User: mkirchner Date: 05/11/29 07:24:46 Modified: /de/www/dev/ makemap.pl
Log: Neue Version 0.5.4 mit Navbarerstellung in ul File Changes: Directory: /de/www/dev/ ======================= File [changed]: makemap.pl Url: http://de.openoffice.org/source/browse/de/www/dev/makemap.pl?r1=1.3&r2=1.4 Delta lines: +335 -93 ---------------------- --- makemap.pl 16 Nov 2005 16:06:28 -0000 1.3 +++ makemap.pl 29 Nov 2005 15:24:43 -0000 1.4 @@ -101,7 +101,7 @@ =head1 VERSION - Version 0.5.1 16.11.2005 Michael Kirchner + Version 0.5.4 21.11.2005 Michael Kirchner Copyright (c) 2005 Michael Kirchner, Marko Moeller Bei Fragen, Wünschen, Anregungen mail to: [EMAIL PROTECTED] This program is free software; you can redistribute it and/or @@ -122,6 +122,10 @@ M. Kirchner: viel Aenderungen, UTF-8, Dokumentation, Aufgaben statt Durchlauf +=item 0511180000 + +Gruppen koennen Gruppen enthalten + =back =head1 TODO @@ -136,7 +140,8 @@ Ausgabe von neuen Dateien =item -Einbinden von pdf und sonstigen Dokumentformaten in die Sitemap +Einbinden von pdf und sonstigen Dokumentformaten in die Sitemap. +Am besten so, dass jeweils nur die Dateiendung und Groesse angezeigt wird. =item Einbinden von Joachims Navbar-ersetzungs-skript und @@ -151,6 +156,7 @@ eine Eingabemaske bereitgestellt wird, in der neue Seiten plaziert werden koennen. + =back =head1 BUGS @@ -192,7 +198,7 @@ $urlmatch = qr/^\./; # Wird in der Ausgabe $urlreplace = '.'; # in jedem relativen Link ersetzt $newdir = '..'; #Zielverzeichnis fuer Start -$Version = '0.5'; +$Version = '0.5.4'; @@ -249,7 +255,7 @@ # amn = aktualisieren, map erstellen, navbar erstellen # => es muss die site.data eingelesen werden -if ($Aufgabe =~ /[amn]/i) { +if ($Aufgabe =~ /[amnw]/i) { &readsite; &crawl; } @@ -280,7 +286,7 @@ } # w = navbar einlesen und einpflegen -if ($Aufgabe =~ /n/i) { +if ($Aufgabe =~ /w/i) { &readnavbar; &writenavbar; } @@ -561,6 +567,72 @@ sub makesitemap { + +sub writemapgroup { + +my ($agroup,$level) = @_; + +my $intro = ""; + + +# soll die Gruppe ueberhaupt ausgegeben werden? +if (($agroup->{'Level'}<=$sitemaplevel)and ($agroup->{'Beschreibung'} ne $noshow)) { + for ($i=2;$i<$level;$i++) { $intro .= "\t" }; + + # Fuer jede Gruppe einen Link, wenn es das oberste Level ist + if ($level == 2) { + printf OUTFILE "\n$intro<a name=\"%s\"></a>\n",$agroup->{'Link'}; + } + + # Fuer jede Gruppe eine Ueberschrift, wenn nicht leer + if ($agroup->{'Text'} ne '') { + printf OUTFILE "\n$intro<h$level>%s ", + $agroup->{'Text'}; + if ($level == 2) { printf OUTFILE "<a href='#Top'>^</a>"; } + printf OUTFILE "</h$level>\n"; + } + + # Fuer jede Gruppe einen Beschreibungstext + if ($agroup->{'Beschreibung'} ne '') { + printf OUTFILE "$intro%s\n", $agroup->{'Beschreibung'}; + } + + + # und jetzt eine Liste + if ($agroup->{'Link'} ne '') { + print OUTFILE "$intro<ul>\n"; + # und jetzt die Elemente der Gruppe + foreach $adata (@{$data{$agroup->{'Link'}}}){ + if (($adata->{'Level'}<=$sitemaplevel) + and ($adata->{'Beschreibung'} ne $noshow)) { + + # Eine Gruppe als Link -> Untergruppe + if ($adata->{'Link'} !~ /^http|\./) { + printf OUTFILE "$intro<li> "; + &writemapgroup ($adata,$level+1); + printf OUTFILE "$intro</li>\n", + } + # Keine Untergruppe + else { + # wenn kein Text definiert ist, wird Pfad+Datei verwendet + printf OUTFILE "$intro<li> <a href=\"%s\"> %s </a>\n$intro\t%s </li>\n", + $adata->{'Link'}, + ($adata->{'Text'} ne "")? $adata->{'Text'}:$adata->{'Link'}, + ($adata->{'Beschreibung'} ne "")? + $adata->{'Beschreibung'}:" "; + } + } + } # foreach adata + printf OUTFILE "$intro</ul>"; + } + + + +} # sitemaplevel + +} # sub writemapgroup + + print VERBOSEOUT "Die Sitemap(s) werden geschrieben: " if $verbose; # Nun werden die Ausgabe-html Dateien geschrieben. foreach $atype (@{$data{'perl-sitemap'}}) { @@ -580,6 +652,10 @@ <head> <title>$sitemaptitle</title> <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" /> + <link rel="stylesheet" href="styles/de.css" media="screen" type="text/css" /> + <link rel="stylesheet" href="styles/de_print.css" media="print" type="text/css" /> + <link rel="stylesheet" title="mit Navbar" href="styles/de_navbar.css" media="screen" type="text/css" /> + <link rel="alternate stylesheet" title="ohne Navbar" media="screen" href="styles/de_nonavbar.css" type="text/css" /> <meta http-equiv="Content-Style-Type" content="text/css" /> <meta name="version" content="$outfile,V$Version $Datum $ENV{'USERNAME'}" /> <meta name="author" content="$ENV{'USERNAME'}" /> @@ -599,7 +675,7 @@ <!-- > Kommentare zur Seite - \$Id: makemap.pl,v 1.3 2005/11/16 16:06:28 mkirchner Exp $ + \$Id: makemap.pl,v 1.4 2005/11/29 15:24:43 mkirchner Exp $ < --> @@ -607,6 +683,9 @@ </head> <body> +<!-- Start Navbar --> +<!-- End Navbar --> + <a name="Top"></a> <div id="body2"> <table id="main2" summary="body2"> @@ -636,7 +715,8 @@ # Eine Linkliste zu den Gruppen steht am Anfang. print OUTFILE "\n<ul>"; foreach $agroup (@{$data{$kato}}) { - if ($agroup->{'Level'}<=$sitemaplevel){ + if (($agroup->{'Level'}<=$sitemaplevel) + and ($agroup->{'Beschreibung'} ne $noshow)){ printf OUTFILE "\n<li><a href=\"#%s\">%s</a></li>", $agroup->{'Link'}, $agroup->{'Text'}; @@ -646,116 +726,155 @@ print OUTFILE '<hr noshade="noshade" size="1" />'; print OUTFILE "\n</div>\n</td>\n</tr>\n</table>"; + + # Dann folgt die Seitenueberschrift print OUTFILE "\n<h1>$sitemaptitle</h1>\n"; + + # Jetzt wird Gruppenweise geschrieben # wobei jeder Gruppe von einer Zeile mit der # Richtigen Kategorie referenziert wird foreach $agroup (@{$data{$kato}}) { - # Fuer jede Gruppe eine Ueberschrift - if ($agroup->{'Level'}<=$sitemaplevel){ - printf OUTFILE "\n<a name=\"%s\"></a>\n<h2>%s <a href='#Top'>^</a></h2>", - $agroup->{'Link'}, - $agroup->{'Text'}; - printf OUTFILE "<p>%s</p>\n", - $agroup->{'Beschreibung'}; + &writemapgroup ($agroup,2); + } + + print OUTFILE $sitemapfuss; + close OUTFILE; + print VERBOSEOUT ", " if $verbose; +} # foreach perl-sitemap + +print VERBOSEOUT ".\n" if $verbose; +} #makesitemap + + - print OUTFILE "<ul>\n"; +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<ul id=\"$navbarstil\">\n"; + } + elsif ($agroup->{'Stil'} eq '' ) { + # Fuer jede Gruppe eine Ueberschrift, es sei denn Pseudogruppen, + # die nur eine Auswahl aus einer Kategorie darstellen + if ($agroup->{'Text'} ne '') { + printf OUTFILE "$intro<li>%s\n", $agroup->{'Text'}; + } + print OUTFILE "$intro <ul>\n"; } + # und jetzt eine Liste + if ($agroup->{'Link'} ne '') { foreach $adata (@{$data{$agroup->{'Link'}}}){ - if ($adata->{'Level'}<=$sitemaplevel){ - if ($adata->{'Link'} eq "") { - if ($adata->{'Beschreibung'} ne $noshow) { - printf OUTFILE "</ul>\n %s \n<ul>\n", - # wenn kein Text definiert ist, wird eine Leerzelle verwendet + if ($adata->{'Level'}<=$navbarlevel){ + + # Eine Gruppe als Link -> Untergruppe + if ($adata->{'Link'} !~ /^http|\./) { + + # Es gibt zwei Moeglichkeiten + # entweder soll wirklich die gesamte Gruppe ausgegeben + # werden oder es soll nur ein element der Gruppe + # ausgegeben werden, der Rest nur mit einem Link auf + # eine UEbersichtsseite + if ($auswahl eq '') { + &writenavgroup ($adata,$level+1,$adata->{'Stil'}); + } + elsif ($auswahl eq $adata->{'Link'} ) { + &writenavgroup ($adata,$level+1,$adata->{'Stil'}); + } else { + # Ausgabe als Ueberschrift mit + # dem ersten Link mit passendem Level in der Gruppe + foreach $bdata (@{$data{$adata->{'Link'}}}){ + if (($bdata->{'Link'} =~ /^http|\./) and + ($bdata->{'Level'}<=$navbarlevel)) { + printf OUTFILE + "$intro <li> <a href=\"%s\" title=\"%s\"> %s </a></li>\n", + $bdata->{'Link'}, ($adata->{'Beschreibung'} ne "")? - $adata->{'Beschreibung'}:" "; + $adata->{'Beschreibung'}:" ", + # wenn kein Text definiert ist, wird Ein Dummy verwendet + ($adata->{'Text'} ne "")? $adata->{'Text'}:'?????'; + last; + } } } + } + # Keine Untergruppe else { - printf OUTFILE "<li> <a href=\"%s\"> %s </a>\n\t%s </li>\n", + printf OUTFILE + "$intro <li> <a href=\"%s\" title=\"%s\"> %s </a></li>\n", $adata->{'Link'}, - # wenn kein Text definiert ist, wird Pfad+Datei verwendet - ($adata->{'Text'} ne "")? $adata->{'Text'}:$adata->{'Link'}, - ($adata->{'Beschreibung'} ne "")? - $adata->{'Beschreibung'}:" "; + ($adata->{'Beschreibung'} ne "")? $adata->{'Beschreibung'}:" ", + # wenn kein Text definiert ist, wird Ein Dummy verwendet + ($adata->{'Text'} ne "")? $adata->{'Text'}:'?????'; + } } } # foreach adata + } - if ($agroup->{'Level'}<=$sitemaplevel){ - printf OUTFILE "</ul>"; + + # die liste schliessen + if ($level == 1) { + printf OUTFILE "$intro</ul>\n"; + } + elsif ($agroup->{'Stil'} eq '' ) { + # Fuer jede Gruppe eine Ueberschrift + print OUTFILE "$intro </ul>\n"; + if ($agroup->{'Text'} ne '') { + printf OUTFILE "$intro</li>\n"; + } } - } # katogorie - print OUTFILE $sitemapfuss; - close OUTFILE; - print VERBOSEOUT ", " if $verbose; -} # foreach perl-sitemap -print VERBOSEOUT ".\n" if $verbose; -} #makesitemap +} # navbarlevel +} # sub writenavgroup -sub makenavbar { -print VERBOSEOUT "Die Navbars werden erzeugt und gespeichert" if $verbose; + + +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: + $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 = <<EOT; -<table id="$navbarstil" summary="$navbartitle" border="0" cellspacing="0" cellpadding="0"> <!-- > - Kommentare zur Seite - \$Id: makemap.pl,v 1.3 2005/11/16 16:06:28 mkirchner Exp $ + Kommentare zur Navbar $navbartitle + \$Id: makemap.pl,v 1.4 2005/11/29 15:24:43 mkirchner Exp $ $outfile,V $Version $Datum $ENV{'USERNAME'} < --> EOT $navbarfuss = <<EOT; -</table> EOT print OUTFILE $navbarkopf; - # Jetzt wird Gruppenweise geschrieben - # wobei jeder Gruppe von einer Zeile mit der - # Richtigen Kategorie referenziert wird - foreach $agroup (@{$data{$kato}}) { - if ($agroup->{'Level'}<=$navbarlevel){ - # Fuer jede Gruppe eine Ueberschrift - printf OUTFILE "\n<tr><th>%s</th></tr>\n", $agroup->{'Text'}; - } - - foreach $adata (@{$data{$agroup->{'Link'}}}){ - if ($adata->{'Level'}<=$navbarlevel){ - # wenn kein link angegeben ist, ist es eine Ueberschrift - if ($adata->{'Link'} eq "") { - printf OUTFILE - " <tr><td> %s </td></tr>\n", - # wenn kein Text definiert ist, wird eine Freizelle verwendet - ($adata->{'Text'} ne "")? $adata->{'Text'}:''; - } - else { - printf OUTFILE - " <tr><td> <a href=\"%s\" title=\"%s\"> %s </a></td></tr>\n", - $adata->{'Link'}, - ($adata->{'Beschreibung'} ne "")? $adata->{'Beschreibung'}:" ", - # wenn kein Text definiert ist, wird Ein Dummy verwendet - ($adata->{'Text'} ne "")? $adata->{'Text'}:'Dummy'; - } - } - } # foreach adata - } # katogorie + &writenavgroup ($atype,1,''); print OUTFILE $navbarfuss; close OUTFILE; @@ -769,18 +888,19 @@ sub readnavbar { # Einlesen der Navbars -print VERBOSEOUT "Lese Navbar" if $verbose; +print VERBOSEOUT "Lese Navbar:\n" if $verbose; foreach $atype (@{$data{'perl-navbar'}}) { my $navfile = $atype->{'Text'}; + my $navstil = $atype->{'Stil'}; print VERBOSEOUT $navfile if $verbose; open (NAVFILE, "<:utf8",$navfile) or die "Kann $navfile nicht oeffnen"; NAVREAD: while (<NAVFILE>) { - push @{$navbar{$navfile}}, $_; + push @{$navbar{$navstil}}, $_; } close NAVFILE; - print VERBOSEOUT ", " if $verbose; + print VERBOSEOUT " " if $verbose; } print VERBOSEOUT ".\n" if $verbose; @@ -788,28 +908,141 @@ 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 " if $verbose; +print VERBOSEOUT "Schreibe Navbar(s) in html-Dateien: \n" if $verbose; -foreach $file ('./credits.html') { +ALLFILE: foreach $file (@files) { - print VERBOSEOUT $file if $verbose; - open (INFILE, "<".$file) or die "Kann $file nicht oeffnen"; - VOR: while (my $Line = <INFILE>) { - if ($Line !~ /<!-- Start Navbar -->/ig) { -# print $Line; + # 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; + } } + + # dann den ersten gruppenstil nehmen, wenn existent + if ($navbarstil eq '' ) { + $adata = $datafiles{$file}{'Ref'}[0]; + $gruppe = $adata->{'Gruppe'}; + $adata = $data{$gruppe}->[0]; + $navbarstil = $adata->{'Stil'}; } - BAR: while (<INFILE> !~ /<!-- End Navbar -->/ig) { + + + if ($navbarstil ne '' ) { + + # Einlesen der html-Datei in ein Array + print VERBOSEOUT "\n$file" if $verbose; + 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); } - NACH: while (<INFILE>) { -# print $_; + 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;} - close INFILE; - print VERBOSEOUT ", " if $verbose; + # 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([EMAIL PROTECTED],[EMAIL PROTECTED])) { + 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; @@ -817,4 +1050,13 @@ } # 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; + } --------------------------------------------------------------------- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
