#!/usr/bin/perl -w use Fcntl ':mode'; use constant DEFODIR => "./out"; # Default output directory use constant DEFLANG => "de"; # Default language use constant BAKLANG => "en"; # Fallback language (only attrs) local %TPLFST = (); # First templates with -s local $ERRNAM = ''; # Filename for error display sub Getopts($) { local($argumentative) = @_; local(@args,$_,$first,$rest); local($errs) = 0; local($[) = 0; @args = split( / */, $argumentative ); while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) { ($first,$rest) = ($1,$2); $pos = index($argumentative,$first); if($pos >= $[) { if($args[$pos+1] eq ':') { shift(@ARGV); if($rest eq '') { ++$errs unless(@ARGV); $rest = shift(@ARGV); } eval " push(\@opt_$first, \$rest); if(\$opt_$first eq '') { \$opt_$first = \$rest; } else { \$opt_$first .= ' ' . \$rest; } "; } else { eval "\$opt_$first = 1"; if($rest eq '') { shift(@ARGV); } else { $ARGV[0] = "-$rest"; } } } else { print STDERR "Unknown option: $first\n"; ++$errs; if($rest ne '') { $ARGV[0] = "-$rest"; } else { shift(@ARGV); } } } $errs == 0; } sub copy_ref { my $src = shift; my $dst = shift; my $lng = shift; my $dstdir = $dst; $dstdir =~ s#[\\\:\/]#/#gs; $dstdir =~ s#(\./)?[^/]+$##s; mkdir($dstdir) if (! -d $dstdir); if ($src =~ m#[\\\/]$#s) { # Special: We reference a directory. Since the OpenWRT # cannot make directory index, we generate one here $ERRNAM = $dst."index.html"; open(IDX, '>'.$ERRNAM) || die("Cannot write ".$ERRNAM); print IDX 'Index of '.$src.''."\n"; print IDX '

Index of '.$src.'

'."\n";
    opendir(DIR, $src) || die("Cannot opendir ".$src);
    while(my $ent = readdir(DIR)) {
      if ($ent ne "index.html") {
        print IDX ''.$ent.'';
        if (-f $src.$ent) {
          @src = stat($src.$ent);
          for(my $i = length($ent); $i <= 40; $i++) {
            print IDX ' ';
          }
          print IDX ' '.$src[7];
          for(my $i = length($src[7]); $i <= 8; $i++) {
            print IDX ' ';
          }
          print IDX ' '.localtime($src[9]);
          copy_ref($src.$ent, $dst.$ent, 0);
        }
        print IDX "\n";
      }
    }
    closedir(DIR);
    print IDX '

'."\n"; close(IDX); } elsif ($src =~ m#\.css$#is) { my ($spt,$dpt) = ($src, $dst); $spt =~ s#[^\\\/\:]+$##s || die; $dpt =~ s#[^\\\/\:]+$##s || die; open(INF, $src) || die("Cannot read css from ".$src); my $css = join('', ); close(INF); $css =~ s#\burl\s*$\s*(([^"'][^$\s]+)|"([^"]+)"|'([^']+)')\s*\)#copy_ref($spt.(defined($3)?$3:$2),$dpt.(defined($3)?$3:$2)),$&#egis; open(OUT, ">".$dst) || die("Cannot write css to ".$dst); print OUT $css; close(OUT); } else { my @src = stat($src); my @dst = stat($dst); if (0 > $#src) { print STDERR "Copy: no ".$src."\n"; } elsif (0 > $#dst || $src[9] > $dst[9]) { #print "Copy $src to $dst\n"; open(INF, $src) || die("Cannot read to copy ".$src); binmode(INF); $_ = join('', ); close(INF); $_ = filter_lang(\$_, '') if ($lng); open(OUT, ">".$dst) || die("Cannot write to copy ".$dst); binmode(OUT); print OUT $_; close(OUT); utime($src[9], $src[9], $dst) || die("Cannot utime($dst)"); chown($src[4], $src[5], $dst) || die("Cannot chown($dst)"); chmod($src[2] & 07777, $dst) || die("Cannot chmod($dst)"); } } } sub work_ref($$$$) { my $ret = shift; my $dir = shift; my $clk = shift; my $lng = shift; if ($ret ne "" && !($ret =~ m#[\\\/\:]$#s) && !($ret =~ m#^\s*[^:]+:#s) && !($ret =~ m#^\s*\##s) && !($ret=~m#^\s*sven\-ola\*ät\*gmx\*de#)) { # This should be a local reference if (!($ret =~ m#\.html?#is) && -e $dir."/".$ret) { my $src = $ret; if (defined($opt_t) && "" ne $opt_t) { my $pat = "(images/)".$opt_t."\\-(intro\\.jpg)\$"; $ret =~ s#$pat#$1$2#is; } copy_ref($dir."/".$src, $opt_o."/".$dir."/".$ret, $lng); # Special for onclick wich popups bigger screenshots if ($clk =~ m#replace\s*$(([^\(]+\([^$]+\))?[^\)]+)#s) { my $clk = $1; if ($clk =~ m#'([^']+)'.*?'([^']+)'#s) { my $s = $1."\$"; my $r = $2; $s =~ s/\\+//gs; $s =~ s/\./\\$&/gs; $_ = $ret; if (s/$s/$r/is) { if (-f $dir."/".$_) { copy_ref($dir."/".$_, $opt_o."/".$dir."/".$_, 0); } else { print STDERR "Copy_ref: no ".$dir."/".$_."\n"; } } } } } elsif(!($ret =~ m#\.html?(\?.*)?$#is) && !($ret =~ m#rrd\-img/%s$#is) && # No msg if rrd link (cube-nylon) !($ret =~ m#cgi\-bin/index$#is)) # No msg if admin link (cube-mtx) { print STDERR "No ".$dir."/".$ret." in ".$ERRNAM."\n"; } } return $ret; } sub work_lang_att($) { my $ret = shift; my @lng = split(/(!([a-z\-]{2,5}):)/io, $ret); my $fnd = ""; my $bak = ""; for(my $i = 1; $i <= $#lng; $i += 3) { if (uc($lng[$i + 1]) eq uc($opt_l)) { $fnd = $lng[0].$lng[$i + 2]; if (defined($opt_p) && $opt_p) { print PRT "$fnd\n"; } } elsif (uc($lng[$i + 1]) eq uc(BAKLANG)) { $bak = $lng[0].$lng[$i + 2]; } } if ("" ne $fnd) { $ret = $fnd; } elsif("" ne $bak) { $ret = $bak; } return $ret; } sub work_att($$$$$$) { my $ret = shift; my $att = shift; my $dir = shift; my $clk = shift; my $lng = shift; my $sep = shift; if ($dir ne '' && ($att =~ m#^(src|href|action|background)$#is)) { $ret = work_ref($ret, $dir, $clk, $lng); } elsif ($att =~ m#^(title|alt|value)$#is) { $ret = work_lang_att($ret); $att_alt = $ret if ($att =~ m#^(alt)$#is); $att_tit = $ret if ($att =~ m#^(title)$#is); } if ($ret =~ s#"#"#gs) { die("Attr with wrong separator: $ret") if ($ret =~ m#'#s); $sep = "'"; } $ret =~ s#>#>#gs; $ret =~ s#<#<#gs; $ret =~ s#&#&#gs; return $sep.$ret.$sep; } sub work_tag($$) { my $ret = shift; my $dir = shift; my $clk = ""; if ($ret =~ m#\bonclick\s*=\s*"([^"]+)"#is) { # Filter warning messages built in to ONCLICK handlers for pictures such as # ONCLICK="if(0<=this.src.search(new RegExp('\\.jpg'))){this.width=368;this.height=446;this.src=this.src.replace(new RegExp('\\.jpg'),'.gif');}else{this.width=123;this.height=149;this.src=this.src.replace(new RegExp('\\.gif'),'.jpg');}return false;" $clk = $1; } if ($ret =~ s#\s+class\s*=\s*"deleteheightwidth"##is) { $ret =~ s#\s+(width|height)\s*=\s*"[^"]*"##igs; } my $lng = ($ret =~ m#\brel\s*=\s*"multilang"#is); local $att_alt = ""; local $att_tit = ""; $ret =~ s#(\b([^\s=>]+)\s*=\s*)((["'])([^\4]*?)\4|(\S+))#$1.(defined($4)?work_att($5, $2, $dir, $clk, $lng, $4):work_att($6, $2, $dir, $clk, $lng, ''))#iegs; if ("" ne $att_alt && "" eq $att_tit) { my $sep=$4; $ret =~ s#(/\s*)?>\s*$# TITLE=$sep$att_alt$sep$&#s; } return $ret; } sub work_link($$) { my $ret = shift; my $dir = shift; if (!($ret =~ m#\bwork\.css#is)) { $ret = work_tag($ret, $dir); } return $ret; } sub work_lang_span($$$) { my $beg = shift; my $txt = shift; my $end = shift; if ($beg =~ s#\s*\blang\s*=\s*((["'])([^\2]*?)\2|(\S+))##is) { my $lng = defined($2)?$3:$4; $lng =~ s#^\s+##s; $lng =~ s#\s+$##s; if (lc($lng) ne lc($opt_l)) { return ''; } if ($beg =~ m#^\s*<\s*span\s*>\s*$#is) { $beg = ''; $end = ''; } } return $beg.$txt.$end; } sub work_onload($$) { my $att = shift; my $ret = shift; if (($att =~ m/^\s*if\s*\(/s) && ($att =~ m/\balert\s*\(/s)) { # Delete the image size alerts for WRT output $ret = ""; } return $ret; } sub del_crlf($) { my $ret = shift; $ret =~ s#[\s\r\n]+# #gs; return $ret; } sub unentity($) { my $ret = shift; $ret =~ s/&#(\d+);/chr($1)/iegs; return $ret; } sub unentity_quotes($) { my $ret = shift; return "&" if (38 == $ret); return "<" if (60 == $ret); return ">" if (62 == $ret); return chr($ret); } sub filter_lang($$) { my $ref = shift; # Reference to source html code my $dir = shift; # Output directory (or '' if unused) my @htm = split(/(<\s*script\b[^>]*>.*?<\s*\/\s*script\b[^>]*>)/is, $$ref); for(my $i = 0; $i <= $#htm; $i++) { if (0 == $i % 2) { $htm[$i] =~ s/ / /igs; @_ = split(/(<[^>]*>)/, $htm[$i]); for(my $j = 0; $j <= $#_; $j+=2) { $_[$j] =~ s/&#(\d+);/unentity_quotes($1)/iegs; } $htm[$i] = join('', @_); # Copy all files in HREF and SRC attributes ($htm[$i] =~ s#<\s*[^\s>]+\b[^>]*>#work_tag($&, $dir)#iegs) if ('' ne $dir); # Filter language and