cgi/pkgindex.cgi

   1 #!/usr/bin/perl -wT
   2
   3 use warnings;
   4 use strict;
   5 use POSIX qw(strftime nice);
   6
   7 use Debbugs::Config;
   8 use CGI::Simple;
   9 use Debbugs::CGI qw(:util :url :html);
  10 use Debbugs::Common qw(getmaintainers);
  11 use Debbugs::Bugs qw(count_bugs);
  12 use Debbugs::Status qw(:status);
  13
  14 nice(5);
  15
  16 my $q = new CGI::Simple;
  17 my %param = cgi_parameters(query   => $q,
  18                            single  => [qw(indexon repeatmerged archive sortby),
  19                                        qw(skip max_results first),
  20                                       ],
  21                            default => {indexon      => 'pkg',
  22                                        repeatmerged => 'yes',
  23                                        archive      => 'no',
  24                                        sortby       => 'alpha',
  25                                        skip         => 0,
  26                                        max_results  => 100,
  27                                       },
  28                           );
  29
  30 if (defined $param{first}) {
  31      # rip out all non-words from first
  32      $param{first} =~ s/\W//g;
  33 }
  34 if (defined $param{next}) {
  35      $param{skip}+=$param{max_results};
  36 }
  37 elsif (defined $param{prev}) {
  38      $param{skip}-=$param{max_results};
  39      $param{skip} = 0 if $param{skip} < 0;
  40 }
  41
  42 my $indexon = $param{indexon};
  43 if ($param{indexon} !~ m/^(pkg|src|maint|submitter|tag)$/) {
  44     quitcgi("You have to choose something to index on");
  45 }
  46
  47 my $repeatmerged = $param{repeatmerged} eq 'yes';
  48 my $archive = $param{archive} eq "yes";
  49 my $sortby = $param{sortby};
  50 if ($sortby !~ m/^(alpha|count)$/) {
  51     quitcgi("Don't know how to sort like that");
  52 }
  53
  54 my $Archived = $archive ? " Archived" : "";
  55
  56 my %maintainers = %{&getmaintainers()};
  57 my %strings = ();
  58
  59 my $dtime = strftime "%a, %e %b %Y %T UTC", gmtime;
  60 my $tail_html = '';#$gHTMLTail;
  61 $tail_html = '';#$gHTMLTail;
  62 $tail_html =~ s/SUBSTITUTE_DTIME/$dtime/;
  63
  64 my %count;
  65 my $tag;
  66 my $note;
  67 my %htmldescrip = ();
  68 my %sortkey = ();
  69 if ($indexon eq "pkg") {
  70   $tag = "package";
  71   %count = count_bugs(function => sub {my %d=@_; return splitpackages($d{"pkg"})});
  72   if (defined $param{first}) {
  73        %count = map {
  74             if (/^\Q$param{first}\E/) {
  75                  ($_,$count{$_});
  76             }
  77             else {
  78                  ();
  79             }
  80        } keys %count;
  81   }
  82   $note = "<p>Note that with multi-binary packages there may be other\n";
  83   $note .= "reports filed under the different binary package names.</p>\n";
  84   foreach my $pkg (keys %count) {
  85     $sortkey{$pkg} = lc $pkg;
  86     $htmldescrip{$pkg} = sprintf('<a href="%s">%s</a> (%s)',
  87                            pkg_url(pkg => $pkg),
  88                            html_escape($pkg),
  89                            htmlize_maintlinks(sub { $_[0] == 1 ? 'maintainer: '
  90                                                            : 'maintainers: ' },
  91                                           $maintainers{$pkg}));
  92   }
  93 } elsif ($indexon eq "src") {
  94   $tag = "source package";
  95   my $pkgsrc = getpkgsrc();
  96   if (defined $param{first}) {
  97        %count = map {
  98             if (/^\Q$param{first}\E/) {
  99                  ($_,$count{$_});
 100             }
 101             else {
 102                  ();
 103             }
 104        } keys %count;
 105   }
 106   %count = countbugs(function => sub {my %d=@_;
 107                           return map {
 108                             $pkgsrc->{$_} || $_
 109                           } splitpackages($d{"pkg"});
 110                          });
 111   $note = "";
 112   foreach my $src (keys %count) {
 113     $sortkey{$src} = lc $src;
 114     $htmldescrip{$src} = sprintf('<a href="%s">%s</a> (%s)',
 115                            srcurl($src),
 116                            html_escape($src),
 117                            htmlize_maintlinks(sub { $_[0] == 1 ? 'maintainer: '
 118                                                            : 'maintainers: ' },
 119                                           $maintainers{$src}));
 120   }
 121 } elsif ($indexon eq "maint") {
 122   $tag = "maintainer";
 123   my %email2maint = ();
 124   %count = count_bugs(function => sub {my %d=@_;
 125                           return map {
 126                             my @me = getparsedaddrs($maintainers{$_});
 127                             foreach my $addr (@me) {
 128                               $email2maint{$addr->address} = $addr->format
 129                                 unless exists $email2maint{$addr->address};
 130                             }
 131                             map { $_->address } @me;
 132                           } splitpackages($d{"pkg"});
 133                          });
 134   if (defined $param{first}) {
 135        %count = map {
 136             if (/^\Q$param{first}\E/) {
 137                  ($_,$count{$_});
 138             }
 139             else {
 140                  ();
 141             }
 142        } keys %count;
 143   }
 144   $note = "<p>Note that maintainers may use different Maintainer fields for\n";
 145   $note .= "different packages, so there may be other reports filed under\n";
 146   $note .= "different addresses.</p>\n";
 147   foreach my $maint (keys %count) {
 148     $sortkey{$maint} = lc $email2maint{$maint} || "(unknown)";
 149     $htmldescrip{$maint} = htmlize_maintlinks('', $email2maint{$maint});
 150   }
 151 } elsif ($indexon eq "submitter") {
 152   $tag = "submitter";
 153   my %fullname = ();
 154   %count = count_bugs(function => sub {my %d=@_;
 155                           my @se = getparsedaddrs($d{"submitter"} || "");
 156                           foreach my $addr (@se) {
 157                             $fullname{$addr->address} = $addr->format
 158                               unless exists $fullname{$addr->address};
 159                           }
 160                           map { $_->address } @se;
 161                          });
 162   if (defined $param{first}) {
 163        %count = map {
 164             if (/^\Q$param{first}\E/) {
 165                  ($_,$count{$_});
 166             }
 167             else {
 168                  ();
 169             }
 170        } keys %count;
 171   }
 172   foreach my $sub (keys %count) {
 173     $sortkey{$sub} = lc $fullname{$sub};
 174     $htmldescrip{$sub} = sprintf('<a href="%s">%s</a>',
 175                            submitterurl($sub),
 176                            html_escape($fullname{$sub}));
 177   }
 178   $note = "<p>Note that people may use different email accounts for\n";
 179   $note .= "different bugs, so there may be other reports filed under\n";
 180   $note .= "different addresses.</p>\n";
 181 } elsif ($indexon eq "tag") {
 182   $tag = "tag";
 183   %count = count_bugs(function => sub {my %d=@_; return split ' ', $d{tags}; });
 184   if (defined $param{first}) {
 185        %count = map {
 186             if (/^\Q$param{first}\E/) {
 187                  ($_,$count{$_});
 188             }
 189             else {
 190                  ();
 191             }
 192        } keys %count;
 193   }
 194   $note = "";
 195   foreach my $keyword (keys %count) {
 196     $sortkey{$keyword} = lc $keyword;
 197     $htmldescrip{$keyword} = sprintf('<a href="%s">%s</a>',
 198                                tagurl($keyword),
 199                                html_escape($keyword));
 200   }
 201 }
 202
 203 my $result = "<ul>\n";
 204 my @orderedentries;
 205 if ($sortby eq "count") {
 206   @orderedentries = sort { $count{$a} <=> $count{$b} } keys %count;
 207 } else { # sortby alpha
 208   @orderedentries = sort { $sortkey{$a} cmp $sortkey{$b} } keys %count;
 209 }
 210 my $skip = $param{skip};
 211 my $max_results = $param{max_results};
 212 foreach my $x (@orderedentries) {
 213      if (not defined $param{first}) {
 214           $skip-- and next if $skip > 0;
 215           last if --$max_results < 0;
 216      }
 217   $result .= "<li>" . $htmldescrip{$x} . " has $count{$x} " .
 218             ($count{$x} == 1 ? "bug" : "bugs") . "</li>\n";
 219 }
 220 $result .= "</ul>\n";
 221
 222 print "Content-Type: text/html\n\n";
 223
 224 print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n";
 225 print "<HTML><HEAD>\n" .
 226     "<TITLE>$debbugs::gProject$Archived $debbugs::gBug reports by $tag</TITLE>\n" .
 227     "</HEAD>\n" .
 228     '<BODY TEXT="#000000" BGCOLOR="#FFFFFF" LINK="#0000FF" VLINK="#800080">' .
 229     "\n";
 230 print "<H1>" . "$debbugs::gProject$Archived $debbugs::gBug report logs by $tag" .
 231       "</H1>\n";
 232
 233 print $note;
 234 print <<END;
 235 <form>
 236 <input type="hidden" name="skip" value="$param{skip}">
 237 <input type="hidden" name="max_results" value="$param{max_results}">
 238 <input type="hidden" name="indexon" value="$param{indexon}">
 239 <input type="hidden" name="repeatmerged" value="$param{repeatmerged}">
 240 <input type="hidden" name="archive" value="$param{archive}">
 241 <input type="hidden" name="sortby" value="$param{sortby}">
 242 END
 243 if (defined $param{first}) {
 244      print qq(<input type="hidden" name="first" value="$param{first}">\n);
 245 }
 246 else {
 247      print q(<p>);
 248      if ($param{skip} > 0) {
 249           print q(<input type="submit" name="prev" value="Prev">);
 250      }
 251      if (keys %count > ($param{skip} + $param{max_results})) {
 252           print q(<input type="submit" name="next" value="Next">);
 253      }
 254      print qq(</p>\n);
 255 }
 256 print $result;
 257
 258 print "<hr>\n";
 259 print "<p>$tail_html";
 260
 261 print "</body></html>\n";