cgi/pkgindex.cgi

   1 #!/usr/bin/perl -wT
   2
   3 package debbugs;
   4
   5 use strict;
   6 use POSIX qw(strftime tzset nice);
   7
   8 #require '/usr/lib/debbugs/errorlib';
   9 #require '/usr/lib/debbugs/common.pl';
  10 require '/debian/home/ajt/newajbug/common.pl';
  11
  12 require '/etc/debbugs/config';
  13 require '/etc/debbugs/text';
  14
  15 nice(5);
  16
  17 my %param = readparse();
  18
  19 my $indexon = $param{'indexon'} || 'pkg';
  20 if ($indexon !~ m/^(pkg|maint|submitter)$/) {
  21     quit("You have to choose something to index on");
  22 }
  23
  24 my $repeatmerged = ($param{'repeatmerged'} || "yes") eq "yes";
  25 my $archive = ($param{'archive'} || "no") eq "yes";
  26 my $sortby = $param{'sortby'} || 'alpha';
  27 if ($sortby !~ m/^(alpha|count)$/) {
  28     quit("Don't know how to sort like that");
  29 }
  30
  31 #my $include = $param{'include'} || "";
  32 #my $exclude = $param{'exclude'} || "";
  33
  34 my $Archived = $archive ? "Archived" : "";
  35
  36 my %maintainers = &getmaintainers();
  37 my %strings = ();
  38
  39 $ENV{"TZ"} = 'UTC';
  40 tzset();
  41
  42 my $dtime = strftime "%a, %e %b %Y %T UTC", localtime;
  43 my $tail_html = $debbugs::gHTMLTail;
  44 $tail_html = $debbugs::gHTMLTail;
  45 $tail_html =~ s/SUBSTITUTE_DTIME/$dtime/;
  46
  47 set_option("repeatmerged", $repeatmerged);
  48 set_option("archive", $archive);
  49 #set_option("include", { map {($_,1)} (split /[\s,]+/, $include) })
  50 #       if ($include);
  51 #set_option("exclude", { map {($_,1)} (split /[\s,]+/, $exclude) })
  52 #       if ($exclude);
  53
  54 my %count;
  55 my $tag;
  56 my $note;
  57 my %htmldescrip = ();
  58 my %sortkey = ();
  59 if ($indexon eq "pkg") {
  60   $tag = "package";
  61   %count = countbugs(sub {my %d=@_; return $d{"pkg"}});
  62   $note = "<p>Note that with multi-binary packages there may be other\n";
  63   $note .= "reports filed under the different binary package names.</p>\n";
  64   foreach my $pkg (keys %count) {
  65     $sortkey{$pkg} = lc $pkg;
  66     $htmldescrip{$pkg} = sprintf('<a href="%s">%s</a> '
  67                            . '(maintainer: <a href="%s">%s</a>)',
  68                            pkgurl($pkg),
  69                            htmlsanit($pkg),
  70                            mainturl($maintainers{$pkg}),
  71                            htmlsanit($maintainers{$pkg} || "(unknown)"));
  72   }
  73 } elsif ($indexon eq "maint") {
  74   $tag = "maintainer";
  75   %count = countbugs(sub {my %d=@_;
  76                           return emailfromrfc822($maintainers{$d{"pkg"}} || "");
  77                          });
  78   $note = "<p>Note that maintainers may use different Maintainer fields for\n";
  79   $note .= "different packages, so there may be other reports filed under\n";
  80   $note .= "different addresses.</p>\n";
  81   my %email2maint = ();
  82   for my $x (values %maintainers) {
  83     my $y = emailfromrfc822($x);
  84     $email2maint{$y} = $x unless (defined $email2maint{$y});
  85   }
  86   foreach my $maint (keys %count) {
  87     $sortkey{$maint} = lc $email2maint{$maint} || "(unknown)";
  88     $htmldescrip{$maint} = sprintf('<a href="%s">%s</a>',
  89                            mainturl($maint),
  90                            htmlsanit($email2maint{$maint}) || "(unknown)")
  91   }
  92 } elsif ($indexon eq "submitter") {
  93   $tag = "submitter";
  94   my %fullname = ();
  95   %count = countbugs(sub {my %d=@_; my $f = $d{"submitter"} || "";
  96                           my $em = emailfromrfc822($f);
  97                           $fullname{$em} = $f if (!defined $fullname{$em});
  98                           return $em;
  99                         });
 100   foreach my $sub (keys %count) {
 101     $sortkey{$sub} = lc $fullname{$sub};
 102     $htmldescrip{$sub} = sprintf('<a href="%s">%s</a>',
 103                            submitterurl($sub),
 104                            htmlsanit($fullname{$sub}));
 105   }
 106   $note = "<p>Note that people may use different email accounts for\n";
 107   $note .= "different bugs, so there may be other reports filed under\n";
 108   $note .= "different addresses.</p>\n";
 109 }
 110
 111 my $result = "<ul>\n";
 112 my @orderedentries;
 113 if ($sortby eq "count") {
 114   @orderedentries = sort { $count{$a} <=> $count{$b} } keys %count;
 115 } else { # sortby alpha
 116   @orderedentries = sort { $sortkey{$a} cmp $sortkey{$b} } keys %count;
 117 }
 118 foreach my $x (@orderedentries) {
 119   $result .= "<li>" . $htmldescrip{$x} . " has $count{$x} " .
 120             ($count{$x} == 1 ? "bug" : "bugs") . "</li>\n";
 121 }
 122 $result .= "</ul>\n";
 123
 124 print "Content-Type: text/html\n\n";
 125
 126 print "<HTML><HEAD><TITLE>\n" .
 127     "$debbugs::gProject $Archived $debbugs::gBug reports by $tag\n" .
 128     "</TITLE></HEAD>\n" .
 129     '<BODY TEXT="#000000" BGCOLOR="#FFFFFF" LINK="#0000FF" VLINK="#800080">' .
 130     "\n";
 131 print "<H1>" . "$debbugs::gProject $Archived $debbugs::gBug report logs by $tag" .
 132       "</H1>\n";
 133
 134 print $note;
 135 print $result;
 136
 137 print "<hr>\n";
 138 print "$tail_html";
 139
 140 print "</body></html>\n";