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 $include = $param{'include'} || "";
  27 #my $exclude = $param{'exclude'} || "";
  28
  29 my $Archived = $archive ? "Archived" : "";
  30
  31 my %maintainers = &getmaintainers();
  32 my %strings = ();
  33
  34 $ENV{"TZ"} = 'UTC';
  35 tzset();
  36
  37 my $dtime = strftime "%a, %e %b %Y %T UTC", localtime;
  38 my $tail_html = $debbugs::gHTMLTail;
  39 $tail_html = $debbugs::gHTMLTail;
  40 $tail_html =~ s/SUBSTITUTE_DTIME/$dtime/;
  41
  42 set_option("repeatmerged", $repeatmerged);
  43 set_option("archive", $archive);
  44 #set_option("include", { map {($_,1)} (split /[\s,]+/, $include) })
  45 #       if ($include);
  46 #set_option("exclude", { map {($_,1)} (split /[\s,]+/, $exclude) })
  47 #       if ($exclude);
  48
  49 my %count;
  50 my $tag;
  51 my $note;
  52 my $linksub;
  53 if ($indexon eq "pkg") {
  54   $tag = "package";
  55   %count = countbugs(sub {my %d=@_; return $d{"pkg"}});
  56   $note = "<p>Note that with multi-binary packages there may be other\n";
  57   $note .= "reports filed under the different binary package names.</p>\n";
  58   $linksub = sub {
  59                    my $pkg = shift;
  60                    sprintf('<a href="%s">%s</a> '
  61                             . '(maintained by <a href="%s">%s</a>',
  62                            pkgurl($pkg),
  63                            htmlsanit($pkg),
  64                            mainturl($maintainers{$pkg}),
  65                            htmlsanit($maintainers{$pkg}));
  66                   };
  67 } elsif ($indexon eq "maint") {
  68   $tag = "maintainer";
  69   %count = countbugs(sub {my %d=@_;
  70                           return emailfromrfc822($maintainers{$d{"pkg"}} || "");
  71                          });
  72   $note = "<p>Note that maintainers may use different Maintainer fields for\n";
  73   $note .= "different packages, so there may be other reports filed under\n";
  74   $note .= "different addresses.</p>\n";
  75   $linksub = sub {
  76                    my $maint = shift; my $maintfull = $maint;
  77                    foreach my $x (values %maintainers) {
  78                        if (emailfromrfc822($x) eq $maint) {
  79                           $maintfull = $x; last;
  80                        }
  81                    }
  82                    sprintf('<a href="%s">%s</a>',
  83                            mainturl($maint),
  84                            htmlsanit($maintfull));
  85                   };
  86 } elsif ($indexon eq "submitter") {
  87   $tag = "submitter";
  88   my %fullname = ();
  89   %count = countbugs(sub {my %d=@_; my $f = $d{"submitter"} || "";
  90                           my $em = emailfromrfc822($f);
  91                           $fullname{$em} = $f if (!defined $fullname{$em});
  92                           return $em;
  93                         });
  94   $linksub = sub {
  95                    my $sub = shift;
  96                    sprintf('<a href="%s">%s</a>',
  97                            submitterurl($sub),
  98                            htmlsanit($fullname{$sub}));
  99                   };
 100   $note = "<p>Note that people may use different email accounts for\n";
 101   $note .= "different bugs, so there may be other reports filed under\n";
 102   $note .= "different addresses.</p>\n";
 103 }
 104
 105 my $result = "<ul>\n";
 106 foreach my $x (sort keys %count) {
 107   $result .= "<li>" . $linksub->($x) . " has $count{$x} bugs</li>\n";
 108 }
 109 $result .= "</ul>\n";
 110
 111 print "Content-Type: text/html\n\n";
 112
 113 print "<HTML><HEAD><TITLE>\n" .
 114     "$debbugs::gProject $Archived $debbugs::gBug reports by $tag\n" .
 115     "</TITLE></HEAD>\n" .
 116     '<BODY TEXT="#000000" BGCOLOR="#FFFFFF" LINK="#0000FF" VLINK="#800080">' .
 117     "\n";
 118 print "<H1>" . "$debbugs::gProject $Archived $debbugs::gBug report logs: $tag" .
 119       "</H1>\n";
 120
 121 print $note;
 122 print $result;
 123
 124 print "<hr>\n";
 125 print "$tail_html";
 126
 127 print "</body></html>\n";