2 # $Id: db2html.in,v 1.13 2002/12/11 02:15:15 cjwatson Exp $
3 # usage: db2html [-diff] [-stampfile=<stampfile>] [-lastrun=<days>] <wwwbase>
5 #load the necessary libraries/configuration
6 $config_path = '/etc/debbugs';
7 $lib_path = '/usr/lib/debbugs';
9 require("$config_path/config");
10 require("$config_path/text");
11 require("$lib_path/errorlib");
12 $ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
14 #set current working directory
15 chdir("$gSpoolDir") || die "chdir spool: $!\n";
19 $stampfile = 'stamp.html';
20 $tail_html = $gHTMLTail;
21 $expirynote_html = $gHTMLExpireNote;
22 $shorthead = ' Ref * Package Keywords/Subject Submitter';
26 %displayshowpendings = ('pending','outstanding',
28 'forwarded','forwarded to upstream software authors');
30 #set timestamp for html files
31 chop($dtime=`date -u '+%H:%M:%S GMT %a %d %h'`); $? and die $?;
32 $tail_html =~ s/SUBSTITUTE_DTIME/$dtime/;
34 #check for commandline switches
35 while (@ARGV && $ARGV[0] =~ m/^-/)
36 { if ($ARGV[0] eq '-diff') { $diff=1; }
37 elsif ($ARGV[0] =~ m/^-lastrun\=([0-9.]+)$/) { $lastrun= $1; undef $stampfile; }
38 elsif ($ARGV[0] =~ m/^-full$/) { undef $lastrun; undef $stampfile; }
39 elsif ($ARGV[0] =~ m/^-stampfile\=(\S+)$/) { $stampfile= $1; }
40 else { &quit("bad usage"); }
44 #check for remaing argument, only one...
46 $wwwbase= shift(@ARGV);
49 defined($startdate= time) || &quit("failed to get time: $!");
53 #if stamp file was given,
54 if (defined($stampfile))
55 { if (open(X,"< $stampfile"))
58 printf "progress last run %.7f days\n",$lastrun;
59 } else { print "progress stamp file $stampfile: $! - full\n"; }
62 #only process file if greater than last run...
63 if (defined($lastrun) && -M "db-h" > $lastrun)
65 s/SUBSTITUTE_DTIME/$dtime/o;
66 s/\<\!\-\-updateupdate\-\-\>.*\<\!\-\-\/updateupdate\-\-\>/check/;
67 &file('ix/zstamp.html','non',$_."</body></html>\n");
69 # print "db2html: no changes since last run\n";
73 #parse maintainer file
74 open(MM,"$gMaintainerFile") || &quit("open $gMaintainerFile: $!");
76 { m/^(\S+)\s+(\S.*\S)\s*$/ || &quit("$gMaintainerFile: \`$_'");
83 #load all database files
84 opendir(D,'db-h') || &quit("opendir db-h: $!");
85 @dirs = sort { $a <=> $b } grep(s#^#db-h/#,grep(/^\d+$/,readdir(D)));
87 foreach my $dir (@dirs) {
89 push @files, sort { $a <=> $b } grep(/^-?\d+\.log$/,readdir(D));
93 for $pending (qw(pending done forwarded))
94 { for $severity (@showseverities)
95 { eval "\$index${pending}${severity}= \$iiindex${pending}${severity}= ''; 1;"
96 or &quit("reset \$index${pending}${severity}: $@");
101 { next unless $f =~ m/^(-?\d+)\.log$/;
103 #((print STDERR "$ref\n"),
106 # unless $ref =~ m/^-/ || $ref =~ m/^124/;
107 &filelock("lock/$ref");
108 $preserveonly= defined($lastrun) && -M "db-h/".get_hashname($ref)."/$ref.log" > $lastrun;
109 if ($ref =~ m/^-\d$/)
110 { $week= $ref eq '-1' ? 'this week' :
111 $ref eq '-2' ? 'last week' :
112 $ref eq '-3' ? 'two weeks ago' :
113 ($ref-1)." weeks ago";
114 $linkto= "ju/unmatched$ref";
115 $short= "junk, $week";
117 "This includes messages sent to <code>done\@$gEmailDomain</code>\n".
118 "which did not have a $gBug reference number in the Subject line\n".
119 "or which contained an\n".
120 "unknown or out of date $gBug report number (these cause a warning\n".
121 "to be sent to the sender) and details about the messages\n".
122 "sent to <code>request@$gEmailDomain</code> (all of which".
123 "produce replies).\n";
124 $indexlink= "Messages not matched to a specific $gBug report - $week";
130 $tpackfile= "pnone.html";
131 $indexpart= 'unmatched';
134 my $hash = get_hashname($ref);
135 open(S,"db-h/$hash/$ref.status") || &quit("open db-h/$hash/$ref.status: $!");
136 chomp($s_originator= <S>);
138 chomp($s_subject= <S>);
139 chomp($s_msgid= <S>);
140 chomp($s_package= <S>);
141 chomp($s_keywords= <S>);
143 chomp($s_forwarded= <S>);
144 chomp($s_mergedwith= <S>);
145 chomp($s_severity= <S>);
146 $_= $s_package; y/A-Z/a-z/; $_= $` if m/[^-+._a-z0-9()]/;
148 if ($s_severity eq '' || $s_severity eq 'normal')
150 $addseverity= $gDefaultSeverity;
151 } elsif (grep($s_severity eq $_, @strongseverities))
152 { $showseverity= "<strong>Severity: $s_severity</strong>;\n";
153 $addseverity= $s_severity;
155 { $showseverity= "Severity: <em>$s_severity</em>;\n";
156 $addseverity= $s_severity;
158 $days= int(($startdate - $s_date)/86400); close(S);
159 $indexlink= "#$ref: ".&sani($s_subject);
161 $packfile= length($tpack) ? "pa/l$tpack.html" : "pa/none.html";
162 $indexentry .= "Package: <A href=\"../$packfile\"><strong>".
163 &sani($s_package)."</strong></A>;\n"
164 if length($s_package);
165 $indexentry .= $showseverity;
166 $indexentry .= "Reported by: ".&sani($s_originator);
167 $indexentry .= ";\nKeywords: ".&sani($s_keywords)
168 if length($s_keywords);
169 $linkto= $ref; $linkto =~ s,^..,$&/$&,;
170 @merged= split(/ /,$s_mergedwith);
172 { $mseparator= ";\nmerged with ";
174 { $mfile= $m; $mfile =~ s,^..,$&/$&,;
175 $indexentry .= $mseparator."<A href=\"../$mfile.html\">#$m</A>";
179 $daysold=$submitted='';
181 { $indexentry .= ";\n<strong>Done:</strong> ".&sani($s_done);
182 $indexpart= "done$addseverity";
183 } elsif (length($s_forwarded))
184 { $indexentry .= ";\n<strong>Forwarded</strong> to ".&sani($s_forwarded);
185 $indexpart= "forwarded$addseverity";
187 { $cmonths= int($days/30);
188 if ($cmonths != $amonths)
189 { $msg= $cmonths == 0 ? "Submitted in the last month" :
190 $cmonths == 1 ? "Over one month old" :
191 $cmonths == 2 ? "Over two months old - attention is required" :
192 "OVER $cmonths MONTHS OLD - ATTENTION IS REQUIRED";
193 $shortindex .= "</pre><h2>$msg:</h2><pre>\n$shorthead\n";
196 $pad= 6-length(sprintf("%d",$f));
198 ($pad>0 ? ' 'x$pad : '').
199 sprintf("<A href=\"../%s.html\">%d</A>",$linkto,$ref).
200 &sani(sprintf(" %-1.1s %-10.10s %-35.35s %-.25s\n",
203 (length($s_keywords) ? $s_keywords.'/' : '').
204 $s_subject, $s_originator));
205 $shortindex.= $thissient;
206 $sient{"$ref $s_package"}= $thissient;
208 { $font= $days <= 30 ? '' :
211 $efont= length($font) ? "</$font>" : '';
212 $font= length($font) ? "<$font>" : '';
213 $daysold= "; $font$days days old$efont";
215 if ($preserveonly) { $submitted= 'THIS IS A BUG IN THE BUG PROCESSOR'; }
217 { $submitted= `TZ=GMT LANG=C \\
218 date -d '1 Jan 1970 00:00:00 + $s_date seconds' \\
219 '+ %a, %d %b %Y %T %Z'`;
222 $submitted =~ s/\n$//; $submitted =~ s/, 0/, /g;
223 $submitted= "; dated $submitted";
224 $indexpart= "pending$addseverity";
227 $short= $ref; $short =~ s/^\d+/#$&/;
228 $tmaint= defined($maintainer{$tpack}) ? $maintainer{$tpack} : '(unknown)';
229 $qpackage= &sani($_);
230 $descriptivehead= $indexentry.$submitted.";\nMaintainer for $qpackage is\n".
231 '<A href="../ma/l'.&maintencoded($tmaint).'.html">'.&sani($tmaint).'</A>.';
232 $indexentry .= $daysold;
236 $indexadd .= "<!--iid $iiref-->" if defined($iiref);
237 $indexadd .= "<li><A href=\"../$linkto.html\">".$indexlink."</A>";
238 $indexadd .= "<br>\n".$indexentry if length($indexentry);
239 $indexadd .= "<!--/iid-->" if defined($iiref);
241 $estr= "\$index$indexpart = \$indexadd.\$index$indexpart; 1;";
242 eval($estr) || &quit("eval add to \$index$indexpart ($estr) failed: $@");
243 #print STDERR ">$estr|$indexadd<\n";
244 $indexadd= "<!--ii $iiref-->\n" if defined($iiref);
245 eval("\$iiindex$indexpart = \$indexadd.\$iiindex$indexpart; 1;") ||
246 &quit("eval add to \$iiindex$indexpart failed: $@");
247 if (defined($tmaint))
248 { $countpermaint{$tmaint} += length($s_done) ? 0 : length($s_forwarded) ? 0 : 1;
249 eval("\$permaint${indexpart}{\$tmaint} .= \$indexadd; 1;") ||
250 &quit("eval add to \$permaint${indexpart}{\$tmaint} failed: $@");
253 { $countperpack{$tpack} += length($s_done) ? 0 : length($s_forwarded) ? 0 : 1;
254 eval("\$perpack${indexpart}{\$tpack} .= \$indexadd; 1;") ||
255 &quit("eval add to \$perpack${indexpart}{\$tpack} failed: $@");
257 if ($preserveonly) { &preserve("$linkto.html"); &preserve("$linkto-b.html"); &unfilelock; next; }
258 my $hash = get_hashname($ref);
259 open(L,"db-h/$hash/$ref.log") || &quit("open db-h/$hash/$ref.log: $!");
261 $boring=''; $xmessage= 0;
262 $normstate= 'kill-init';
266 $normstate eq 'kill-init' || $normstate eq 'kill-end' ||
267 &quit("$ref ^G in state $normstate");
268 $normstate= 'incoming-recv';
270 $normstate eq 'kill-init' || $normstate eq 'kill-end' ||
271 &quit("$ref ^A in state $normstate");
272 $normstate= 'autocheck';
274 $normstate eq 'kill-init' || $normstate eq 'kill-end' ||
275 &quit("$ref ^B in state $normstate");
276 $normstate= 'recips';
278 $normstate eq 'go' || $normstate eq 'go-nox' || $normstate eq 'html' ||
279 &quit("$ref ^C in state $normstate");
280 $this .= "</pre>\n" if $normstate eq 'go' || $normstate eq 'go-nox';
281 if ($normstate eq 'html') {
283 $this .= " <em><A href=\"../$linkto-b.html#m$xmessage\">Full text</A>".
286 if ($suppressnext && $normstate ne 'html') {
287 $ntis= $this; $ntis =~ s:\<pre\>:</A><pre>:i;
288 $boring .= "<hr><A name=\"m$xmessage\">\n$ntis\n";
290 $log = $this. "<hr>\n". $log;
292 $suppressnext= $normstate eq 'html';
293 $normstate= 'kill-end';
295 $normstate eq 'kill-body' || &quit("^E in state $normstate");
299 $normstate eq 'kill-init' || $normstate eq 'kill-end' ||
300 &quit("$ref ^F in state $normstate");
301 $normstate= 'html'; $this= '';
302 } elsif ($normstate eq 'incoming-recv') {
303 $pl= $_; $pl =~ s/\n+$//;
304 m/^Received: \(at (\S+)\) by (\S+)\;/ ||
305 &quit("bad line \`$pl' in state incoming-recv");
306 $this = "<h2>Message received at ".&sani("$1\@$2").":</h2><br>\n".
310 } elsif ($normstate eq 'html') {
312 } elsif ($normstate eq 'go') {
315 } elsif ($normstate eq 'go-nox') {
318 } elsif ($normstate eq 'recips') {
320 $this = "<h2>Message sent:</h2><br>\n";
323 $this = "<h2>Message sent to ".&sani($_).":</h2><br>\n";
325 $normstate= 'kill-body';
326 } elsif ($normstate eq 'autocheck') {
327 next if !m/^X-Debian-Bugs(-\w+)?: This is an autoforward from (\S+)/;
328 $normstate= 'autowait';
329 $this = "<h2>Message received at $2:</h2><br>\n";
330 } elsif ($normstate eq 'autowait') {
332 $normstate= 'go-nox';
335 &quit("$ref state $normstate line \`$_'");
338 &quit("$ref state $normstate at end") unless $normstate eq 'kill-end';
340 if (length($boring)) {
341 &file("$linkto-b.html",'non',
342 "<html><head><title>$gProject $gBug report logs - ".
343 "$short, boring messages</title>\n".
344 "<link rev=\"made\" href=\"mailto:$gMaintainerEmail)\">\n".
345 "</head>$gHTMLStart<h1>$gProject $gBugreport logs -".
346 "\n <A href=\"../$linkto.html\">$short</A>,".
347 " boring messages</h1>\n$boring\n<hr>\n".
348 $tail_html."</body></html>\n");
350 &file("$linkto.html",'non',
351 "<html><head><title>$gProject $gBug report logs - ".
353 "<link rev=\"made\" href=\"mailto:$gMaintainerEmail\">\n".
354 "</head>$gHTMLStart<h1>$gProject $gBug report logs - $short<br>\n".
355 &sani($s_subject)."</h1>".
356 "$descriptivehead\n".
359 $tail_html."</body></html>\n");
365 s/([^<>()]+) \(([^()<>]+)\)/$2 \<$1\>/;
369 $email= s/ *\<[^<>()]+\>$//g ? $& : '';
370 $_= "$1 $_" if s/ (\S+)$//;
376 return $maintencoded{$_[0]} if defined($maintencoded{$_[0]});
378 local ($todo,$encoded)= ($input);
379 while ($todo =~ m/\W/) {
380 $encoded.=$`.sprintf("-%02x_",unpack("C",$&));
384 $encoded =~ s/-2e_/\./g;
385 $encoded =~ s/^([^,]+)-20_-3c_(.*)-40_(.*)-3e_/$1,$2,$3,/;
386 $encoded =~ s/^(.*)-40_(.*)-20_-28_([^,]+)-29_$/,$1,$2,$3/;
387 $encoded =~ s/-20_/_/g;
388 $encoded =~ s/-([^_]+)_-/-$1/g;
389 $maintencoded{$input}= $encoded;
392 for $tmaint (keys %countpermaint) {
394 $after=$before=$sort2d=$sort2s=$sort1d=$sort1s='';
395 $after= "$&$after" if s/\s*\<[^<>()]+\>\s*$//;
396 $after= "$&$after" if s/\s*\)\s*$//;
397 $after= "$&$after" if s/\s*,.*$//;
398 $before.= $& if s/^.*\(\s*//;
399 $sort2d= $& if s/\S+$//;
401 while (s/^([^()<>]+)\. */$1 /) { };
402 s/\s+$//; y/A-Za-z/a-zA-Z/; $sort1s= $_;
403 $sort2s= $sort2d; $sort2s =~ y/A-Za-z/a-zA-Z/;
404 $maintsort{$tmaint}= $sort2s.' '.$sort1s.' '.$before.$sort1d.$sort2d.$after;
405 $maintdisplay{$tmaint}=
406 &sani($before).'<strong>'.&sani($sort1d.$sort2d).'</strong>'.&sani($after);
411 return $displayshowseverities{$sv}.' - '.$displayshowpendings{$pt};
414 sub makeindex ($$$) {
415 my ($varprefix,$varsuffix,$tkey) = @_;
416 my ($pending,$severity,$anydone,$text);
419 for $pending (qw(pending forwarded done)) {
420 for $severity (@showseverities) {
421 $estr= "\$value= \\${varprefix}${pending}${severity}${varsuffix}; 1;";
424 or &quit("eval get \$${varprefix}${pending}${severity} failed: $@");
425 #print STDERR ">$$value<\n";
426 next unless length($$value);
427 $text.= "<hr>\n<h2>".&heading($pending,$severity).":</h2>\n".
428 "(List of <A href=\"../si/$pending$severity.html\">all".
429 " such $gBugs</A> is available.)\n<ul>\n".
432 $anydone=1 if $pending eq 'done';
435 $text.= $expirynote_html if $anydone;
439 &file("ix/full.html",'def',
441 makeindex('$index',"",'').
443 $tail_html."</body><html>\n");
445 &file("ju/junk.html",'non',
447 "<hr>\n<h2>Junk (messages without a specific $gBug report number):</h2>\n".
448 "(\`this week' is everything since last Wednesday.)\n<ul>\n".
451 $tail_html."</body><html>\n");
453 $nobugs_html= "No reports are currently in this state.";
454 $who_html= $gProject;
455 $owner_addr= $gMaintainerEmail;
456 $otherindex_html= "For other kinds of index or for other information about
457 $gProject and the $gBug system, see the <A HREF=\"../../\">$gBug system top-level
458 contents WWW page</A>.
462 for $pending (qw(pending forwarded done)) {
463 for $severity (@showseverities) {
464 eval "\$value= \\\$iiindex${pending}${severity}; 1;"
465 or &quit("eval get \$iiindex${pendingtype}${severity} failed: $@");
466 $value= \$nobugs_html if !length($$value);
467 $headstring= &heading($pending,$severity);
468 &file("si/$pending$severity.html",'ref',
469 "<html><head><title>$who_html $gBug reports: $headstring</title>\n".
470 "<link rev=\"made\" href=\"mailto:".&sani($owner_addr)."\">\n".
471 "</head>$gHTMLStart<h1>$who_html $gBug reports: $headstring</h1>\n".
473 ($pending eq 'done' ? "<P>\n$expirynote_html" : '').
477 $tail_html."</body></html>\n");
481 sub individualindexes ($\@&\%&&$$$$$&&) {
482 my ($filename,$keysref,$getfilenameref,$countref,$getdisplayref,
483 $getsimpledisplayref,$what,$caveat,$whatplural,$abbrev,$ihead,
484 $getxinforef,$getxindexref) = @_;
485 my ($itext,$i,$tkey,$sani,$count,$tfilename,$refto,$backnext,$xitext,$bugbugs);
487 for ($i=0; $i<=$#$keysref; $i++) {
488 $tkey= $$keysref[$i];
489 $tfilename= &$getfilenameref($tkey);
490 $sani= &$getsimpledisplayref($tkey);
491 $count= $$countref{$tkey};
492 $count= $count >= 1 ? "$count" : "no";
493 $bugbugs= $count == 1 ? "$gBug" : "$gBugs";
494 $xitext= &$getxindexref($tkey);
495 $xitext= length($xitext) ? "$count $bugbugs; $xitext"
496 : "$count outstanding $bugbugs";
497 $itext .= "<li><A href=\"../$tfilename\">".&$getdisplayref($tkey)."</A>"."\n".
501 $refto= $$keysref[$i-1];
502 $xitext= &$getxindexref($refto);
503 $xitext= " ($xitext)" if length($xitext);
504 $backnext .= "<br>\nPrevious $what in list, <A href=\"../".
505 &$getfilenameref($refto)."\">".&$getdisplayref($refto)."</A>".
509 $refto= $$keysref[$i+1];
510 $xitext= &$getxindexref($refto);
511 $xitext= " ($xitext)" if length($xitext);
512 $backnext .= "<br>\nNext $what in list, <A href=\"../".
513 &$getfilenameref($refto)."\">".&$getdisplayref($refto)."</A>".
516 &file($tfilename,'ref',
517 "<html><head><title>$gProject $gBug reports: $what $sani</title>\n".
518 "<link rev=\"made\" href=\"mailto:$gMaintainerEmail\">\n".
519 "</head>$gHTMLStart<h1>$gProject $gBug reports: $what $sani</h1>\n".
520 &$getxinforef($tkey).
522 "See the <A href=\"../$filename\">listing of $whatplural</A>.\n".
524 &makeindex("\$per${abbrev}","{\$tkey}",$tkey).
526 $tail_html."</body></html>\n");
528 &file($filename,'non',
533 $tail_html."</body></html>\n");
536 @maintainers= sort { $maintsort{$a} cmp $maintsort{$b}; } keys %countpermaint;
537 individualindexes('ix/maintainers.html',
539 sub { 'ma/l'.&maintencoded($_[0]).'.html'; },
541 sub { $maintdisplay{$_[0]}; },
542 sub { &sani($_[0]); },
544 "Note that there may be other reports filed under different
545 variations on the maintainer\'s name and email address.<P>",
552 @packages= sort keys %countperpack;
553 individualindexes('ix/packages.html',
555 sub { length($_[0]) ? "pa/l$_[0].html" : 'pa/none.html'; },
557 sub { length($_[0]) ? $_[0] : 'not specified'; },
558 sub { &sani(length($_[0]) ? $_[0] : 'not specified'); },
560 "Note that with multi-binary packages there may be other
561 reports filed under the different binary package names.<P>",
566 return unless defined($maintainer{$_[0]});
567 $tmaint= $maintainer{$_[0]};
568 return "Maintainer for $_[0] is <A href=\"../ma/l".
569 &maintencoded($tmaint).
570 ".html\">".&sani($tmaint)."</A>.\n<p>\n";
573 return unless defined($maintainer{$_[0]});
574 $tmaint= $maintainer{$_[0]};
575 return "<A href=\"../ma/l".
576 &maintencoded($tmaint).
577 ".html\">".&sani($tmaint)."</A>";
580 &file('ix/summary.html','non',
585 $tail_html."</body></html>\n");
588 for $k (map {$_->[0] }
589 sort { $a->[2] cmp $b->[2] || $a->[1] <=> $b->[1] }
590 map { [$_, split(' ',$_,2)] } keys %sient)
591 { $bypackageindex.= $sient{$k}; }
592 &file('ix/psummary.html','non',
594 "<hr><pre>\n$shorthead\n".
597 $tail_html."</body></html>\n");
599 open(P,"$gPseudoDescFile") ||
600 &quit("$gPseudoDescFile: $!");
601 $ppd=''; while(<P>) { s/\s*\n$//; $ppd.= &sani($_)."\n"; } close(P);
602 &file('ix/pseudopackages.html','non',
606 $tail_html."</body></html>\n");
608 $_= $gHTMLStamp; s/SUBSTITUTE_DTIME/$dtime/o;
610 &file('ix/zstamp.html','non',$_."</body></html>\n");
612 sub notimestamp ($) {
614 s/\<\!\-\-timestamp\-\-\>\n.*\n\<\!\-\-\/timestamp\-\-\>\n//;
619 local ($name,$ii,$file)= @_;
621 $cmppath= "$wwwbase/$name".($ii eq 'ref' ? '.ref' : '');
622 if (open(ORIG,"$cmppath")) {
623 undef $/; $orig= <ORIG>; $/= "\n";
625 if (¬imestamp($orig) eq ¬imestamp($file)) {
626 print "preserve $name\n";
629 defined($c= open(P,"-|")) or &quit("pipe/fork for diff: $!");
631 open(Q,"|diff -e $cmppath -") or die "pipe/fork II for diff: $!\n";
632 print Q $file or die "write orig to diff: $!\n";
633 close(Q); $?==0 || $?==256 or die "diff gave $?\n";
636 undef $/; $difftxt= <P>; $/= "\n";
637 close(P); $?==0 || $?==256 or die "diff fork gave $?\n";
639 print "preserve $name\n";
642 $v= (split(/\n/,$difftxt));
643 print "diff $v $ii $name\n${difftxt}thatdiff $name\n"
644 or &quit("stdout (diff): $!");
648 $v= (split(/\n/,$file));
649 print "file $v $ii $name\n${file}thatfile $name\n" or &quit("stdout: $!");
653 print "preserve $_[0]\n";
658 while ($u= $cleanups[$#cleanups]) { &$u; }