sub writenavbar()

in archive/assets/de/Archive/dev/makemap.pl [933:1071]

• 107 lines of code
• 33 McCabe index (conditional complexity)

sub writenavbar {

my @sourcefile; 
my @navbar ;
my $startpos; 
my $endpos;
my $startnavflag= qr/<!-- Start Navbar -->/;
my $endnavflag= qr/<!-- End Navbar -->/;
		
# Schreiben der Navbars
print VERBOSEOUT "Schreibe Navbar(s) in html-Dateien: \n" if $verbose;


ALLFILE: foreach $file (@files)  {

   	print VERBOSEOUT "\n$file" if $verbose;
	# soll ueberhaupt eine Navbar angelegt werden?

	# ersmal alle File-styles pruefen
	$navbarstil = '';
	foreach $adata ( @{$datafiles{$file}{'Ref'}}) {
		if ($adata->{'Stil'} ne '') {
			$navbarstil = $adata->{'Stil'};
			last; 
		}
	}
	
	# wenn er immer noch fehlt, dann den ersten gruppenstil nehmen, wenn existent
	if ($navbarstil eq '' ) {
		$adata = $datafiles{$file}{'Ref'}[0];
		$gruppe = $adata->{'Gruppe'};
		if ($gruppe ne $unsorted) {
			$adata = $data{$gruppe}[0];
			$navbarstil = $adata->{'Stil'};
		}
	}

	
	if ($navbarstil ne '' ) {

		# Einlesen der html-Datei in ein Array
		open (HTMLFILE, "<:utf8",$file) or die "Kann $file nicht oeffnen";
		@sourcefile = ();
		local ($/) = "\012";
		while (<HTMLFILE>) {
			s/\015?\012/\n/g;
			push @sourcefile, $_;
			print DEBUGOUT if ($debug);
		}
    	print VERBOSEOUT "<" if $verbose;
		close HTMLFILE;

		

		# Finden der Start und Endpunkte der Navbar		
		$startpos = -1;
		$endpos = -1;
		for ($i = 0; $i <= $#sourcefile; $i++) {
			if ($sourcefile[$i] =~ /$startnavflag/ig) { $startpos = $i }
			if ($sourcefile[$i] =~ /$endnavflag/ig) { $endpos = $i }
		} 

		# Fehlende oder falsche Endpunkte?		
		print DEBUGOUT ($startpos,' ',$endpos) if $debug>1;	
		if (($startpos == -1) or ( $startpos >= $endpos)) {next ALLFILE;}

		# Alle Links in der vorbereiteten Navbar sind Relativ von siteroot
		# das muss geaendert werden
		@navbar = ();
		foreach my $Line (@{$navbar{$navbarstil}}) {
			$newLine = $Line;
			while ($newLine =~ m/href=\"(\.\/[^"]*)\"/ ) {
				# ueber alle _relativen_ Links in der Navbar
				# achtung, dabei wird der fuehrende Punkt 
				# als Indikator fuer die aenderung entfernt
				# das sollte mit \G noch besser gehen, aber wie?
				$link = $1;
				print DEBUGOUT ($link," -> ") if $debug>1;	
				# Aufspalten in Verzeichnisebenen
    			@filetree = split /\//,$file;
				# Aufspalten in Verzeichnisebenen, fuer jeden Link
    			@linktree = split /\//,$link;

				# Gleiche Ebenen loeschen, mindestens den Punkt behalten
				while (     ($#filetree > 0) 
						and ($#linktree > 0) 
						and ($filetree[1] eq $linktree[1]) ) {
					print DEBUGOUT (" -> ") if $debug>1;	
					splice @filetree,1,1;
					splice @linktree,1,1;
				} 

				#Fuer jede verbliebene Ebene im file ein .. zufuegen
				for (1 .. $#filetree-1) {
					print DEBUGOUT (" .. -> ") if $debug>1;	
					splice @linktree,1,0,('..');
				}

				# den Punkt weg
				shift @linktree;
				
				# und wieder zusammen
				$linknew = join ('/',@linktree);
				print DEBUGOUT ("\n",$link,"=>",$linknew,"\n") if $debug;	
				if (length($linknew)) {
					$newLine =~ s/$link/$linknew/;
					print DEBUGOUT ($newLine,"\n") if $debug;	
				}
				# wenn der neue Link leer ist, sind wir auf der Seite
				# Diese soll besonders behandelt werden, der Link
				# verschwindet, stattdessen nur Text
				else {
					$newLine =~ s/\<a href=\"$link\" .*?> (.*) \<\/a\>/$1 /;
					print DEBUGOUT ($newLine,"\n") if $debug;	
				}
			}
			push @navbar, $newLine;
		}
		
		# Einfuegen der Navbar in das Dateiarray
    	@removed = splice @sourcefile,$startpos+1,$endpos-$startpos-1,@navbar;

		# wenn die entfernten gleich den neuen sind, brauchen wir die Datei nicht
		# schreiben.
    	if (&compare_navbar(\@removed,\@navbar)) {
    		print VERBOSEOUT "-> " if $verbose;
			next ALLFILE;
		} 
		

		# Schreiben der Datei
		open (HTMLFILE, ">:utf8",$file) or die "Kann $file nicht oeffnen";
		foreach (@sourcefile) {
			print HTMLFILE;
		}
    	print VERBOSEOUT "w> " if $verbose;
		close HTMLFILE;
	} # if defined stil
}