]> git.donarmstrong.com Git - debbugs.git/blob - cgi/pkgindex.cgi
switch to using Require all granted from old Options allow,deny
[debbugs.git] / 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