5 use POSIX qw(strftime nice);
9 use Debbugs::CGI qw(cgi_parameters);
10 require './common.pl';
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),
19 default => {indexon => 'pkg',
20 repeatmerged => 'yes',
28 if (defined $param{first}) {
29 # rip out all non-words from first
30 $param{first} =~ s/\W//g;
32 if (defined $param{next}) {
33 $param{skip}+=$param{max_results};
35 elsif (defined $param{prev}) {
36 $param{skip}-=$param{max_results};
37 $param{skip} = 0 if $param{skip} < 0;
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");
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");
52 my $Archived = $archive ? " Archived" : "";
54 my %maintainers = %{&getmaintainers()};
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/;
67 if ($indexon eq "pkg") {
69 %count = countbugs(sub {my %d=@_; return splitpackages($d{"pkg"})});
70 if (defined $param{first}) {
72 if (/^\Q$param{first}\E/) {
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)',
87 htmlmaintlinks(sub { $_[0] == 1 ? 'maintainer: '
91 } elsif ($indexon eq "src") {
92 $tag = "source package";
93 my $pkgsrc = getpkgsrc();
94 if (defined $param{first}) {
96 if (/^\Q$param{first}\E/) {
104 %count = countbugs(sub {my %d=@_;
107 } splitpackages($d{"pkg"});
110 foreach my $src (keys %count) {
111 $sortkey{$src} = lc $src;
112 $htmldescrip{$src} = sprintf('<a href="%s">%s</a> (%s)',
115 htmlmaintlinks(sub { $_[0] == 1 ? 'maintainer: '
117 $maintainers{$src}));
119 } elsif ($indexon eq "maint") {
121 my %email2maint = ();
122 %count = countbugs(sub {my %d=@_;
124 my @me = getparsedaddrs($maintainers{$_});
125 foreach my $addr (@me) {
126 $email2maint{$addr->address} = $addr->format
127 unless exists $email2maint{$addr->address};
129 map { $_->address } @me;
130 } splitpackages($d{"pkg"});
132 if (defined $param{first}) {
134 if (/^\Q$param{first}\E/) {
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});
149 } elsif ($indexon eq "submitter") {
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};
158 map { $_->address } @se;
160 if (defined $param{first}) {
162 if (/^\Q$param{first}\E/) {
170 foreach my $sub (keys %count) {
171 $sortkey{$sub} = lc $fullname{$sub};
172 $htmldescrip{$sub} = sprintf('<a href="%s">%s</a>',
174 htmlsanit($fullname{$sub}));
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") {
181 %count = countbugs(sub {my %d=@_; return split ' ', $d{tags}; });
182 if (defined $param{first}) {
184 if (/^\Q$param{first}\E/) {
193 foreach my $keyword (keys %count) {
194 $sortkey{$keyword} = lc $keyword;
195 $htmldescrip{$keyword} = sprintf('<a href="%s">%s</a>',
197 htmlsanit($keyword));
201 my $result = "<ul>\n";
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;
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;
215 $result .= "<li>" . $htmldescrip{$x} . " has $count{$x} " .
216 ($count{$x} == 1 ? "bug" : "bugs") . "</li>\n";
218 $result .= "</ul>\n";
220 print "Content-Type: text/html\n\n";
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" .
226 '<BODY TEXT="#000000" BGCOLOR="#FFFFFF" LINK="#0000FF" VLINK="#800080">' .
228 print "<H1>" . "$debbugs::gProject$Archived $debbugs::gBug report logs by $tag" .
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}">
241 if (defined $param{first}) {
242 print qq(<input type="hidden" name="first" value="$param{first}">\n);
246 if ($param{skip} > 0) {
247 print q(<input type="submit" name="prev" value="Prev">);
249 if (keys %count > ($param{skip} + $param{max_results})) {
250 print q(<input type="submit" name="next" value="Next">);
257 print "<p>$tail_html";
259 print "</body></html>\n";