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