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