#!/usr/bin/perl # $Id: db2html.in,v 1.22 2004/04/19 10:03:53 cjwatson Exp $ # usage: db2html [-diff] [-stampfile=] [-lastrun=] #load the necessary libraries/configuration $config_path = '/etc/debbugs'; $lib_path = '/usr/lib/debbugs'; require("$config_path/config"); require("$config_path/text"); require("$lib_path/errorlib"); $ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'}; use POSIX qw(strftime tzset); $ENV{"TZ"} = 'UTC'; tzset(); #set current working directory chdir("$gSpoolDir") || die "chdir spool: $!\n"; #setup variables $diff = 0; $stampfile = 'stamp.html'; $tail_html = $gHTMLTail; $expirynote_html = ''; $expirynote_html = $gHTMLExpireNote if $gRemoveAge; $shorthead = ' Ref * Package Keywords/Subject Submitter'; $shortindex = ''; $amonths = -1; $indexunmatched = ''; %displayshowpendings = ('pending','outstanding', 'done','resolved', 'forwarded','forwarded to upstream software authors'); #set timestamp for html files $dtime = strftime "%a, %e %b %Y %T UTC", localtime; $tail_html =~ s/SUBSTITUTE_DTIME/$dtime/; #check for commandline switches while (@ARGV && $ARGV[0] =~ m/^-/) { if ($ARGV[0] eq '-diff') { $diff=1; } elsif ($ARGV[0] =~ m/^-lastrun\=([0-9.]+)$/) { $lastrun= $1; undef $stampfile; } elsif ($ARGV[0] =~ m/^-full$/) { undef $lastrun; undef $stampfile; } elsif ($ARGV[0] =~ m/^-stampfile\=(\S+)$/) { $stampfile= $1; } else { die "bad usage"; } shift; } #check for remaing argument, only one... @ARGV==1 or die; $wwwbase= shift(@ARGV); #get starting time defined($startdate= time) || die "failed to get time: $!"; $|=1; #if stamp file was given, if (defined($stampfile)) { if (open(X,"< $stampfile")) { $lastrun= -M X; close(X); printf "progress last run %.7f days\n",$lastrun; } else { print "progress stamp file $stampfile: $! - full\n"; } } #only process file if greater than last run... if (defined($lastrun) && -M "db-h" > $lastrun) { $_= $gHTMLStamp; s/SUBSTITUTE_DTIME/$dtime/o; s/\<\!\-\-updateupdate\-\-\>.*\<\!\-\-\/updateupdate\-\-\>/check/; &file('ix/zstamp.html','non',$_."\n"); print "noremoves"; # print "db2html: no changes since last run\n"; exit 0; } #parse maintainer file open(MM,"$gMaintainerFile") || die "open $gMaintainerFile: $!"; while() { m/^(\S+)\s+(\S.*\S)\s*$/ || die "$gMaintainerFile: \`$_'"; ($a,$b)=($1,$2); $a =~ y/A-Z/a-z/; $maintainer{$a}= $b; } close(MM); #load all database files opendir(D,'db-h') || die "opendir db-h: $!"; @dirs = grep(s#^#db-h/#,grep(/^\d+$/,readdir(D))); closedir(D); foreach my $dir (@dirs) { opendir(D,$dir); push @files, grep(/^-?\d+\.log$/,readdir(D)); closedir(D); } @files = sort { $a <=> $b } @files; for $pending (qw(pending done forwarded)) { for $severity (@showseverities) { eval "\$index${pending}${severity}= \$iiindex${pending}${severity}= ''; 1;" or die "reset \$index${pending}${severity}: $@"; } } for $f (@files) { next unless $f =~ m/^(-?\d+)\.log$/; $ref= $1; #((print STDERR "$ref\n"), #next #) # unless $ref =~ m/^-/ || $ref =~ m/^124/; &filelock("lock/$ref"); $preserveonly= defined($lastrun) && -M "db-h/".get_hashname($ref)."/$ref.log" > $lastrun; if ($ref =~ m/^-\d$/) { $week= $ref eq '-1' ? 'this week' : $ref eq '-2' ? 'last week' : $ref eq '-3' ? 'two weeks ago' : ($ref-1)." weeks ago"; $linkto= "ju/unmatched$ref"; $short= "junk, $week"; $descriptivehead= "This includes messages sent to done\@$gEmailDomain\n". "which did not have a $gBug reference number in the Subject line\n". "or which contained an\n". "unknown or out of date $gBug report number (these cause a warning\n". "to be sent to the sender) and details about the messages\n". "sent to request@$gEmailDomain (all of which". "produce replies).\n"; $indexlink= "Messages not matched to a specific $gBug report - $week"; $data->{subject}= ''; $indexentry= ''; undef $tpack; undef $tmaint; undef $iiref; $tpackfile= "pnone.html"; $indexpart= 'unmatched'; } else { $data=readbug($ref); $_= $data->{package}; y/A-Z/a-z/; $_= $` if m/[^-+._a-z0-9()]/; $tpack= $_; if ($data->{severity} eq '' || $data->{severity} eq 'normal') { $showseverity= ''; $addseverity= $gDefaultSeverity; } elsif (isstrongseverity($data->{severity})) { $showseverity= "Severity: $data->{severity};\n"; $addseverity= $data->{severity}; } else { $showseverity= "Severity: $data->{severity};\n"; $addseverity= $data->{severity}; } $days= int(($startdate - $data->{date})/86400); close(S); $indexlink= "#$ref: ".&sani($data->{subject}); $indexentry= ''; $packfile= length($tpack) ? "pa/l$tpack.html" : "pa/none.html"; $indexentry .= "Package: ". &sani($data->{package}).";\n" if length($data->{package}); $indexentry .= $showseverity; $indexentry .= "Reported by: ".&sani($data->{originator}); $indexentry .= ";\nOwned by: ".&sani($data->{owner}) if length($data->{owner}); $indexentry .= ";\nKeywords: ".&sani($data->{keywords}) if length($data->{keywords}); $linkto= $ref; $linkto =~ s,^..,$&/$&,; @merged= split(/ /,$data->{mergedwith}); if (@merged) { $mseparator= ";\nmerged with "; for $m (@merged) { $mfile= $m; $mfile =~ s,^..,$&/$&,; $indexentry .= $mseparator."#$m"; $mseparator= ",\n"; } } $daysold=$submitted=''; if (length($data->{done})) { $indexentry .= ";\nDone: ".&sani($data->{done}); $indexpart= "done$addseverity"; } elsif (length($data->{forwarded})) { $indexentry .= ";\nForwarded to ".&sani($data->{forwarded}); $indexpart= "forwarded$addseverity"; } else { $cmonths= int($days/30); if ($cmonths != $amonths) { $msg= $cmonths == 0 ? "Submitted in the last month" : $cmonths == 1 ? "Over one month old" : $cmonths == 2 ? "Over two months old - attention is required" : "OVER $cmonths MONTHS OLD - ATTENTION IS REQUIRED"; $shortindex .= "

$msg:

\n$shorthead\n";
                $amonths= $cmonths;
            }
            $pad= 6-length(sprintf("%d",$f));
            $thissient=
                ($pad>0 ? ' 'x$pad : '').
                sprintf("%d",$linkto,$ref).
                &sani(sprintf(" %-1.1s %-10.10s %-35.35s %-.25s\n",
						$data->{severity},
                        $data->{package},
                        (length($data->{keywords}) ? $data->{keywords}.'/' : '').
                        $data->{subject}, $data->{originator}));
            $shortindex.= $thissient;
            $sient{"$ref $data->{package}"}= $thissient;
            if ($days >= 7) 
			{ 	$font= $days <= 30 ? '' :
                	$days <= 60 ? 'em' :
                    'strong';
                $efont= length($font) ? "" : '';
                $font= length($font) ? "<$font>" : '';
                $daysold= "; $font$days days old$efont";
            }
            if ($preserveonly) {
                $submitted = 'THIS IS A BUG IN THE BUG PROCESSOR';
            } else {
                $submitted = strftime "%a, %e %b %Y %T %Z", localtime($data->{date});
            }
            $submitted= "; dated $submitted";
            $indexpart= "pending$addseverity";
        }
        $iiref= $ref;
        $short= $ref; $short =~ s/^\d+/#$&/;
        $tmaint= defined($maintainer{$tpack}) ? $maintainer{$tpack} : '(unknown)';
        $qpackage= &sani($_);
        $descriptivehead= $indexentry.$submitted.";\nMaintainer for $qpackage is\n".
            ''.&sani($tmaint).'.';
        $indexentry .= $daysold;
        $indexentry .= ".";
    }
    $indexadd='';
    $indexadd .= "" if defined($iiref);
    $indexadd .= "
  • ".$indexlink.""; $indexadd .= "
    \n".$indexentry if length($indexentry); $indexadd .= "" if defined($iiref); $indexadd .= "\n"; $estr= "\$index$indexpart = \$indexadd.\$index$indexpart; 1;"; eval($estr) || die "eval add to \$index$indexpart ($estr) failed: $@"; #print STDERR ">$estr|$indexadd<\n"; $indexadd= "\n" if defined($iiref); eval("\$iiindex$indexpart = \$indexadd.\$iiindex$indexpart; 1;") || die "eval add to \$iiindex$indexpart failed: $@"; if (defined($tmaint)) { $countpermaint{$tmaint} += length($data->{done}) ? 0 : length($data->{forwarded}) ? 0 : 1; eval("\$permaint${indexpart}{\$tmaint} .= \$indexadd; 1;") || die "eval add to \$permaint${indexpart}{\$tmaint} failed: $@"; } if (defined($tpack)) { $countperpack{$tpack} += length($data->{done}) ? 0 : length($data->{forwarded}) ? 0 : 1; eval("\$perpack${indexpart}{\$tpack} .= \$indexadd; 1;") || die "eval add to \$perpack${indexpart}{\$tpack} failed: $@"; } if ($preserveonly) { &preserve("$linkto.html"); &preserve("$linkto-b.html"); &unfilelock; next; } my $hash = get_hashname($ref); open(L,"db-h/$hash/$ref.log") || die "open db-h/$hash/$ref.log: $!"; $log=''; $boring=''; $xmessage= 0; $normstate= 'kill-init'; $suppressnext= 0; while() { if (m/^\07$/) { $normstate eq 'kill-init' || $normstate eq 'kill-end' || die "$ref ^G in state $normstate"; $normstate= 'incoming-recv'; } elsif (m/^\01$/) { $normstate eq 'kill-init' || $normstate eq 'kill-end' || die "$ref ^A in state $normstate"; $normstate= 'autocheck'; } elsif (m/^\02$/) { $normstate eq 'kill-init' || $normstate eq 'kill-end' || die "$ref ^B in state $normstate"; $normstate= 'recips'; } elsif (m/^\03$/) { $normstate eq 'go' || $normstate eq 'go-nox' || $normstate eq 'html' || die "$ref ^C in state $normstate"; $this .= "
  • \n" if $normstate eq 'go' || $normstate eq 'go-nox'; if ($normstate eq 'html') { $xmessage++; $this .= " Full text". " available."; } if ($suppressnext && $normstate ne 'html') { $ntis= $this; $ntis =~ s:\:
    :i;
                    $boring .= "
    \n$ntis\n"; } else { $log = $this. "
    \n". $log; } $suppressnext= $normstate eq 'html'; $normstate= 'kill-end'; } elsif (m/^\05$/) { $normstate eq 'kill-body' || die "^E in state $normstate"; $this .= "
    \n";
                $normstate= 'go';
            } elsif (m/^\06$/) {
                $normstate eq 'kill-init' || $normstate eq 'kill-end' ||
                    die "$ref ^F in state $normstate";
                $normstate= 'html'; $this= '';
            } elsif ($normstate eq 'incoming-recv') {
                $pl= $_; $pl =~ s/\n+$//;
                m/^Received: \(at (\S+)\) by (\S+)\;/ ||
                    die "bad line \`$pl' in state incoming-recv";
                $this = "

    Message received at ".&sani("$1\@$2").":


    \n". "
    \n".
                        "$_";
                $normstate= 'go';
            } elsif ($normstate eq 'html') {
                $this .= $_;
            } elsif ($normstate eq 'go') {
                s/^\030//;
                $this .= &sani($_);
            } elsif ($normstate eq 'go-nox') {
                next if !s/^X//;
                $this .= &sani($_);
            } elsif ($normstate eq 'recips') {
                if (m/^-t$/) {
                    $this = "

    Message sent:


    \n"; } else { s/\04/, /g; s/\n$//; $this = "

    Message sent to ".&sani($_).":


    \n"; } $normstate= 'kill-body'; } elsif ($normstate eq 'autocheck') { next if !m/^X-Debian-Bugs(-\w+)?: This is an autoforward from (\S+)/; $normstate= 'autowait'; $this = "

    Message received at $2:


    \n"; } elsif ($normstate eq 'autowait') { next if !m/^$/; $normstate= 'go-nox'; $this .= "
    \n";
            } else {
                die "$ref state $normstate line \`$_'";
            }
        }
        die "$ref state $normstate at end" unless $normstate eq 'kill-end';
        close(L);
        if (length($boring)) {
            &file("$linkto-b.html",'non',
                  "$gProject $gBug report logs - ".
                  "$short, boring messages\n".
                  "\n".
                  "$gHTMLStart

    $gProject $gBugreport logs -". "\n $short,". " boring messages

    \n$boring\n
    \n". $tail_html."\n"); } &file("$linkto.html",'non', "$gProject $gBug report logs - ". "$short\n". "\n". "$gHTMLStart

    $gProject $gBug report logs - $short
    \n". &sani($data->{subject})."

    ". "$descriptivehead\n". "\n
    \n". $log. $tail_html."\n"); &unfilelock; } sub maintsort { $_= $_[0]; s/([^<>()]+) \(([^()<>]+)\)/$2 \<$1\>/; s/\s+/ /g; s/^\s*//; $email= s/ *\<[^<>()]+\>$//g ? $& : ''; $_= "$1 $_" if s/ (\S+)$//; $_.= $email; $_; } sub maintencoded { return $maintencoded{$_[0]} if defined($maintencoded{$_[0]}); local ($input)= @_; local ($todo,$encoded)= ($input); while ($todo =~ m/\W/) { $encoded.=$`.sprintf("-%02x_",unpack("C",$&)); $todo= $'; } $encoded.= $todo; $encoded =~ s/-2e_/\./g; $encoded =~ s/^([^,]+)-20_-3c_(.*)-40_(.*)-3e_/$1,$2,$3,/; $encoded =~ s/^(.*)-40_(.*)-20_-28_([^,]+)-29_$/,$1,$2,$3/; $encoded =~ s/-20_/_/g; $encoded =~ s/-([^_]+)_-/-$1/g; $maintencoded{$input}= $encoded; } for $tmaint (keys %countpermaint) { $_= $tmaint; $after=$before=$sort2d=$sort2s=$sort1d=$sort1s=''; $after= "$&$after" if s/\s*\<[^<>()]+\>\s*$//; $after= "$&$after" if s/\s*\)\s*$//; $after= "$&$after" if s/\s*,.*$//; $before.= $& if s/^.*\(\s*//; $sort2d= $& if s/\S+$//; $sort1d= $_; while (s/^([^()<>]+)\. */$1 /) { }; s/\s+$//; y/A-Za-z/a-zA-Z/; $sort1s= $_; $sort2s= $sort2d; $sort2s =~ y/A-Za-z/a-zA-Z/; $maintsort{$tmaint}= $sort2s.' '.$sort1s.' '.$before.$sort1d.$sort2d.$after; $maintdisplay{$tmaint}= &sani($before).''.&sani($sort1d.$sort2d).''.&sani($after); } sub heading ($$) { my ($pt,$sv) = @_; return $displayshowseverities{$sv}.' - '.$displayshowpendings{$pt}; } sub makeindex ($$$) { my ($varprefix,$varsuffix,$tkey) = @_; my ($pending,$severity,$anydone,$text); $anydone= 0; $text= ''; for $pending (qw(pending forwarded done)) { for $severity (@showseverities) { $estr= "\$value= \\${varprefix}${pending}${severity}${varsuffix}; 1;"; #print STDERR $estr; eval $estr or die "eval get \$${varprefix}${pending}${severity} failed: $@"; #print STDERR ">$$value<\n"; next unless length($$value); $text.= "
    \n

    ".&heading($pending,$severity).":

    \n". "(List of all". " such $gBugs is available.)\n
      \n". $$value. "
    \n"; $anydone=1 if $pending eq 'done'; } } $text.= $expirynote_html if $anydone; return $text; } &file("ix/full.html",'def', $gFullIndex. makeindex('$index',"",''). "
    \n". $tail_html."\n"); &file("ju/junk.html",'non', $gJunkIndex. "
    \n

    Junk (messages without a specific $gBug report number):

    \n". "(\`this week' is everything since last Wednesday.)\n
      \n". $indexunmatched. "

    \n". $tail_html."\n"); $nobugs_html= "No reports are currently in this state."; $who_html= $gProject; $owner_addr= $gMaintainerEmail; $otherindex_html= "For other kinds of index or for other information about $gProject and the $gBug system, see the $gBug system top-level contents WWW page. "; for $pending (qw(pending forwarded done)) { for $severity (@showseverities) { eval "\$value= \\\$iiindex${pending}${severity}; 1;" or die "eval get \$iiindex${pendingtype}${severity} failed: $@"; $value= \$nobugs_html if !length($$value); $headstring= &heading($pending,$severity); &file("si/$pending$severity.html",'ref', "$who_html $gBug reports: $headstring\n". "\n". "$gHTMLStart

    $who_html $gBug reports: $headstring

    \n". $otherindex_html. ($pending eq 'done' ? "

    \n$expirynote_html" : ''). "


    \n
      \n". $$value. "
    \n
    \n". $tail_html."\n"); } } sub individualindexes ($\@&\%&&$$$$$&&) { my ($filename,$keysref,$getfilenameref,$countref,$getdisplayref, $getsimpledisplayref,$what,$caveat,$whatplural,$abbrev,$ihead, $getxinforef,$getxindexref) = @_; my ($itext,$i,$tkey,$sani,$count,$tfilename,$refto,$backnext,$xitext,$bugbugs); $itext=''; for ($i=0; $i<=$#$keysref; $i++) { $tkey= $$keysref[$i]; $tfilename= &$getfilenameref($tkey); $sani= &$getsimpledisplayref($tkey); $count= $$countref{$tkey}; $count= $count >= 1 ? "$count" : "no"; $bugbugs= $count == 1 ? "$gBug" : "$gBugs"; $xitext= &$getxindexref($tkey); $xitext= length($xitext) ? "$count $bugbugs; $xitext" : "$count outstanding $bugbugs"; $itext .= "
  • ".&$getdisplayref($tkey).""."\n". " ($xitext)\n"; $backnext= ''; if ($i>0) { $refto= $$keysref[$i-1]; $xitext= &$getxindexref($refto); $xitext= " ($xitext)" if length($xitext); $backnext .= "
    \nPrevious $what in list, ".&$getdisplayref($refto)."". "$xitext\n"; } if ($i<$#$keysref) { $refto= $$keysref[$i+1]; $xitext= &$getxindexref($refto); $xitext= " ($xitext)" if length($xitext); $backnext .= "
    \nNext $what in list, ".&$getdisplayref($refto)."". "$xitext\n"; } &file($tfilename,'ref', "$gProject $gBug reports: $what $sani\n". "\n". "$gHTMLStart

    $gProject $gBug reports: $what $sani

    \n". &$getxinforef($tkey). $caveat. "See the listing of $whatplural.\n". $backnext. &makeindex("\$per${abbrev}","{\$tkey}",$tkey). "
    \n". $tail_html."\n"); } &file($filename,'non', $ihead. "
      \n". $itext. "

    \n". $tail_html."\n"); } @maintainers= sort { $maintsort{$a} cmp $maintsort{$b}; } keys %countpermaint; individualindexes('ix/maintainers.html', @maintainers, sub { 'ma/l'.&maintencoded($_[0]).'.html'; }, %countpermaint, sub { $maintdisplay{$_[0]}; }, sub { &sani($_[0]); }, 'maintainer', "Note that there may be other reports filed under different variations on the maintainer\'s name and email address.

    ", 'maintainers', 'maint', $gMaintIndex, sub { return ''; }, sub { return ''; }); @packages= sort keys %countperpack; individualindexes('ix/packages.html', @packages, sub { length($_[0]) ? "pa/l$_[0].html" : 'pa/none.html'; }, %countperpack, sub { length($_[0]) ? $_[0] : 'not specified'; }, sub { &sani(length($_[0]) ? $_[0] : 'not specified'); }, 'package', "Note that with multi-binary packages there may be other reports filed under the different binary package names.

    ", 'packages', 'pack', $gPackageIndex, sub { return unless defined($maintainer{$_[0]}); $tmaint= $maintainer{$_[0]}; return "Maintainer for $_[0] is ".&sani($tmaint).".\n

    \n"; }, sub { return unless defined($maintainer{$_[0]}); $tmaint= $maintainer{$_[0]}; return "".&sani($tmaint).""; }); &file('ix/summary.html','non', $gSummaryIndex. "


    \n".
          $shortindex.
          "

    \n". $tail_html."\n"); $bypackageindex=''; for $k (map {$_->[0] } sort { $a->[2] cmp $b->[2] || $a->[1] <=> $b->[1] } map { [$_, split(' ',$_,2)] } keys %sient) { $bypackageindex.= $sient{$k}; } &file('ix/psummary.html','non', $gPackageLog. "
    \n$shorthead\n".
          $bypackageindex.
          "

    \n". $tail_html."\n"); open(P,"$gPseudoDescFile") || die "$gPseudoDescFile: $!"; $ppd=''; while(

    ) { s/\s*\n$//; $ppd.= &sani($_)."\n"; } close(P); &file('ix/pseudopackages.html','non', $gPseudoIndex. "


    \n$ppd".
          "

    \n". $tail_html."\n"); $_= $gHTMLStamp; s/SUBSTITUTE_DTIME/$dtime/o; &file('ix/zstamp.html','non',$_."\n"); sub notimestamp ($) { $_= $_[0]; s/\<\!\-\-timestamp\-\-\>\n.*\n\<\!\-\-\/timestamp\-\-\>\n//; return $_; } sub file { local ($name,$ii,$file)= @_; if ($diff) { $cmppath= "$wwwbase/$name".($ii eq 'ref' ? '.ref' : ''); if (open(ORIG,"$cmppath")) { undef $/; $orig= ; $/= "\n"; close(ORIG); if (¬imestamp($orig) eq ¬imestamp($file)) { print "preserve $name\n"; return; } defined($c= open(P,"-|")) or die "pipe/fork for diff: $!"; if (!$c) { open(Q,"|diff -e $cmppath -") or die "pipe/fork II for diff: $!\n"; print Q $file or die "write orig to diff: $!\n"; close(Q); $?==0 || $?==256 or die "diff gave $?\n"; exit($?>>8); } undef $/; $difftxt=

    ; $/= "\n"; close(P); $?==0 || $?==256 or die "diff fork gave $?\n"; if ($?==0) { print "preserve $name\n"; return; } $v= (split(/\n/,$difftxt)); print "diff $v $ii $name\n${difftxt}thatdiff $name\n" or die "stdout (diff): $!"; return; } } $v= (split(/\n/,$file)); print "file $v $ii $name\n${file}thatfile $name\n" or die "stdout: $!"; } sub preserve { print "preserve $_[0]\n"; } print "end\n"; while ($u= $cleanups[$#cleanups]) { &$u; } exit 0;