\n\n

EOT $sitemapfuss = <

EOT2 print OUTFILE $sitemapkopf; # ueber alle Gruppen in der Kategorie # Eine Linkliste zu den Gruppen steht am Anfang. print OUTFILE "\n

\n

"; print OUTFILE '

'; print OUTFILE "\n\n

"; # Dann folgt die Seitenueberschrift print OUTFILE "\n

$sitemaptitle

\n"; # Jetzt wird Gruppenweise geschrieben # wobei jeder Gruppe von einer Zeile mit der # Richtigen Kategorie referenziert wird foreach $agroup (@{$data{$kato}}) { &writemapgroup ($agroup,2); } print OUTFILE $sitemapfuss; close OUTFILE; print VERBOSEOUT ", " if $verbose; } # foreach perl-sitemap print VERBOSEOUT ".\n" if $verbose; } #makesitemap sub makenavbar { sub writenavgroup { my ($agroup,$level,$auswahl) = @_; my $intro = ""; # soll die Gruppe ueberhaupt ausgegeben werden? if ($agroup->{'Level'}<=$navbarlevel) { for ($i=1;$i<$level;$i++) { $intro .= " " }; # die liste oeffnen if ($level == 1) { print OUTFILE "$intro

de-links
%s\n", $agroup->{'Text'}; } print OUTFILE "$intro
- %s
- %s
\n"; } elsif ($level > 2 ) { # Fuer jede Gruppe eine Ueberschrift print OUTFILE "$intro

\n"; if ($agroup->{'Text'} ne '') { printf OUTFILE "$intro\n"; } } } # navbarlevel } # sub writenavgroup print VERBOSEOUT "Die Navbars werden erzeugt und gespeichert:\n" if $verbose; foreach $atype (@{$data{'perl-navbar'}}) { $outfile = $atype->{'Text'}; print VERBOSEOUT $outfile if $verbose; $navbarstil = $atype->{'Stil'}; # hack: urspr�nglich sollten die Navbars mal unterschieden werden # dies sollte sich im Stil ausdruecken $navbarstil = 'navbar_de'; # hack:ende $navbarlevel = $atype->{'Level'}; $navbartitle = $atype->{'Beschreibung'}; $kato = $atype->{'Link'}; open (OUTFILE, '>:utf8', $outfile) or die "Kann $outfile nicht oeffnen"; $Datum = strftime "%A, %d. %B %Y %H:%M:%S", localtime( time); $navbarkopf = < Kommentare zur Navbar $navbartitle Makemapversion: \$Id: makemap.pl,v 1.8 2006/08/15 06:52:27 markomlm Exp $ Navbar: $outfile ,V $Version $Datum $ENV{'USERNAME'} < --> EOT $navbarfuss = <{'Text'}; my $navstil = $atype->{'Stil'}; print VERBOSEOUT $navfile if $verbose; open (NAVFILE, "<:utf8",$navfile) or die "Kann $navfile nicht oeffnen"; NAVREAD: while () { push @{$navbar{$navstil}}, $_; } close NAVFILE; print VERBOSEOUT " " if $verbose; } print VERBOSEOUT ".\n" if $verbose; } # readnavbar sub writenavbar { my @sourcefile; my @navbar ; my $startpos; my $endpos; my $startnavflag= qr//; my $endnavflag= qr//; # 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 () { 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\>/$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 } print VERBOSEOUT ".\n" if $verbose; } # writenavbar sub compare_navbar { my ($first, $second) = @_; no warnings; # silence spurious -w undef complaints return 0 unless @$first == @$second; for (my $i = 4; $i < @$first; $i++) { return 0 if $first->[$i] ne $second->[$i]; } return 1; }