cgi/pkgindex.cgi

   1 #!/usr/bin/perl -wT
   2
   3 use warnings;
   4 use strict;
   5 use POSIX qw(strftime nice);
   6
   7 # if we're running out of git, we want to use the git base directory as the
   8 # first INC directory. If you're not running out of git, don't do that.
   9 use File::Basename qw(dirname);
  10 use Cwd qw(abs_path);
  11 our $debbugs_dir;
  12 BEGIN {
  13     $debbugs_dir =
  14         abs_path(dirname(abs_path(__FILE__)) . '/../');
  15     # clear the taint; we'll assume that the absolute path to __FILE__ is the
  16     # right path if there's a .git directory there
  17     ($debbugs_dir) = $debbugs_dir =~ /([[:print:]]+)/;
  18     if (defined $debbugs_dir and
  19         -d $debbugs_dir . '/.git/') {
  20     } else {
  21         undef $debbugs_dir;
  22     }
  23     # if the first directory in @INC is not an absolute directory, assume that
  24     # someone has overridden us via -I.
  25     if ($INC[0] !~ /^\//) {
  26     }
  27 }
  28 use if defined $debbugs_dir, lib => $debbugs_dir;
  29
  30 use Debbugs::Config qw(:globals :text :config);
  31 use CGI::Simple;
  32 use Debbugs::CGI qw(:util :url :html);
  33 use Debbugs::Common qw(getmaintainers getparsedaddrs);
  34 use Debbugs::Bugs qw(count_bugs);
  35 use Debbugs::Status qw(:status);
  36 use Debbugs::Packages qw(getpkgsrc);
  37 use Debbugs::Text qw(:templates);
  38
  39 nice(5);
  40
  41 my $q = new CGI::Simple;
  42 my %param = cgi_parameters(query   => $q,
  43                            single  => [qw(indexon repeatmerged archive sortby),
  44                                        qw(skip max_results first),
  45                                       ],
  46                            default => {indexon      => 'pkg',
  47                                        repeatmerged => 'yes',
  48                                        archive      => 'no',
  49                                        sortby       => 'alpha',
  50                                        skip         => 0,
  51                                        max_results  => 100,
  52                                       },
  53                           );
  54
  55 if (defined $param{first}) {
  56      # rip out all non-words from first
  57      $param{first} =~ s/\W//g;
  58 }
  59 if (defined $param{next}) {
  60      $param{skip}+=$param{max_results};
  61 }
  62 elsif (defined $param{prev}) {
  63      $param{skip}-=$param{max_results};
  64      $param{skip} = 0 if $param{skip} < 0;
  65 }
  66
  67 my $indexon = $param{indexon};
  68 if ($param{indexon} !~ m/^(pkg|src|maint|submitter|tag)$/) {
  69     quitcgi("You have to choose something to index on", '400 Bad Request');
  70 }
  71
  72 my $repeatmerged = $param{repeatmerged} eq 'yes';
  73 my $archive = $param{archive} eq "yes";
  74 my $sortby = $param{sortby};
  75 if ($sortby !~ m/^(alpha|count)$/) {
  76     quitcgi("Don't know how to sort like that", '400 Bad Request');
  77 }
  78
  79 my $Archived = $archive ? " Archived" : "";
  80
  81 my %maintainers = %{&getmaintainers()};
  82 my %strings = ();
  83
  84 my $dtime = strftime "%a, %e %b %Y %T UTC", gmtime;
  85
  86 my %count;
  87 my $tag;
  88 my $note;
  89 my %htmldescrip = ();
  90 my %sortkey = ();
  91 if ($indexon eq "pkg") {
  92   $tag = "package";
  93   %count = count_bugs(function => sub {my %d=@_; return splitpackages($d{"pkg"})},
  94                      archive => $archive,
  95                      );
  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   $note = "<p>Note that with multi-binary packages there may be other\n";
 107   $note .= "reports filed under the different binary package names.</p>\n";
 108   foreach my $pkg (keys %count) {
 109     $sortkey{$pkg} = lc $pkg;
 110     $htmldescrip{$pkg} = sprintf('<a href="%s">%s</a> (%s)',
 111                                  package_links(package => $pkg, links_only=>1),
 112                                  html_escape($pkg),
 113                                  package_links(maint=>$maintainers{$pkg}//['']));
 114   }
 115 } elsif ($indexon eq "src") {
 116   $tag = "source package";
 117   my $pkgsrc = getpkgsrc();
 118   if (defined $param{first}) {
 119        %count = map {
 120             if (/^\Q$param{first}\E/) {
 121                  ($_,$count{$_});
 122             }
 123             else {
 124                  ();
 125             }
 126        } keys %count;
 127   }
 128   %count = count_bugs(function => sub {my %d=@_;
 129                           return map {
 130                             $pkgsrc->{$_} || $_
 131                           } splitpackages($d{"pkg"});
 132                          },
 133                      archive => $archive,
 134                      );
 135   $note = "";
 136   foreach my $src (keys %count) {
 137     $sortkey{$src} = lc $src;
 138     $htmldescrip{$src} = sprintf('<a href="%s">%s</a> (%s)',
 139                            package_links(src => $src, links_only=>1),
 140                            html_escape($src),
 141                                  package_links(maint => $maintainers{$src}//['']));
 142   }
 143 } elsif ($indexon eq "maint") {
 144   $tag = "maintainer";
 145   my %email2maint = ();
 146   %count = count_bugs(function => sub {my %d=@_;
 147                           return map {
 148                             my @me = getparsedaddrs($maintainers{$_});
 149                             foreach my $addr (@me) {
 150                               $email2maint{$addr->address} = $addr->format
 151                                 unless exists $email2maint{$addr->address};
 152                             }
 153                             map { $_->address } @me;
 154                           } splitpackages($d{"pkg"});
 155                          },
 156                      archive => $archive,
 157                      );
 158   if (defined $param{first}) {
 159        %count = map {
 160             if (/^\Q$param{first}\E/) {
 161                  ($_,$count{$_});
 162             }
 163             else {
 164                  ();
 165             }
 166        } keys %count;
 167   }
 168   $note = "<p>Note that maintainers may use different Maintainer fields for\n";
 169   $note .= "different packages, so there may be other reports filed under\n";
 170   $note .= "different addresses.</p>\n";
 171   foreach my $maint (keys %count) {
 172     $sortkey{$maint} = lc $email2maint{$maint} || "(unknown)";
 173     $htmldescrip{$maint} = package_links(maint => $email2maint{$maint}//['']);
 174   }
 175 } elsif ($indexon eq "submitter") {
 176   $tag = "submitter";
 177   my %fullname = ();
 178   %count = count_bugs(function => sub {my %d=@_;
 179                           my @se = getparsedaddrs($d{"submitter"} || "");
 180                           foreach my $addr (@se) {
 181                             $fullname{$addr->address} = $addr->format
 182                               unless exists $fullname{$addr->address};
 183                           }
 184                           map { $_->address } @se;
 185                          },
 186                      archive => $archive,
 187                      );
 188   if (defined $param{first}) {
 189        %count = map {
 190             if (/^\Q$param{first}\E/) {
 191                  ($_,$count{$_});
 192             }
 193             else {
 194                  ();
 195             }
 196        } keys %count;
 197   }
 198   foreach my $sub (keys %count) {
 199     $sortkey{$sub} = lc $fullname{$sub};
 200     $htmldescrip{$sub} = sprintf('<a href="%s">%s</a>',
 201                            submitterurl($sub),
 202                            html_escape($fullname{$sub}));
 203   }
 204   $note = "<p>Note that people may use different email accounts for\n";
 205   $note .= "different bugs, so there may be other reports filed under\n";
 206   $note .= "different addresses.</p>\n";
 207 } elsif ($indexon eq "tag") {
 208   $tag = "tag";
 209   %count = count_bugs(function => sub {my %d=@_; return split ' ', $d{tags}; },
 210                       archive => $archive,
 211                      );
 212   if (defined $param{first}) {
 213        %count = map {
 214             if (/^\Q$param{first}\E/) {
 215                  ($_,$count{$_});
 216             }
 217             else {
 218                  ();
 219             }
 220        } keys %count;
 221   }
 222   $note = "";
 223   foreach my $keyword (keys %count) {
 224     $sortkey{$keyword} = lc $keyword;
 225     $htmldescrip{$keyword} = sprintf('<a href="%s">%s</a>',
 226                                tagurl($keyword),
 227                                html_escape($keyword));
 228   }
 229 }
 230
 231 my $result = "<ul>\n";
 232 my @orderedentries;
 233 if ($sortby eq "count") {
 234   @orderedentries = sort { $count{$a} <=> $count{$b} } keys %count;
 235 } else { # sortby alpha
 236   @orderedentries = sort { $sortkey{$a} cmp $sortkey{$b} } keys %count;
 237 }
 238 my $skip = $param{skip};
 239 my $max_results = $param{max_results};
 240 foreach my $x (@orderedentries) {
 241      if (not defined $param{first}) {
 242           $skip-- and next if $skip > 0;
 243           last if --$max_results < 0;
 244      }
 245   $result .= "<li>" . $htmldescrip{$x} . " has $count{$x} " .
 246             ($count{$x} == 1 ? "bug" : "bugs") . "</li>\n";
 247 }
 248 $result .= "</ul>\n";
 249
 250 print "Content-Type: text/html\n\n";
 251
 252 print fill_in_template(template=>'cgi/pkgindex.tmpl',
 253                        variables => {count => \%count,
 254                                      param => \%param,
 255                                      result => $result,
 256                                      html_escape => \&Debbugs::CGI::html_escape,
 257                                      archived => $Archived,
 258                                      note => $note,
 259                                      tag => $tag,
 260                                     },
 261                        hole_var => {'&strftime' => \&POSIX::strftime,
 262                                    },
 263                       );
 264