[project @ 2003-08-06 23:35:55 by cjwatson]

[debbugs.git] / cgi / pkgindex.cgi

diff --git a/cgi/pkgindex.cgi b/cgi/pkgindex.cgi
index f1dea0134a6b2cdf6e14389fdf22538624aab83b..029ecd872b808e30d6f3d271c1edeef3761b0f8d 100755 (executable)
--- a/cgi/pkgindex.cgi
+++ b/cgi/pkgindex.cgi
@@ -6,8 +6,7 @@ use strict;
 use POSIX qw(strftime tzset nice);
 
 #require '/usr/lib/debbugs/errorlib';
-#require '/usr/lib/debbugs/common.pl';
-require '/debian/home/ajt/newajbug/common.pl';
+require './common.pl';
 
 require '/etc/debbugs/config';
 require '/etc/debbugs/text';
@@ -17,23 +16,23 @@ nice(5);
 my %param = readparse();
 
 my $indexon = $param{'indexon'} || 'pkg';
-if ($indexon !~ m/^(pkg|maint|submitter)$/) {
-    quit("You have to choose something to index on");
+if ($indexon !~ m/^(pkg|src|maint|submitter|tag)$/) {
+    quitcgi("You have to choose something to index on");
 }
 
 my $repeatmerged = ($param{'repeatmerged'} || "yes") eq "yes";
 my $archive = ($param{'archive'} || "no") eq "yes";
 my $sortby = $param{'sortby'} || 'alpha';
 if ($sortby !~ m/^(alpha|count)$/) {
-    quit("Don't know how to sort like that");
+    quitcgi("Don't know how to sort like that");
 }
 
 #my $include = $param{'include'} || "";
 #my $exclude = $param{'exclude'} || "";
 
-my $Archived = $archive ? "Archived" : "";
+my $Archived = $archive ? " Archived" : "";
 
-my %maintainers = &getmaintainers();
+my %maintainers = %{&getmaintainers()};
 my %strings = ();
 
 $ENV{"TZ"} = 'UTC';
@@ -58,36 +57,55 @@ my %htmldescrip = ();
 my %sortkey = ();
 if ($indexon eq "pkg") {
   $tag = "package";
-  %count = countbugs(sub {my %d=@_; return $d{"pkg"}});
+  %count = countbugs(sub {my %d=@_; return splitpackages($d{"pkg"})});
   $note = "<p>Note that with multi-binary packages there may be other\n";
   $note .= "reports filed under the different binary package names.</p>\n";
   foreach my $pkg (keys %count) {
     $sortkey{$pkg} = lc $pkg;
-    $htmldescrip{$pkg} = sprintf('<a href="%s">%s</a> ' 
-                           . '(maintainer: <a href="%s">%s</a>)',
+    $htmldescrip{$pkg} = sprintf('<a href="%s">%s</a> (%s)',
                            pkgurl($pkg),
                            htmlsanit($pkg),
-                           mainturl($maintainers{$pkg}),
-                          htmlsanit($maintainers{$pkg} || "(unknown)"));
+                           htmlmaintlinks(sub { $_[0] == 1 ? 'maintainer: '
+                                                           : 'maintainers: ' },
+                                          $maintainers{$pkg}));
+  }
+} elsif ($indexon eq "src") {
+  $tag = "source package";
+  my $pkgsrc = getpkgsrc();
+  %count = countbugs(sub {my %d=@_;
+                          return map {
+                            $pkgsrc->{$_} || $_
+                          } splitpackages($d{"pkg"});
+                         });
+  $note = "";
+  foreach my $src (keys %count) {
+    $sortkey{$src} = lc $src;
+    $htmldescrip{$src} = sprintf('<a href="%s">%s</a> (%s)',
+                           srcurl($src),
+                           htmlsanit($src),
+                           htmlmaintlinks(sub { $_[0] == 1 ? 'maintainer: '
+                                                           : 'maintainers: ' },
+                                          $maintainers{$src}));
   }
 } elsif ($indexon eq "maint") {
   $tag = "maintainer";
-  %count = countbugs(sub {my %d=@_; 
-                          return emailfromrfc822($maintainers{$d{"pkg"}} || "");
-                        });
+  my %email2maint = ();
+  %count = countbugs(sub {my %d=@_;
+                          return map {
+                            my @me = getparsedaddrs($maintainers{$_});
+                            foreach my $addr (@me) {
+                              $email2maint{$addr->address} = $addr->format
+                                unless exists $email2maint{$addr->address};
+                            }
+                            map { $_->address } @me;
+                          } splitpackages($d{"pkg"});
+                         });
   $note = "<p>Note that maintainers may use different Maintainer fields for\n";
   $note .= "different packages, so there may be other reports filed under\n";
   $note .= "different addresses.</p>\n";
-  my %email2maint = ();
-  for my $x (values %maintainers) {
-    my $y = emailfromrfc822($x);
-    $email2maint{$y} = $x unless (defined $email2maint{$y});
-  }
   foreach my $maint (keys %count) {
     $sortkey{$maint} = lc $email2maint{$maint} || "(unknown)";
-    $htmldescrip{$maint} = sprintf('<a href="%s">%s</a>',
-                           mainturl($maint),
-                          htmlsanit($email2maint{$maint}) || "(unknown)")
+    $htmldescrip{$maint} = htmlmaintlinks('', $email2maint{$maint});
   }
 } elsif ($indexon eq "submitter") {
   $tag = "submitter";
@@ -106,6 +124,16 @@ if ($indexon eq "pkg") {
   $note = "<p>Note that people may use different email accounts for\n";
   $note .= "different bugs, so there may be other reports filed under\n";
   $note .= "different addresses.</p>\n";
+} elsif ($indexon eq "tag") {
+  $tag = "tag";
+  %count = countbugs(sub {my %d=@_; return split ' ', $d{tags}; });
+  $note = "";
+  foreach my $keyword (keys %count) {
+    $sortkey{$keyword} = lc $keyword;
+    $htmldescrip{$keyword} = sprintf('<a href="%s">%s</a>',
+                               tagurl($keyword),
+                               htmlsanit($keyword));
+  }
 }
 
 my $result = "<ul>\n";
@@ -123,12 +151,13 @@ $result .= "</ul>\n";
 
 print "Content-Type: text/html\n\n";
 
-print "<HTML><HEAD><TITLE>\n" . 
-    "$debbugs::gProject $Archived $debbugs::gBug reports by $tag\n" .
-    "</TITLE></HEAD>\n" .
+print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n";
+print "<HTML><HEAD>\n" . 
+    "<TITLE>$debbugs::gProject$Archived $debbugs::gBug reports by $tag</TITLE>\n" .
+    "</HEAD>\n" .
     '<BODY TEXT="#000000" BGCOLOR="#FFFFFF" LINK="#0000FF" VLINK="#800080">' .
     "\n";
-print "<H1>" . "$debbugs::gProject $Archived $debbugs::gBug report logs by $tag" .
+print "<H1>" . "$debbugs::gProject$Archived $debbugs::gBug report logs by $tag" .
       "</H1>\n";
 
 print $note;