5 use POSIX qw(strftime nice);
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);
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/') {
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] !~ /^\//) {
28 use if defined $debbugs_dir, lib => $debbugs_dir;
30 use Debbugs::Config qw(:globals :text :config);
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);
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),
46 default => {indexon => 'pkg',
47 repeatmerged => 'yes',
55 if (defined $param{first}) {
56 # rip out all non-words from first
57 $param{first} =~ s/\W//g;
59 if (defined $param{next}) {
60 $param{skip}+=$param{max_results};
62 elsif (defined $param{prev}) {
63 $param{skip}-=$param{max_results};
64 $param{skip} = 0 if $param{skip} < 0;
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');
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');
79 my $Archived = $archive ? " Archived" : "";
81 my %maintainers = %{&getmaintainers()};
84 my $dtime = strftime "%a, %e %b %Y %T UTC", gmtime;
91 if ($indexon eq "pkg") {
93 %count = count_bugs(function => sub {my %d=@_; return splitpackages($d{"pkg"})},
96 if (defined $param{first}) {
98 if (/^\Q$param{first}\E/) {
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),
113 package_links(maint=>$maintainers{$pkg}//['']));
115 } elsif ($indexon eq "src") {
116 $tag = "source package";
117 my $pkgsrc = getpkgsrc();
118 if (defined $param{first}) {
120 if (/^\Q$param{first}\E/) {
128 %count = count_bugs(function => sub {my %d=@_;
131 } splitpackages($d{"pkg"});
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),
141 package_links(maint => $maintainers{$src}//['']));
143 } elsif ($indexon eq "maint") {
145 my %email2maint = ();
146 %count = count_bugs(function => sub {my %d=@_;
148 my @me = getparsedaddrs($maintainers{$_});
149 foreach my $addr (@me) {
150 $email2maint{$addr->address} = $addr->format
151 unless exists $email2maint{$addr->address};
153 map { $_->address } @me;
154 } splitpackages($d{"pkg"});
158 if (defined $param{first}) {
160 if (/^\Q$param{first}\E/) {
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}//['']);
175 } elsif ($indexon eq "submitter") {
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};
184 map { $_->address } @se;
188 if (defined $param{first}) {
190 if (/^\Q$param{first}\E/) {
198 foreach my $sub (keys %count) {
199 $sortkey{$sub} = lc $fullname{$sub};
200 $htmldescrip{$sub} = sprintf('<a href="%s">%s</a>',
202 html_escape($fullname{$sub}));
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") {
209 %count = count_bugs(function => sub {my %d=@_; return split ' ', $d{tags}; },
212 if (defined $param{first}) {
214 if (/^\Q$param{first}\E/) {
223 foreach my $keyword (keys %count) {
224 $sortkey{$keyword} = lc $keyword;
225 $htmldescrip{$keyword} = sprintf('<a href="%s">%s</a>',
227 html_escape($keyword));
231 my $result = "<ul>\n";
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;
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;
245 $result .= "<li>" . $htmldescrip{$x} . " has $count{$x} " .
246 ($count{$x} == 1 ? "bug" : "bugs") . "</li>\n";
248 $result .= "</ul>\n";
250 print "Content-Type: text/html\n\n";
252 print fill_in_template(template=>'cgi/pkgindex.tmpl',
253 variables => {count => \%count,
256 html_escape => \&Debbugs::CGI::html_escape,
257 archived => $Archived,
261 hole_var => {'&strftime' => \&POSIX::strftime,