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                                  package_links(maint=>$maintainers{$pkg}//['']));
  91   }
  92 } elsif ($indexon eq "src") {
  93   $tag = "source package";
  94   my $pkgsrc = getpkgsrc();
  95   if (defined $param{first}) {
  96        %count = map {
  97             if (/^\Q$param{first}\E/) {
  98                  ($_,$count{$_});
  99             }
 100             else {
 101                  ();
 102             }
 103        } keys %count;
 104   }
 105   %count = count_bugs(function => sub {my %d=@_;
 106                           return map {
 107                             $pkgsrc->{$_} || $_
 108                           } splitpackages($d{"pkg"});
 109                          },
 110                      archive => $archive,
 111                      );
 112   $note = "";
 113   foreach my $src (keys %count) {
 114     $sortkey{$src} = lc $src;
 115     $htmldescrip{$src} = sprintf('<a href="%s">%s</a> (%s)',
 116                            package_links(src => $src, links_only=>1),
 117                            html_escape($src),
 118                                  package_links(maint => $maintainers{$src}//['']));
 119   }
 120 } elsif ($indexon eq "maint") {
 121   $tag = "maintainer";
 122   my %email2maint = ();
 123   %count = count_bugs(function => sub {my %d=@_;
 124                           return map {
 125                             my @me = getparsedaddrs($maintainers{$_});
 126                             foreach my $addr (@me) {
 127                               $email2maint{$addr->address} = $addr->format
 128                                 unless exists $email2maint{$addr->address};
 129                             }
 130                             map { $_->address } @me;
 131                           } splitpackages($d{"pkg"});
 132                          },
 133                      archive => $archive,
 134                      );
 135   if (defined $param{first}) {
 136        %count = map {
 137             if (/^\Q$param{first}\E/) {
 138                  ($_,$count{$_});
 139             }
 140             else {
 141                  ();
 142             }
 143        } keys %count;
 144   }
 145   $note = "<p>Note that maintainers may use different Maintainer fields for\n";
 146   $note .= "different packages, so there may be other reports filed under\n";
 147   $note .= "different addresses.</p>\n";
 148   foreach my $maint (keys %count) {
 149     $sortkey{$maint} = lc $email2maint{$maint} || "(unknown)";
 150     $htmldescrip{$maint} = package_links(maint => $email2maint{$maint}//['']);
 151   }
 152 } elsif ($indexon eq "submitter") {
 153   $tag = "submitter";
 154   my %fullname = ();
 155   %count = count_bugs(function => sub {my %d=@_;
 156                           my @se = getparsedaddrs($d{"submitter"} || "");
 157                           foreach my $addr (@se) {
 158                             $fullname{$addr->address} = $addr->format
 159                               unless exists $fullname{$addr->address};
 160                           }
 161                           map { $_->address } @se;
 162                          },
 163                      archive => $archive,
 164                      );
 165   if (defined $param{first}) {
 166        %count = map {
 167             if (/^\Q$param{first}\E/) {
 168                  ($_,$count{$_});
 169             }
 170             else {
 171                  ();
 172             }
 173        } keys %count;
 174   }
 175   foreach my $sub (keys %count) {
 176     $sortkey{$sub} = lc $fullname{$sub};
 177     $htmldescrip{$sub} = sprintf('<a href="%s">%s</a>',
 178                            submitterurl($sub),
 179                            html_escape($fullname{$sub}));
 180   }
 181   $note = "<p>Note that people may use different email accounts for\n";
 182   $note .= "different bugs, so there may be other reports filed under\n";
 183   $note .= "different addresses.</p>\n";
 184 } elsif ($indexon eq "tag") {
 185   $tag = "tag";
 186   %count = count_bugs(function => sub {my %d=@_; return split ' ', $d{tags}; },
 187                       archive => $archive,
 188                      );
 189   if (defined $param{first}) {
 190        %count = map {
 191             if (/^\Q$param{first}\E/) {
 192                  ($_,$count{$_});
 193             }
 194             else {
 195                  ();
 196             }
 197        } keys %count;
 198   }
 199   $note = "";
 200   foreach my $keyword (keys %count) {
 201     $sortkey{$keyword} = lc $keyword;
 202     $htmldescrip{$keyword} = sprintf('<a href="%s">%s</a>',
 203                                tagurl($keyword),
 204                                html_escape($keyword));
 205   }
 206 }
 207
 208 my $result = "<ul>\n";
 209 my @orderedentries;
 210 if ($sortby eq "count") {
 211   @orderedentries = sort { $count{$a} <=> $count{$b} } keys %count;
 212 } else { # sortby alpha
 213   @orderedentries = sort { $sortkey{$a} cmp $sortkey{$b} } keys %count;
 214 }
 215 my $skip = $param{skip};
 216 my $max_results = $param{max_results};
 217 foreach my $x (@orderedentries) {
 218      if (not defined $param{first}) {
 219           $skip-- and next if $skip > 0;
 220           last if --$max_results < 0;
 221      }
 222   $result .= "<li>" . $htmldescrip{$x} . " has $count{$x} " .
 223             ($count{$x} == 1 ? "bug" : "bugs") . "</li>\n";
 224 }
 225 $result .= "</ul>\n";
 226
 227 print "Content-Type: text/html\n\n";
 228
 229 print fill_in_template(template=>'cgi/pkgindex.tmpl',
 230                        variables => {count => \%count,
 231                                      param => \%param,
 232                                      result => $result,
 233                                      html_escape => \&Debbugs::CGI::html_escape,
 234                                      archived => $Archived,
 235                                      note => $note,
 236                                      tag => $tag,
 237                                     },
 238                        hole_var => {'&strftime' => \&POSIX::strftime,
 239                                    },
 240                       );
 241