Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
executable file 1217 lines (985 sloc) 27.5 KB
#!/usr/bin/perl -w
use strict;
use POSIX qw(strftime);
use Digest::MD5 qw(md5_hex);
##
## [ 2do ]
##
#
# - DESCRIPTION-Meta-Tag sinnvoll füllen
# - table summary="" lokalisieren (de/en)
# - mehrere DLINKs auf einer Zeile nicht möglich!
# - LINK-check findet keinen Fehler, wenn nur eine Sprachersion vorhanden ist
# - mit <link>s im Header arbeiten (http://www.w3.org/QA/Tips/use-links)
#
##
##
my $version = 'webCOMA (git)';
my $favicon = 'pics/favicon.ico'; # may also be empty
my $author = 'Christian Garbs';
my $authormail= 'mitch@cgarbs.de';
my $sitename = 'Master Mitch';
my $rsstitle = 'Master Mitch on da netz';
my $rssdescription = "Mitch's homepage";
my $baseurl = 'http://www.cgarbs.de';
## RSS definitions
my $rssmax = 15; # number or articles in file
my $rsspicurl = 'http://www.cgarbs.de/pics/favicon.feed.png'; # may also be empty
my $rsspicwidth = 22;
my $rsspicheight = 18;
my $flattr = 'http://flattr.com/thing/570000/Master-Mitch-on-da-netz'; # may also be empty
##
my $amazon_link = 'http://www.amazon.de/exec/obidos/ASIN/%/mastemitchondane';
my @languages = ('de', 'en');
my $srcpath = 'in';
my $destpath = 'out';
my $startdoc = 'index';
my $template = "$srcpath/TEMPLATE";
my $sourcepath= 'source';
my %pagestructure;
my %date;
my $date_cmd = 'date';
my $copy_cmd = 'cp';
my $revisit = '7 days';
my $host = `hostname -f`;
chomp $host;
my %cache;
my %linkcache;
$linkcache{$startdoc} = "";
my %dlinkcache;
my %news;
my $dotfile = 'homepage.dot';
my $subtitlecount = 0;
my %lastedited = ( 'de' => 'letzte Änderung:', 'en' => 'last edited:' );
my %generatedby = ( 'de' => 'erstellt mit:', 'en' => 'generated by:' );
my %author = ( 'de' => 'Autor:', 'en' => 'author:' );
my %navtitle = ( 'de' => 'Navigation', 'en' => 'navigation' );
my %langtitle = ( 'de' => 'Sprache', 'en' => 'language' );
my %language = ( 'de' => 'Deutsch', 'en' => 'English' );
my %langsrc = ( 'de' => 'Quellcode', 'en' => 'source' );
my %feedtitle = ( 'de' => 'Feed', 'en' => 'feed' );
sub scanStructure($$);
sub printPage($$);
sub initDates();
sub convertDate($$);
sub readTag($$);
sub navBar($$);
sub expand($$);
sub newsBox($$);
sub includeSiteMap($);
sub rssfeed($);
sub getLeft($$);
sub getRight($$);
{
print "Initializing dates.\n";
initDates();
print "\n";
open DOT, ">$dotfile" or die "can't open dotfile <$dotfile>: $!";
print DOT "digraph \"$sitename\" {\n";
print DOT "\tsize=\"7,8\";\n";
print DOT "\tratio=stretch;\n";
print DOT "\t$startdoc [shape=box];\n";
print "Scanning site structure:\n";
scanStructure($startdoc,"");
foreach my $lang (@languages) {
print "$lang: ";
print (scalar @{$pagestructure{$lang}});
print " pages found.\n";
}
print DOT "}\n";
print "\n";
close DOT or die "can't close dotfile <$dotfile>: $!";
print "Scanning dlink integrity: ";
foreach my $dlink (keys %dlinkcache) {
if (! defined $linkcache{$dlink}) {
print "\n";
die "DLINK TO $dlink COULD NOT BE RESOLVED\n";
}
}
print "OK\n\n";
print "Looking for stale files: ";
open FILES, "find $srcpath -maxdepth 1 -name *.page |" or die "can't list directory: $!";
while (my $file = <FILES>) {
chomp $file;
$file =~ s/^$srcpath\///;
$file =~ s/\.page$//;
if (! defined $linkcache{$file}) {
print "\n";
die "STALE FILE $file.page DETECTED\n";
}
}
close FILES or die "can't close directory list: $!";
print "OK\n\n";
print "Generating pages:\n";
foreach my $lang (@languages) {
for (my $page = 0; $page < @{$pagestructure{$lang}}; $page++) {
printPage($page,$lang);
}
}
print "\n";
print "Generating RSS feeds:\n";
foreach my $lang (@languages) {
rssfeed($lang);
}
print "\n";
print "Finished.\n\n";
exit 0;
}
#
sub scanStructure($$)
{
my $doc = shift;
my $parent = shift;
my @files;
my $filedate = `$date_cmd -r "$srcpath/$doc.page" +%Y%m%d\\ %H:%M:%S`;
foreach my $lang (@languages) {
open IN, "<$srcpath/$doc.page" or die "can't open <$srcpath/$doc.page>: $!";
my $valid = 0;
while (<IN>) {
$valid = 1 if $_ =~ /^#VALID/;
last if $_ =~ /^#RCS/;
}
$_ =~ /(\$(Id):.*\$)/; # (Id) because RCS should not find and substitute this line
$cache{"$parent$doc"}{'RCS'} = ($1 or die "no rcs tag in $srcpath/$doc.page");
next unless grep { $lang eq $_ } readTag("LANG", $lang);
print "$lang: $parent$doc\n";
push @{$pagestructure{$lang}}, "$parent$doc";
my @temp;
@temp = readTag("TYPE", $lang);
$cache{"$parent$doc"}{$lang}{'TYPE'} = $temp[0];
$cache{"$parent$doc"}{$lang}{'VALID'} = $valid;
{
my $olddate;
my $text = "";
foreach my $news (readTag("NEWS", $lang)) {
if ($news =~ /#DATE:(.*)/) {
if (defined $olddate) {
# vvv UGLY -- DOUPLICATE CODE !!! -- UGLY vvv
if ($text =~ /#DLINK:([^#]*)#/) {
my $link = $1;
$link =~ s/\!.*$//;
$dlinkcache{$link} = "";
{
my ($from, $to) = ($doc, $1);
$from =~ s/-/_/g;
$to =~ s/-/_/g;
print DOT "\t$from -> $to [style=dotted];\n";
}
}
# ^^^ UGLY -- DOUPLICATE CODE !!! -- UGLY ^^^
## COPY BEGIN
$text =~ s/\s+$//;
$text =~ s/^\s+//;
$text = expand( $text, $lang );
$news{"$parent$doc"}{$olddate}{$lang} = $text unless $text eq "";
## COPY END
}
$text = "";
$olddate = $1;
$olddate =~ s/\s+$//;
$olddate =~ s/^\s+//;
die "EMPTY NEWS DATE\n" if ($olddate eq "");
} else {
$text .= "$news ";
}
}
## COPY BEGIN
$text =~ s/\s+$//;
$text =~ s/^\s+//;
$text = expand( $text, $lang );
$news{"$parent$doc"}{$olddate}{$lang} = $text unless $text eq "";
## COPY END
}
@temp = readTag("TITLE", $lang);
$cache{"$parent$doc"}{$lang}{'TITLE'} = $temp[0];
$cache{"$parent$doc"}{$lang}{'DATE'} = convertDate($lang, $filedate);
@temp = readTag("KEYWORDS", $lang);
my @keywords = $temp[0];
my $subtitles = [];
if ($cache{"$parent$doc"}{$lang}{'TYPE'} eq "oldschool") {
@temp = readTag("OLDSCHOOL", $lang);
} else {
@temp = readTag("PLAIN", $lang);
}
foreach my $line (@temp) {
if ($line =~ /#LINK:([^#]*)#/) {
my $link = $1;
$link =~ s/\!.*$//;
if ((grep {$link eq $_} @files) == 0 ) {
push @files, $link;
}
}
# vvv UGLY -- DOUPLICATE CODE !!! -- UGLY vvv
if ($line =~ /#DLINK:([^#]*)#/) {
my $link = $1;
$link =~ s/\!.*$//;
$dlinkcache{$link} = "";
{
my ($from, $to) = ($doc, $1);
$from =~ s/-/_/g;
$to =~ s/-/_/g;
print DOT "\t$from -> $to [style=dotted];\n";
}
}
# ^^^ UGLY -- DOUPLICATE CODE !!! -- UGLY ^^^
if ($line =~ /#SUBTITLE:(.*):([^:]*):/) {
my ($show, $title) = ($1, $2);
if ($title eq "") {
$title = $show;
}
die "SUBTITLE without title!" if ($title eq "");
push @{$subtitles}, $title;
}
}
close IN or die "can't close <$srcpath/$doc.page>: $!";
$cache{"$parent$doc"}{$lang}{'SUBTITLES'} = $subtitles;
}
foreach my $file (@files) {
next if $file =~ /^\s*$/;
if (defined $linkcache{$file}) {
die "$srcpath/$file.page HAS MULTIPLE PARENTAGES\n";
} else {
$linkcache{$file} = "";
if (! -e "$srcpath/$file.page") {
system("$copy_cmd $template $srcpath/$file.page") == 0 or die "copy failed: $?";
warn "CREATING NEW TEMPLATE FOR $srcpath/$file.page\n";
my $taste=<STDIN>;
}
{
my ($from, $to) = ($doc, $file);
$from =~ s/-/_/g;
$to =~ s/-/_/g;
print DOT "\t$from -> $to;\n";
}
scanStructure($file, "$parent$doc!");
}
}
}
#
sub printPage($$)
{
my $i = shift;
my $lang = shift;
my $page = $pagestructure{$lang}[$i];
my ($file, $path, @elements) = getStuff($i, $lang);
my $date = $cache{$page}{$lang}{'DATE'};
my $typ = $cache{$page}{$lang}{'TYPE'};
my $title = $cache{$page}{$lang}{'TITLE'};
my $gbAlign = 1;
print "$file.$lang.html\t<$title>\t[$typ]\n";
open IN, "<$srcpath/$file.page" or die "can't open <$srcpath/$file.page>: $!";
open OUT, ">$destpath/$file.$lang.html" or die "can't open <$destpath/$file.$lang.html>: $!";
my @news = readTag("NEWS", $lang);
my @temp = readTag("KEYWORDS", $lang);
my @keywords = $temp[0];
$subtitlecount = 0;
print OUT <<"EOF";
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<html><head><title>$sitename - $title</title>
<link rel="stylesheet" type="text/css" href="style.css">
<link rel="alternate" type="application/rss+xml" title="RSS-Feed" href="$baseurl/rssfeed.$lang.xml">
EOF
;
print OUT "<link rel=\"shortcut icon\" type=\"image/ico\" href=\"$favicon\">\n" if $favicon;
print OUT <<"EOF";
<meta name="generator" content="$version">
<meta name="generating_host" content="$host">
<meta name="generation_date" content="$date{$lang}">
<meta name="rcs_tag" content="$cache{$page}{'RCS'}">
<meta name="robots" content="index,follow">
<meta name="keywords" content="@keywords">
<meta name="author" content="$author ($authormail)">
<meta name="language" content="$lang">
<meta http-equiv="revisit-after" content="$revisit">
<meta http-equiv="content-language" content="$lang">
<meta http-equiv="content-type" content="text/html; charset=UTF-8">
</head>
<body>
EOF
;
#<meta name="DESCRIPTION" content="$sitename - $title">
print OUT << "EOF";
<table width="100%" border="0" cellspacing="0" cellpadding="0">
<tr id="topbox">
<td width="100%">
<table width="100%" border="0" cellspacing="0" cellpadding="15">
<tr>
<td width="80%" height="50" valign="top">
<div class="titletext" align="left">$sitename - $title</div>
</td>
<td width="20%" height="50" valign="top" align="right">
<!-- <a href="http://www.cgarbs.de"><img src="pics/mitchlogo_web.png" alt="WEBSITE" width="37" height="35"></a>
&nbsp; -->
<a href="http://www.cgarbs.de/blog/"><img src="pics/mitchlogo_blog.png" alt="BLOG" width="37" height="35"></a>
&nbsp;
<a href="http://flickr.com/photos/mitchmaster/"><img src="pics/mitchlogo_flickr.png" alt="FLICKR" width="37" height="35"></a>
&nbsp;
<a href="http://github.com/mmitch"><img src="pics/mitchlogo_git.png" alt="GIT" width="37" height="35"></a>
</td>
</tr>
</table>
</td>
<tr>
<td width="100%">
<table width="100%" border="0" cellspacing="0" cellpadding="10">
<tr>
<td width="15%" valign="top" id="leftbox">
<div id="navcontainer" align="left">
EOF
;
navBar($i, $lang);
print OUT "</div></td>\n<td width=\"85%\" valign=\"top\">\n";
if (($typ eq "plain") or ($typ eq "news")) {
my @lines = readTag("PLAIN", $lang);
while (@lines) {
my $line = shift @lines;
$line = expand($line, $lang);
if ($line =~ /#SITEMAP#/) {
includeSiteMap($lang);
} elsif ($line =~ /\#GRAPHBOX</) {
my @amazon;
my ($x, $y, $file, $amazon, $alt) = split /!/, shift @lines, 5;
die "Error in GRAPHBOX in $page:\n$x!$y!$file!$amazon$alt\n" unless defined $alt;
if ($amazon =~ /,/)
{
($amazon, @amazon) = split /,/, $amazon;
}
print OUT "<center><table width=\"95%\" border=0><tr>\n";
my ($align, $align2);
if ($gbAlign) {
$gbAlign = 0;
$align='align="left"';
$align2='align="right"';
} else {
$gbAlign = 1;
$align='align="right"';
$align2='align="left"';
}
if (($amazon eq "") || ($lang ne "de")) {
print OUT "<td $align><img src=\"pics/$file\" alt=\"$alt\" width=$x height=$y $align2 hspace=5 vspace=5>";
} else {
my $link = $amazon_link;
die "wrong ASIN chksum: <$amazon> @ GRAPHBOX in $page:\n$x!$y!$file!$amazon$alt\n" unless CheckISBN($amazon);
$link =~ s/%/$amazon/;
print OUT "<td $align><a href=\"$link\"><img src=\"pics/$file\" alt=\"$alt\" width=$x height=$y $align2 hspace=5 vspace=5 border=0></a>";
}
while (@lines) {
my $line = shift @lines;
last if $line =~ /\#GRAPHBOX>/;
$line = expand($line, $lang);
print OUT "$line\n";
}
if (($amazon ne "") && ($lang eq "de")) {
my $link = $amazon_link;
$link =~ s/%/$amazon/;
die "wrong ASIN chksum: <$amazon> @ GRAPHBOX in $page:\n$x!$y!$file!$amazon$alt\n" unless CheckISBN($amazon);
print OUT "<ul><li><small>Einkaufen bei <a href=\"$link\">amazon.de</a>";
if (@amazon)
{
print OUT ":<br>Band ";
while (@amazon)
{
my ($ep, $amazon) = split /:/, shift @amazon;
my $link = $amazon_link;
$link =~ s/%/$amazon/;
die "wrong ASIN chksum: <$ep:$amazon> @ GRAPHBOX in $page:\n$x!$y!$file![...]$alt\n" unless CheckISBN($amazon);
print OUT "<a href=\"$link\">$ep</a>";
print OUT " - " if (@amazon);
}
}
print OUT "</small></li></ul>";
}
print OUT "</td></tr></table></center>\n";
} elsif ($line =~ /\#NEWS\#/) {
if ($typ eq "plain") {
newsBox($page, $lang);
} else {
newsBox("", $lang);
}
} elsif ($line =~ /\#SUBTITLES(\/s)?\#/) {
my $count = 0;
if (defined $1) {
my %sorthash;
map {$sorthash{$_} = $count++} @{$cache{"$page"}{$lang}{'SUBTITLES'}};
foreach my $key (sort {uc($a) cmp uc($b)} keys %sorthash) {
print OUT "[<a href=\"#$sorthash{$key}\">$key</a>] ";
}
} else {
foreach my $subtitle (@{$cache{"$page"}{$lang}{'SUBTITLES'}}) {
print OUT "[<a href=\"#$count\">$subtitle</a>] ";
$count++;
}
}
} else {
print OUT "$line\n";
}
}
} elsif ($typ eq "oldschool") {
my ($autor_head, $datum_head, $version_head, $size_head, $name_head, $comment_head);
if ($lang eq "de") {
# Deutsch
$autor_head = "Autor";
$datum_head = "Datum";
$version_head = "Version";
$size_head = "Größe";
$name_head = "Datei";
$comment_head = "Hinweise";
} else {
# Englisch
$autor_head = "author";
$datum_head = "date";
$version_head = "version";
$size_head = "size";
$name_head = "file";
$comment_head = "notes";
};
# Vorlage durchgehen
my @input = readTag("OLDSCHOOL", $lang);
my $zeile= shift @input;
while ($zeile !~ /^<!--.BEG/) {
$zeile= shift @input;
}
print OUT "$zeile";
# Autor-Spalte ?
my $autor_schalter;
if ($zeile =~ /\ EXT\ /) {
$autor_schalter = "JA";
} else {
$autor_schalter = "NEIN";
};
# Tabellenkopf
my $fehler = 0;
my $typ = shift @input;
if ($typ ne "PROGRAMMNAME") {
$fehler++;
print "\n\nFEHLER [$fehler]: PROGRAMMNAME fehlt\n\n";
}
my $programmname=shift @input;
$typ = shift @input;
if ($typ ne "SPRUNGMARKE") {
$fehler++;
print "\n\nFEHLER [$fehler]: SPRUNGMARKE fehlt\n\n";
}
my $sprungmarke=shift @input;
print OUT "<h2 class=\"centered\">Download</h2>";
print OUT "<h1 class=\"centered\">$programmname</h1>";
# Der Freitext
$typ = shift @input;
if ($typ ne "FREITEXT") {
$fehler++;
printf "\n\nFEHLER [$fehler]: FREITEXT fehlt\n\n";
}
print OUT "<p>";
$zeile = shift @input;
while ($zeile ne "ZEILE") {
$zeile = expand($zeile,$lang);
print OUT "$zeile\n";
$zeile = shift @input;
}
print OUT "</p>";
print OUT "<table class=\"noborder\" width=\"100%\"><tr><td align=\"center\">";
print OUT "<table class=\"dwn\" summary=\"list of files\"><tr>";
if ($autor_schalter eq "JA") {
print OUT "<th class=\"dwn\" align=\"left\">$autor_head</th>";
};
print OUT "<th class=\"dwn\">$datum_head</th>";
print OUT "<th class=\"dwn\">$version_head</th>";
print OUT "<th class=\"dwn\">$size_head</th>";
print OUT "<th class=\"dwn\">$name_head</th>";
print OUT "<th class=\"dwn\">$comment_head</th>";
print OUT "</tr>";
# Die einzelnen Zeilen
$typ = $zeile;
while (($typ eq "ZEILE") || ($typ eq "--HLINE--")) {
if ($typ eq "--HLINE--") {
print OUT "<tr><td colspan=";
if ($autor_schalter eq "JA") {
print OUT "6";
} else {
print OUT "5";
}
print OUT "><hr></td></tr>\n";
} else {
my $autor;
if ($autor_schalter eq "JA") {
$autor = shift @input;
};
my $datum = shift @input;
my $version = shift @input;
my $size = shift @input;
my $url = shift @input;
my $name = shift @input;
my $comment = shift @input;
print OUT "<tr>";
if ($autor_schalter eq "JA") {
print OUT "<td class=\"dwnauthor\">$autor</td>";
};
print OUT "<td class=\"dwndate\">$datum</td>";
print OUT "<td class=\"dwnversion\">$version</td>";
print OUT "<td class=\"dwnsize\">$size</td>";
print OUT "<td class=\"dwnlink\"><a href=\"$url\">$name</a></td>";
print OUT "<td class=\"dwncomment\">$comment</td>";
print OUT "</tr>\n";
}
$typ = shift @input;
}
# Tabellenfuß
if ($typ !~ /^<!--.END/) {
$fehler++;
print "\n\nFEHLER [$fehler]: <!--END oder ZEILE fehlt \n\n";
}
print OUT "</table><p><br></p></td></tr></table>";
print OUT "$typ\n";
if ($fehler > 0) {
die "\n\nOBACHT! ES SIND $fehler FEHLER AUFGETRETEN!\n\n";
}
newsBox($page, $lang);
} else {
die "UNKNOWN TYPE <$typ>\n";
}
#
# Seitenfuß
#
print OUT << "EOF";
</td>
</tr>
</table>
</td>
<tr>
<td width="100%" id="footbox">
<div align="right"><a href="mailto:$authormail">$author</a>
:
<a href="webcoma.$lang.html">$version</a>
:
$date
:
EOF
;
my $uri = "$baseurl/$file.$lang.html";
if ($cache{$page}{$lang}{VALID}) {
print OUT << "EOF";
<a href="http://validator.w3.org/check?uri=$uri">valid HTML</a>
:
EOF
;
} else {
print OUT << "EOF";
<a href="http://validator.w3.org/check?uri=$uri">HTML not yet validated!</a>
:
EOF
;
}
print OUT << "EOF";
<a href="http://jigsaw.w3.org/css-validator/validator?uri=$uri">valid CSS</a>
:
<a href="http://www.feedvalidator.org/check.cgi?url=$baseurl/rssfeed.$lang.xml">valid RSS</a>
EOF
;
if ($flattr) {
print OUT << "EOF";
:
<a href="$flattr" target="_blank" style="color: black">Flattr this!</a>
EOF
;
}
print OUT << "EOF";
&nbsp;
</div>
</td>
</tr>
</table>
</body>
</html>
EOF
;
close IN or die "can't close <$srcpath/$file.page>: $!";
close OUT or die "can't close <$destpath/$file.$lang.html>: $!";
}
#
sub initDates()
{
foreach my $lang (@languages) {
$date{$lang} = convertDate($lang, `$date_cmd +%Y%m%d\\ %H:%M:%S`);
print "$lang: $date{$lang}\n";
chomp $date{$lang};
}
}
#
sub convertDate($$)
{
my $lang = shift;
chomp(my $date = shift);
my $ret;
if ($lang eq "de") {
$ret = `LANG=de_DE.UTF-8 $date_cmd +%c -d "$date"`;
} else {
$ret = `LANG=EN $date_cmd -d "$date"`;
}
chomp $ret;
return $ret;
}
#
sub readTag($$)
{
my $tag = shift;
my $lang = shift;
my @ret;
while (<IN>) {
last if /#$tag</;
}
while (my $line = <IN>) {
last if $line =~ /#$tag>/;
chomp $line;
# Einzel-Language-Tag
if ($line =~ /^&([^:]*):/) {
if ($1 eq $lang) {
$line =~ s/^&$lang://;
push @ret, $line;
}
}
# Language-Block
elsif ($line =~ /^&(.*)</) {
if ($1 eq $lang) {
while (my $line = <IN>) {
last if $line =~ /^&$lang>/;
chomp $line;
push @ret, $line;
}
} else {
while (<IN>) {
last if /^&$1>/;
}
}
}
# Freitext
else {
push @ret, $line;
}
}
return @ret;
}
#
sub navBar($$)
{
my ($i, $lang) = @_;
my ($me, $path) = getStuff($i, $lang);
$me =~ s/^.*!//;
if ($path ne "") {
$path .= "!";
}
print OUT "<b>$navtitle{$lang}</b><br>\n";
my $depth = $path =~ tr/!/!/;
my $olddepth = -1;
my $li = 0;
foreach my $element ( @{$pagestructure{$lang}} ) {
my @element = (split /!/, $element);
my $file = pop @element;
my $el_path = join '!', @element;
my $el_depth = $element =~ tr/!/!/;
if ($el_depth == $depth) {
# neighbour nodes: check for own tree
next unless $element =~ /^$path/;
} elsif ($el_depth > $depth) {
# subnodes: check for own tree
# skip subsubnodes and the like
next if $el_depth > $depth + 1;
# test if subnodes are direct siblings
next unless $element =~ /^$path$me/;
} else {
# super nodes: check for own tree
next unless $path =~ /^$el_path/;
}
if ($el_depth > $olddepth) {
print OUT "<ul>\n";
$olddepth++;
} else {
while ($el_depth < $olddepth) {
$olddepth--;
print OUT "</li>\n</ul>\n";
$li--;
}
if ($li) {
print OUT "</li>\n";
}
}
# shorten title
my $title = $cache{$element}{$lang}{TITLE};
$title =~ s/^.* - //;
if ($element eq $path.$me) {
print OUT "<li><a href=\"#\" class=\"selected\">$title</a>";
} else {
print OUT "<li><a href=\"$file.$lang.html\">$title</a>";
}
$li++;
}
while ($olddepth > -1) {
if ($li) {
print OUT "</li>\n";
$li--;
}
print OUT "</ul>\n";
$olddepth--;
}
print OUT "<b>$langtitle{$lang}</b><br>\n";
print OUT "<ul>\n";
foreach my $l (@languages) {
if ($l ne $lang) {
if (grep { $pagestructure{$lang}[$i] eq $_ } @{$pagestructure{$l}}) {
print OUT "<li><a href=\"$me.$l.html\">$language{$l}</a></li>\n";
}
} else {
print OUT "<li><a href=\"#\" class=\"selected\">$language{$l}</a></li>\n";
}
}
print OUT "<li><a href=\"$sourcepath/$me.txt\" class=\"navbar\">$langsrc{$lang}</a></li>\n";
print OUT "</ul>\n";
print OUT "<b>$feedtitle{$lang}</b><br>\n";
print OUT "<ul>\n";
print OUT "<li><a href=\"$baseurl/rssfeed.$lang.xml\" class=\"navbar\">$feedtitle{$lang}</a></li>\n";
print OUT "</ul>\n";
}
#
sub expand($$)
{
my $zeile = shift;
my $lang = shift;
if ($zeile =~ /#D?LINK:([^#]*)#/) {
my ($link, $hash, $class) = split /!/, $1, 3;
if ($hash) {
$hash = "#$hash";
if ($class) {
$class=" class=\"$class\"";
} else {
$class="";
}
} else {
$hash = "";
$class = "";
}
$zeile =~ s/#D?LINK:[^#]*#/<a href="$link.$lang.html$hash"${class}>/;
}
if ($zeile =~ s/#SUBTITLE:(.*):[^:]*:/<a name="$subtitlecount">$1<\/a>/) {
$subtitlecount++;
}
return $zeile;
}
#
sub newsBox($$)
{
my $path = shift;
my $lang = shift;
my %dates;
foreach my $file (keys %news) {
if ($file =~ /^$path/) {
my $link = $file;
$link =~ s/.*!//g;
foreach my $date (keys %{$news{$file}}) {
if (defined $news{$file}{$date}{$lang}) {
push @{$dates{$date}},
{
'LINK' => $link,
'TEXT' => $news{$file}{$date}{$lang},
'TITLE'=> $cache{$file}{$lang}{'TITLE'}
};
}
}
}
}
if (keys %dates) {
print OUT "<div id=\"news\"><p><b>&nbsp;&nbsp;News</b></p>\n";
my $count = 1;
my $max = 3;
foreach my $date (reverse sort keys %dates) {
last if $count > $max;
# Language-Datum!
my $datum = $date;
if ($lang eq "de") {
$datum =~ /(....)-(..)-(..)/;
$datum = "$3.$2.$1";
}
foreach my $elem (@{$dates{$date}}) {
print OUT "<p><a href=\"$elem->{'LINK'}.$lang.html\">$datum: $elem->{'TITLE'}</a><br>\n";
print OUT "$elem->{'TEXT'}</p>\n";
$count++ unless $path eq "";
}
}
print OUT "</div>\n";
}
}
#
sub rssfeed($)
{
my $lang = shift;
my $feedfile = "rssfeed.$lang.xml";
my %dates;
foreach my $file (keys %news) {
my $link = $file;
$link =~ s/.*!//g;
foreach my $date (keys %{$news{$file}}) {
if (defined $news{$file}{$date}{$lang}) {
push @{$dates{$date}},
{
'LINK' => $link,
'TEXT' => $news{$file}{$date}{$lang},
'TITLE'=> $cache{$file}{$lang}{'TITLE'}
};
}
}
}
open FEED, ">$destpath/$feedfile" or die "can't open <$destpath/$feedfile>: $!";
print FEED <<"EOF";
<?xml version="1.0" encoding="ISO-8859-1"?>
<rss version="2.0"
xmlns:dc="http://purl.org/dc/elements/1.1/"
xmlns:content="http://purl.org/rss/1.0/modules/content/"
xmlns:atom="http://www.w3.org/2005/Atom">
<channel>
<atom:link href="$baseurl/$feedfile" rel="self" type="application/rss+xml" />
<title>$rsstitle</title>
<link>$baseurl/index.$lang.html</link>
<description>$rssdescription</description>
<language>$lang</language>
<generator>$version</generator>
EOF
;
if ($rsspicurl) {
print FEED <<"EOF";
<image>
<url>$rsspicurl</url>
<title>$rsstitle</title>
<link>$baseurl/index.$lang.html</link>
<width>$rsspicwidth</width>
<height>$rsspicheight</height>
</image>
EOF
;
}
if (keys %dates) {
my $count = 1;
foreach my $date (reverse sort keys %dates) {
last if $count > $rssmax;
my $datum = strftime("%a, %d %b %Y %H:%M:%S +0000", 0, 0, 12, substr($date,8,2), substr($date,5,2)-1, substr($date,0,4)-1900);
foreach my $elem (@{$dates{$date}}) {
my $guid = md5_hex( $elem->{TEXT} . $elem->{TITLE} . $datum );
print FEED " <item>\n";
print FEED " <title><![CDATA[$sitename - $elem->{'TITLE'}]]></title>\n";
# print FEED " <description>see content</description>\n"; ## TODO
print FEED " <content:encoded>\n<![CDATA[$elem->{'TEXT'}]]></content:encoded>\n";
print FEED " <pubDate>$datum</pubDate>\n";
print FEED " <dc:creator>$author (mailto:$authormail)</dc:creator>\n";
# print FEED " <category domain=\"URL\">category</category>\n"; ## TODO
print FEED " <guid isPermaLink=\"false\">$guid</guid>\n"; ## TODO
print FEED " <link>$baseurl/$elem->{'LINK'}.$lang.html</link>\n";
# print FEED " <comments>URL</comments>\n";
print FEED " </item>\n";
$count++;
last if $count > $rssmax;
}
}
}
print FEED " </channel>\n";
print FEED "</rss>\n";
close FEED or die "can't close <$destpath/$feedfile>: $!";
print " $feedfile\n";
}
#
sub includeSiteMap($)
{
my $lang = shift;
my @oldpath = ("");
my @list = @{$pagestructure{$lang}};
print OUT "<ul>\n";
while (my $page = shift @list) {
my ($path, $file);
if ($page =~ /^(.*)!([^!]*)$/) {
$path = $1;
$file = $2;
} else {
$path = "";
$file = $page;
}
if ($path ne $oldpath[0]) {
if ($path !~ /^$oldpath[0]/) {
while ($path ne $oldpath[0]) {
print OUT "</li></ul></li>\n";
shift @oldpath;
}
} else {
print OUT "<ul>\n";
unshift @oldpath, $path;
}
} else {
print OUT "</li>\n" unless @oldpath == 1;
}
print OUT "<li><a href=\"$file.$lang.html\">$cache{$page}{$lang}{'TITLE'}</a>";
if ($cache{$page}{$lang}{VALID}) {
print OUT " (V)";
}
print OUT "\n";
}
foreach (@oldpath) {
print OUT "</li></ul>\n";
}
}
#
sub CheckISBN($)
{
return 0 unless (my $isbn = $_[0]);
return 0 unless ($isbn =~ /^(\d{9})([\dxX])$/);
my ($nummer, $pruef) = ($1, $2);
my $erg=0;
my $stelle=2;
while ($nummer) {
$erg += (substr $nummer, -1, 1) * $stelle;
$nummer = substr $nummer, 0, length($nummer) - 1;
$stelle++;
}
$erg = 11 - $erg % 11;
if ($erg eq "10") {
$erg = "X";
} elsif ($erg == 11) {
$erg = 0;
}
return ((lc $erg) eq (lc $pruef));
}
#
sub getLeft($$)
{
my ($i, $lang) = @_;
my ($file, $path, @elements) = getStuff($i, $lang);
my $left="";
for (my $j = $i-1; $j >= 0; $j--) {
my @elements = split /!/, $pagestructure{$lang}[$j];
my $file = pop @elements;
if ((join '!', @elements) eq $path) {
$left = $file;
$j = -1;
}
}
return $left;
}
#
sub getRight($$)
{
my ($i, $lang) = @_;
my ($file, $path, @elements) = getStuff($i, $lang);
my $right="";
for (my $j = $i + 1; defined $pagestructure{$lang}[$j]; $j++) {
my @elements = split /!/, $pagestructure{$lang}[$j];
my $file = pop @elements;
if ((join '!', @elements) eq $path) {
$right = $file;
$j = @{$pagestructure{$lang}} + 1;
}
}
return $right;
}
#
sub getStuff($$)
{
my ($i, $lang) = @_;
my @elements = split /!/, $pagestructure{$lang}[$i];
my $file = pop @elements;
my $path = join '!', @elements;
return ($file, $path, @elements);
}
Jump to Line
Something went wrong with that request. Please try again.