X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=cgi%2Fpkgindex.cgi;h=f0ac8d0b6c86b486ea4c8b993e4777adf155e906;hb=20eecdf58e4962a4d1a6042eacd0ed6abbd28e15;hp=6654ef2743d5ced4d3498c089a34d22845856bbe;hpb=64ffc95ed7a3b149782675d45915258a7302e96e;p=debbugs.git diff --git a/cgi/pkgindex.cgi b/cgi/pkgindex.cgi index 6654ef2..f0ac8d0 100755 --- a/cgi/pkgindex.cgi +++ b/cgi/pkgindex.cgi @@ -1,54 +1,87 @@ #!/usr/bin/perl -wT -package debbugs; - +use warnings; use strict; -use POSIX qw(strftime tzset nice); +use POSIX qw(strftime nice); -#require '/usr/lib/debbugs/errorlib'; -require './common.pl'; +# if we're running out of git, we want to use the git base directory as the +# first INC directory. If you're not running out of git, don't do that. +use File::Basename qw(dirname); +use Cwd qw(abs_path); +our $debbugs_dir; +BEGIN { + $debbugs_dir = + abs_path(dirname(abs_path(__FILE__)) . '/../'); + # clear the taint; we'll assume that the absolute path to __FILE__ is the + # right path if there's a .git directory there + ($debbugs_dir) = $debbugs_dir =~ /([[:print:]]+)/; + if (defined $debbugs_dir and + -d $debbugs_dir . '/.git/') { + } else { + undef $debbugs_dir; + } + # if the first directory in @INC is not an absolute directory, assume that + # someone has overridden us via -I. + if ($INC[0] !~ /^\//) { + } +} +use if defined $debbugs_dir, lib => $debbugs_dir.'/lib/'; -require '/etc/debbugs/config'; -require '/etc/debbugs/text'; +use Debbugs::Config qw(:globals :text :config); +use CGI::Simple; +use Debbugs::CGI qw(:util :url :html); +use Debbugs::Common qw(getmaintainers getparsedaddrs); +use Debbugs::Bugs qw(count_bugs); +use Debbugs::Status qw(:status); +use Debbugs::Packages qw(getpkgsrc); +use Debbugs::Text qw(:templates); nice(5); -my %param = readparse(); +my $q = new CGI::Simple; +my %param = cgi_parameters(query => $q, + single => [qw(indexon repeatmerged archive sortby), + qw(skip max_results first), + ], + default => {indexon => 'pkg', + repeatmerged => 'yes', + archive => 'no', + sortby => 'alpha', + skip => 0, + max_results => 100, + }, + ); -my $indexon = $param{'indexon'} || 'pkg'; -if ($indexon !~ m/^(pkg|maint|submitter)$/) { - quitcgi("You have to choose something to index on"); +if (defined $param{first}) { + # rip out all non-words from first + $param{first} =~ s/\W//g; +} +if (defined $param{next}) { + $param{skip}+=$param{max_results}; +} +elsif (defined $param{prev}) { + $param{skip}-=$param{max_results}; + $param{skip} = 0 if $param{skip} < 0; } -my $repeatmerged = ($param{'repeatmerged'} || "yes") eq "yes"; -my $archive = ($param{'archive'} || "no") eq "yes"; -my $sortby = $param{'sortby'} || 'alpha'; -if ($sortby !~ m/^(alpha|count)$/) { - quitcgi("Don't know how to sort like that"); +my $indexon = $param{indexon}; +if ($param{indexon} !~ m/^(pkg|src|maint|submitter|tag)$/) { + quitcgi("You have to choose something to index on", '400 Bad Request'); } -#my $include = $param{'include'} || ""; -#my $exclude = $param{'exclude'} || ""; +my $repeatmerged = $param{repeatmerged} eq 'yes'; +my $archive = $param{archive} eq "yes"; +my $sortby = $param{sortby}; +if ($sortby !~ m/^(alpha|count)$/) { + quitcgi("Don't know how to sort like that", '400 Bad Request'); +} my $Archived = $archive ? " Archived" : ""; my %maintainers = %{&getmaintainers()}; my %strings = (); -$ENV{"TZ"} = 'UTC'; -tzset(); - -my $dtime = strftime "%a, %e %b %Y %T UTC", localtime; -my $tail_html = $debbugs::gHTMLTail; -$tail_html = $debbugs::gHTMLTail; -$tail_html =~ s/SUBSTITUTE_DTIME/$dtime/; - -set_option("repeatmerged", $repeatmerged); -set_option("archive", $archive); -#set_option("include", { map {($_,1)} (split /[\s,]+/, $include) }) -# if ($include); -#set_option("exclude", { map {($_,1)} (split /[\s,]+/, $exclude) }) -# if ($exclude); +my $dtime = strftime "%a, %e %b %Y %T UTC", gmtime; my %count; my $tag; @@ -57,56 +90,142 @@ my %htmldescrip = (); my %sortkey = (); if ($indexon eq "pkg") { $tag = "package"; - %count = countbugs(sub {my %d=@_; return splitpackages($d{"pkg"})}); + %count = count_bugs(function => sub {my %d=@_; return splitpackages($d{"pkg"})}, + archive => $archive, + ); + if (defined $param{first}) { + %count = map { + if (/^\Q$param{first}\E/) { + ($_,$count{$_}); + } + else { + (); + } + } keys %count; + } $note = "

Note that with multi-binary packages there may be other\n"; $note .= "reports filed under the different binary package names.

\n"; foreach my $pkg (keys %count) { $sortkey{$pkg} = lc $pkg; - $htmldescrip{$pkg} = sprintf('%s ' - . '(maintainer: %s)', - pkgurl($pkg), - htmlsanit($pkg), - mainturl($maintainers{$pkg}), - htmlsanit($maintainers{$pkg} || "(unknown)")); + $htmldescrip{$pkg} = sprintf('%s (%s)', + package_links(package => $pkg, links_only=>1), + html_escape($pkg), + package_links(maint=>$maintainers{$pkg}//[''])); + } +} elsif ($indexon eq "src") { + $tag = "source package"; + my $pkgsrc = getpkgsrc(); + if (defined $param{first}) { + %count = map { + if (/^\Q$param{first}\E/) { + ($_,$count{$_}); + } + else { + (); + } + } keys %count; + } + %count = count_bugs(function => sub {my %d=@_; + return map { + $pkgsrc->{$_} || $_ + } splitpackages($d{"pkg"}); + }, + archive => $archive, + ); + $note = ""; + foreach my $src (keys %count) { + $sortkey{$src} = lc $src; + $htmldescrip{$src} = sprintf('%s (%s)', + package_links(src => $src, links_only=>1), + html_escape($src), + package_links(maint => $maintainers{$src}//[''])); } } elsif ($indexon eq "maint") { $tag = "maintainer"; - %count = countbugs(sub {my %d=@_; + my %email2maint = (); + %count = count_bugs(function => sub {my %d=@_; return map { - emailfromrfc822($maintainers{$_}) || () + my @me = getparsedaddrs($maintainers{$_}); + foreach my $addr (@me) { + $email2maint{$addr->address} = $addr->format + unless exists $email2maint{$addr->address}; + } + map { $_->address } @me; } splitpackages($d{"pkg"}); - }); + }, + archive => $archive, + ); + if (defined $param{first}) { + %count = map { + if (/^\Q$param{first}\E/) { + ($_,$count{$_}); + } + else { + (); + } + } keys %count; + } $note = "

Note that maintainers may use different Maintainer fields for\n"; $note .= "different packages, so there may be other reports filed under\n"; $note .= "different addresses.

\n"; - my %email2maint = (); - for my $x (values %maintainers) { - my $y = emailfromrfc822($x); - $email2maint{$y} = $x unless (defined $email2maint{$y}); - } foreach my $maint (keys %count) { $sortkey{$maint} = lc $email2maint{$maint} || "(unknown)"; - $htmldescrip{$maint} = sprintf('%s', - mainturl($maint), - htmlsanit($email2maint{$maint}) || "(unknown)") + $htmldescrip{$maint} = package_links(maint => $email2maint{$maint}//['']); } } elsif ($indexon eq "submitter") { $tag = "submitter"; my %fullname = (); - %count = countbugs(sub {my %d=@_; my $f = $d{"submitter"} || ""; - my $em = emailfromrfc822($f); - $fullname{$em} = $f if (!defined $fullname{$em}); - return $em; - }); + %count = count_bugs(function => sub {my %d=@_; + my @se = getparsedaddrs($d{"submitter"} || ""); + foreach my $addr (@se) { + $fullname{$addr->address} = $addr->format + unless exists $fullname{$addr->address}; + } + map { $_->address } @se; + }, + archive => $archive, + ); + if (defined $param{first}) { + %count = map { + if (/^\Q$param{first}\E/) { + ($_,$count{$_}); + } + else { + (); + } + } keys %count; + } foreach my $sub (keys %count) { $sortkey{$sub} = lc $fullname{$sub}; $htmldescrip{$sub} = sprintf('%s', submitterurl($sub), - htmlsanit($fullname{$sub})); + html_escape($fullname{$sub})); } $note = "

Note that people may use different email accounts for\n"; $note .= "different bugs, so there may be other reports filed under\n"; $note .= "different addresses.

\n"; +} elsif ($indexon eq "tag") { + $tag = "tag"; + %count = count_bugs(function => sub {my %d=@_; return split ' ', $d{tags}; }, + archive => $archive, + ); + if (defined $param{first}) { + %count = map { + if (/^\Q$param{first}\E/) { + ($_,$count{$_}); + } + else { + (); + } + } keys %count; + } + $note = ""; + foreach my $keyword (keys %count) { + $sortkey{$keyword} = lc $keyword; + $htmldescrip{$keyword} = sprintf('%s', + tagurl($keyword), + html_escape($keyword)); + } } my $result = "\n"; print "Content-Type: text/html\n\n"; -print "\n"; -print "\n" . - "$debbugs::gProject$Archived $debbugs::gBug reports by $tag\n" . - "\n" . - '' . - "\n"; -print "

" . "$debbugs::gProject$Archived $debbugs::gBug report logs by $tag" . - "

\n"; - -print $note; -print $result; - -print "
\n"; -print "$tail_html"; +print fill_in_template(template=>'cgi/pkgindex.tmpl', + variables => {count => \%count, + param => \%param, + result => $result, + html_escape => \&Debbugs::CGI::html_escape, + archived => $Archived, + note => $note, + tag => $tag, + }, + hole_var => {'&strftime' => \&POSIX::strftime, + }, + ); -print "\n";