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