X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=cgi%2Fpkgreport.cgi;h=455df20cea2896c7f2645c601d59a14584ce50a4;hb=1a1fa6f0af2be9d4076d9aad5f5a84c5fb3d9a8a;hp=afbf4a6351b8ee1d129e0735a6091191ac5d687f;hpb=8c9417056a775f796601bc078246de4699355278;p=debbugs.git diff --git a/cgi/pkgreport.cgi b/cgi/pkgreport.cgi index afbf4a6..455df20 100755 --- a/cgi/pkgreport.cgi +++ b/cgi/pkgreport.cgi @@ -1,33 +1,140 @@ #!/usr/bin/perl -wT - -package debbugs; - +# This script is part of debbugs, and is released +# under the terms of the GPL version 2, or any later +# version at your option. +# See the file README and COPYING for more information. +# +# [Other people have contributed to this file; their copyrights should +# go here too.] +# Copyright 2004-2006 by Anthony Towns +# Copyright 2007 by Don Armstrong . + + +use warnings; use strict; -use POSIX qw(strftime tzset nice); -#require '/usr/lib/debbugs/errorlib'; -require './common.pl'; +# Sanitize environent for taint +BEGIN{ + delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; +} + +binmode(STDOUT,':encoding(UTF-8)'); +use POSIX qw(strftime nice); -require '/etc/debbugs/config'; -require '/etc/debbugs/text'; +use Debbugs::Config qw(:globals :text :config); use Debbugs::User; -my $cats = 5; -use vars qw($gPackagePages $gWebDomain); +use Debbugs::Common qw(getparsedaddrs make_list getmaintainers getpseudodesc); + +use Debbugs::Bugs qw(get_bugs bug_filter newest_bug); +use Debbugs::Packages qw(getsrcpkgs getpkgsrc get_versions); + +use Debbugs::Status qw(splitpackages); + +use Debbugs::CGI qw(:all); + +use Debbugs::CGI::Pkgreport qw(:all); + +use Debbugs::Text qw(:templates); + +use CGI::Simple; +my $q = new CGI::Simple; + +if ($q->request_method() eq 'HEAD') { + print $q->header(-type => "text/html", + -charset => 'utf-8', + ); + exit 0; +} + +my $default_params = {ordering => 'normal', + archive => 0, + repeatmerged => 0, + include => [], + exclude => [], + }; -if (defined $ENV{REQUEST_METHOD} and $ENV{REQUEST_METHOD} eq 'HEAD') { - print "Content-Type: text/html; charset=utf-8\n\n"; - exit 0; +our %param = cgi_parameters(query => $q, + single => [qw(ordering archive repeatmerged), + qw(bug-rev pend-rev sev-rev), + qw(maxdays mindays version), + qw(data which dist newest), + qw(noaffects), + ], + default => $default_params, + ); + +my ($form_options,$param) = ({},undef); +($form_options,$param)= form_options_and_normal_param(\%param) + if $param{form_options}; + +%param = %{$param} if defined $param; + +if (exists $param{form_options} and defined $param{form_options}) { + delete $param{form_options}; + delete $param{submit} if exists $param{submit}; + for my $default (keys %{$default_params}) { + if (exists $param{$default} and + not ref($default_params->{$default}) and + $default_params->{$default} eq $param{$default} + ) { + delete $param{$default}; + } + } + for my $incexc (qw(include exclude)) { + next unless exists $param{$incexc}; + # normalize tag to tags + $param{$incexc} = [map {s/^tag:/tags:/; $_} grep /\S\:\S/, make_list($param{$incexc})]; + } + for my $key (keys %package_search_keys) { + next unless exists $param{key}; + $param{$key} = [map {split /\s*,\s*/} make_list($param{$key})]; + } + # kill off keys for which empty values are meaningless + for my $key (qw(package src submitter affects severity status dist)) { + next unless exists $param{$key}; + $param{$key} = [grep {defined $_ and length $_} + make_list($param{$key})]; + } + print $q->redirect(munge_url('pkgreport.cgi?',%param)); + exit 0; +} + +# normalize innclude/exclude keys; currently this is in two locations, +# which is suboptimal. Closes: #567407 +for my $incexc (qw(include exclude)) { + next unless exists $param{$incexc}; + # normalize tag to tags + $param{$incexc} = [map {s/^tag:/tags:/; $_} make_list($param{$incexc})]; +} + + + +# map from yes|no to 1|0 +for my $key (qw(repeatmerged bug-rev pend-rev sev-rev)) { + if (exists $param{$key}){ + if ($param{$key} =~ /^no$/i) { + $param{$key} = 0; + } + elsif ($param{$key}) { + $param{$key} = 1; + } + } } -nice(5); +if (lc($param{archive}) eq 'no') { + $param{archive} = 0; +} +elsif (lc($param{archive}) eq 'yes') { + $param{archive} = 1; +} -my $userAgent = detect_user_agent(); -my %param = readparse(); +# fixup dist +if (exists $param{dist} and $param{dist} eq '') { + delete $param{dist}; +} -my $repeatmerged = ($param{'repeatmerged'} || "yes") eq "yes"; -my $archive = ($param{'archive'} || "no") eq "yes"; my $include = $param{'&include'} || $param{'include'} || ""; my $exclude = $param{'&exclude'} || $param{'exclude'} || ""; @@ -36,1084 +143,368 @@ my $users = $param{'users'} || ""; my $ordering = $param{'ordering'}; my $raw_sort = ($param{'raw'} || "no") eq "yes"; my $old_view = ($param{'oldview'} || "no") eq "yes"; +my $age_sort = ($param{'age'} || "no") eq "yes"; unless (defined $ordering) { $ordering = "normal"; - $ordering = "old" if $old_view; + $ordering = "oldview" if $old_view; $ordering = "raw" if $raw_sort; + $ordering = 'age' if $age_sort; } +$param{ordering} = $ordering; + +our ($bug_order) = $ordering =~ /(age(?:rev)?)/; +$bug_order = '' if not defined $bug_order; my $bug_rev = ($param{'bug-rev'} || "no") eq "yes"; my $pend_rev = ($param{'pend-rev'} || "no") eq "yes"; my $sev_rev = ($param{'sev-rev'} || "no") eq "yes"; -my $pend_exc = $param{'&pend-exc'} || $param{'pend-exc'} || ""; -my $pend_inc = $param{'&pend-inc'} || $param{'pend-inc'} || ""; -my $sev_exc = $param{'&sev-exc'} || $param{'sev-exc'} || ""; -my $sev_inc = $param{'&sev-inc'} || $param{'sev-inc'} || ""; -my $maxdays = ($param{'maxdays'} || -1); -my $mindays = ($param{'mindays'} || 0); -my $version = $param{'version'} || undef; -my $dist = $param{'dist'} || undef; -my $arch = $param{'arch'} || undef; -my $show_list_header = ($param{'show_list_header'} || $userAgent->{'show_list_header'} || "yes" ) eq "yes"; -my $show_list_footer = ($param{'show_list_footer'} || $userAgent->{'show_list_footer'} || "yes" ) eq "yes"; - -my @p = ( - "pending:pending,forwarded,pending-fixed,fixed,done,absent", - "severity:critical,grave,serious,important,normal,minor,wishlist", - "pending=pending+tag=wontfix,pending=pending+tag=moreinfo,pending=pending+tag=patch,pending=pending+tag=confirmed,pending=pending"); -my @t = ( - "Outstanding,Forwarded,Pending Upload,Fixed in NMU,Resolved,From other Branch,Unknown Pending Status", - "Critical,Grave,Serious,Important,Normal,Minor,Wishlist,Unknown Severity", - "Will Not Fix,More information needed,Patch Available,Confirmed,Unclassified"); -my @o = ("0,1,2,3,4,5,6","0,1,2,3,4,5,6,7","2,3,4,1,0,5"); -my @n = ("Status", "Severity", "Classification"); - -if ($ordering eq "old") { - splice @p, 2, 1; - splice @t, 2, 1; - splice @o, 2, 1; - splice @n, 2, 1; -} -$o[0] = scalar reverse($o[0]) if ($pend_rev); -$o[1] = scalar reverse($o[1]) if ($sev_rev); - -if (!defined $param{"pri0"} && $ordering =~ m/^user(\d+)$/) { - my $id = $1; - my $l = 0; - if (defined $param{"cat${id}_users"}) { - $users .= "," . $param{"cat${id}_users"}; - } - while (defined $param{"cat${id}_nam$l"}) { - my ($n, $p, $t, $o) = - map { $param{"cat${id}_${_}$l"} || "" } - ("nam", "pri", "ttl", "ord"); - if ($p eq "") { - if ($n eq "status") { - ($p, $t, $o) = ($p[0], $t[0], $o[0]); - } elsif ($n eq "severity") { - ($p, $t, $o) = ($p[1], $t[1], $o[1]) - } else { - $ordering = "raw"; - last; - } - } - $param{"nam$l"} = $n; - $param{"pri$l"} = $p; - $param{"ttl$l"} = $t; - $param{"ord$l"} = $o; - $l++; - } -} -if (defined $param{"pri0"}) { - my $i = 0; - @p = (); @o = (); @t = (); @n = (); - while (defined $param{"pri$i"}) { - push @p, $param{"pri$i"}; - push @o, $param{"ord$i"} || ""; - push @t, $param{"ttl$i"} || ""; - push @n, $param{"nam$i"} || ""; - $i++; - } -} -for my $x (@p) { - next if "$x," =~ m/^(pending|severity|tag):(([*]|[a-z0-9.-]+),)+$/; - next if "$x," =~ m/^((pending|severity|tag)=([*]|[a-z0-9.-]+)[,+])+/; - quitcgi("Bad syntax in Priority: $x"); -} -my @names; my @prior; my @title; my @order; -for my $i (0..$#p) { - push @prior, [ make_order_list($p[$i]) ]; - if ($n[$i]) { - push @names, $n[$i]; - } elsif ($p[$i] =~ m/^([^:]+):/) { - push @names, $1; - } else { - push @names, "Bug attribute #" . (1+$i); - } - if ($o[$i]) { - push @order, [ split /,/, $o[$i] ]; - } else { - push @order, [ 0..$#{$prior[$i]} ]; - } - my @t = split /,/, $t[$i]; - push @t, map { toenglish($prior[$i]->[$_]) } ($#t+1)..($#{$prior[$i]}); - push @title, [@t]; +my @inc_exc_mapping = ({name => 'pending', + incexc => 'include', + key => 'pend-inc', + }, + {name => 'pending', + incexc => 'exclude', + key => 'pend-exc', + }, + {name => 'severity', + incexc => 'include', + key => 'sev-inc', + }, + {name => 'severity', + incexc => 'exclude', + key => 'sev-exc', + }, + {name => 'subject', + incexc => 'include', + key => 'includesubj', + }, + {name => 'subject', + incexc => 'exclude', + key => 'excludesubj', + }, + ); +for my $incexcmap (@inc_exc_mapping) { + push @{$param{$incexcmap->{incexc}}}, map {"$incexcmap->{name}:$_"} + map{split /\s*,\s*/} make_list($param{$incexcmap->{key}}) + if exists $param{$incexcmap->{key}}; + delete $param{$incexcmap->{key}}; } -sub toenglish { - my $expr = shift; - $expr =~ s/[+]/ and /g; - $expr =~ s/[a-z]+=//g; - return $expr; -} -{ - if (defined $param{'vt'}) { - my $vt = $param{'vt'}; - if ($vt eq "none") { $dist = undef; $arch = undef; $version = undef; } - if ($vt eq "bysuite") { - $version = undef; - $arch = undef if ($arch eq "any"); - } - if ($vt eq "bypkg" || $vt eq "bysrc") { $dist = undef; $arch = undef; } - } - if (defined $param{'includesubj'}) { - my $is = $param{'includesubj'}; - $include .= "," . join(",", map { "subj:$_" } (split /[\s,]+/, $is)); - } - if (defined $param{'excludesubj'}) { - my $es = $param{'excludesubj'}; - $exclude .= "," . join(",", map { "subj:$_" } (split /[\s,]+/, $es)); - } -} +my $maxdays = ($param{'maxdays'} || -1); +my $mindays = ($param{'mindays'} || 0); +my $version = $param{'version'} || undef; -my ($pkg, $src, $maint, $maintenc, $submitter, $severity, $status, $tag, $usertag); - -my %which = ( - 'pkg' => \$pkg, - 'src' => \$src, - 'maint' => \$maint, - 'maintenc' => \$maintenc, - 'submitter' => \$submitter, - 'severity' => \$severity, - 'tag' => \$tag, - 'usertag' => \$usertag, - ); -my @allowedEmpty = ( 'maint' ); - -my $found; -foreach ( keys %which ) { - $status = $param{'status'} || 'open' if /^severity$/; - if (($found = $param{$_})) { - ${ $which{$_} } = $found; - last; - } -} -if (!$found && !$archive) { - foreach ( @allowedEmpty ) { - if (exists($param{$_})) { - ${ $which{$_} } = ''; - $found = 1; - last; - } - } +our %hidden = map { $_, 1 } qw(status severity classification); +our %cats = ( + "status" => [ { + "nam" => "Status", + "pri" => [map { "pending=$_" } + qw(pending forwarded pending-fixed fixed done absent)], + "ttl" => ["Outstanding","Forwarded","Pending Upload", + "Fixed in NMU","Resolved","From other Branch"], + "def" => "Unknown Pending Status", + "ord" => [0,1,2,3,4,5,6], + } ], + "severity" => [ { + "nam" => "Severity", + "pri" => [map { "severity=$_" } @gSeverityList], + "ttl" => [map { $gSeverityDisplay{$_} } @gSeverityList], + "def" => "Unknown Severity", + "ord" => [0..@gSeverityList], + } ], + "classification" => [ { + "nam" => "Classification", + "pri" => [qw(pending=pending+tag=wontfix + pending=pending+tag=moreinfo + pending=pending+tag=patch + pending=pending+tag=confirmed + pending=pending)], + "ttl" => ["Will Not Fix","More information needed", + "Patch Available","Confirmed"], + "def" => "Unclassified", + "ord" => [2,3,4,1,0,5], + } ], + "oldview" => [ qw(status severity) ], + "normal" => [ qw(status severity classification) ], +); + +if (exists $param{which} and exists $param{data}) { + $param{$param{which}} = [exists $param{$param{which}}?(make_list($param{$param{which}})):(), + make_list($param{data}), + ]; + delete $param{which}; + delete $param{data}; +} + +if (defined $param{maintenc}) { + $param{maint} = maint_decode($param{maintenc}); + delete $param{maintenc} +} + +if (exists $param{pkg}) { + $param{package} = $param{pkg}; + delete $param{pkg}; +} + +if (not grep {exists $param{$_}} keys %package_search_keys and exists $param{users}) { + $param{usertag} = [make_list($param{users})]; } -if (!$found) { - my $which; - if (($which = $param{'which'})) { - if (grep( /^\Q$which\E$/, @allowedEmpty)) { - ${ $which{$which} } = $param{'data'}; - $found = 1; - } elsif (($found = $param{'data'})) { - ${ $which{$which} } = $found if (exists($which{$which})); - } - } -} -quitcgi("You have to choose something to select by") if (!$found); my %bugusertags; my %ut; -for my $user (split /[\s*,]+/, $users) { - next unless ($user =~ m/..../); - add_usertags(\%ut, $user); -} +my %seen_users; -if (defined $usertag) { - my %select_ut = (); - my ($u, $t) = split /:/, $usertag, 2; - Debbugs::User::read_usertags(\%select_ut, $u); - unless (defined $t && $t ne "") { - $t = join(",", keys(%select_ut)); - } +for my $user (map {split /[\s*,\s*]+/} make_list($param{users}||[])) { + next unless length($user); + add_user($user,\%ut,\%bugusertags,\%seen_users,\%cats,\%hidden); +} - add_usertags(\%ut, $u); - $tag = $t; +if (defined $param{usertag}) { + for my $usertag (make_list($param{usertag})) { + my %select_ut = (); + my ($u, $t) = split /:/, $usertag, 2; + Debbugs::User::read_usertags(\%select_ut, $u); + unless (defined $t && $t ne "") { + $t = join(",", keys(%select_ut)); + } + add_user($u,\%ut,\%bugusertags,\%seen_users,\%cats,\%hidden); + push @{$param{tag}}, split /,/, $t; + } } -my $Archived = $archive ? " Archived" : ""; +quitcgi("You have to choose something to select by", '400 Bad Request') + unless grep {exists $param{$_}} keys %package_search_keys; + -my $this = ""; +my $Archived = $param{archive} ? " Archived" : ""; + +my $this = munge_url('pkgreport.cgi?', + %param, + ); my %indexentry; 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", $include); -set_option("exclude", $exclude); -set_option("pend-exc", $pend_exc); -set_option("pend-inc", $pend_inc); -set_option("sev-exc", $sev_exc); -set_option("sev-inc", $sev_inc); -set_option("maxdays", $maxdays); -set_option("mindays", $mindays); -set_option("version", $version); -set_option("dist", $dist); -set_option("arch", $arch); -set_option("use-bug-idx", defined($param{'use-bug-idx'}) ? $param{'use-bug-idx'} : 0); -set_option("show_list_header", $show_list_header); -set_option("show_list_footer", $show_list_footer); - -sub add_usertags { - my $ut = shift; - my $u = shift; - Debbugs::User::read_usertags($ut, $u); - - %bugusertags = (); - for my $t (keys %{$ut}) { - for my $b (@{$ut->{$t}}) { - $bugusertags{$b} = [] unless defined $bugusertags{$b}; - push @{$bugusertags{$b}}, $t; - } - } - set_option("bugusertags", \%bugusertags); -} - - -my $title; my @bugs; -if (defined $pkg) { - $title = "package $pkg"; - add_usertags(\%ut, "$pkg\@packages.debian.org"); - if (defined $version) { - $title .= " (version $version)"; - } elsif (defined $dist) { - $title .= " in $dist"; - my $verdesc = getversiondesc($pkg); - $title .= " ($verdesc)" if defined $verdesc; - } - my @pkgs = split /,/, $pkg; - @bugs = @{getbugs(sub {my %d=@_; - foreach my $try (splitpackages($d{"pkg"})) { - return 1 if grep($try eq $_, @pkgs); - } - return 0; - }, 'package', @pkgs)}; -} elsif (defined $src) { - add_usertags(\%ut, "$src\@packages.debian.org"); - $title = "source $src"; - set_option('arch', 'source'); - if (defined $version) { - $title .= " (version $version)"; - } elsif (defined $dist) { - $title .= " in $dist"; - my $verdesc = getversiondesc($src); - $title .= " ($verdesc)" if defined $verdesc; - } - my @pkgs = (); - my @srcs = split /,/, $src; - foreach my $try (@srcs) { - push @pkgs, getsrcpkgs($try); - push @pkgs, $try if ( !grep(/^\Q$try\E$/, @pkgs) ); - } - @bugs = @{getbugs(sub {my %d=@_; - foreach my $try (splitpackages($d{"pkg"})) { - return 1 if grep($try eq $_, @pkgs); - } - return 0; - }, 'package', @pkgs)}; -} elsif (defined $maint) { - my %maintainers = %{getmaintainers()}; - add_usertags(\%ut, $maint); - $title = "maintainer $maint"; - $title .= " in $dist" if defined $dist; - if ($maint eq "") { - @bugs = @{getbugs(sub {my %d=@_; - foreach my $try (splitpackages($d{"pkg"})) { - return 1 if !getparsedaddrs($maintainers{$try}); - } - return 0; - })}; - } else { - my @maints = split /,/, $maint; - my @pkgs = (); - foreach my $try (@maints) { - foreach my $p (keys %maintainers) { - my @me = getparsedaddrs($maintainers{$p}); - push @pkgs, $p if grep { $_->address eq $try } @me; - } - } - @bugs = @{getbugs(sub {my %d=@_; - foreach my $try (splitpackages($d{"pkg"})) { - my @me = getparsedaddrs($maintainers{$try}); - return 1 if grep { $_->address eq $maint } @me; - } - return 0; - }, 'package', @pkgs)}; - } -} elsif (defined $maintenc) { - my %maintainers = %{getmaintainers()}; - $title = "encoded maintainer $maintenc"; - $title .= " in $dist" if defined $dist; - @bugs = @{getbugs(sub {my %d=@_; - foreach my $try (splitpackages($d{"pkg"})) { - my @me = getparsedaddrs($maintainers{$try}); - return 1 if grep { - maintencoded($_->address) eq $maintenc - } @me; - } - return 0; - })}; -} elsif (defined $submitter) { - add_usertags(\%ut, $submitter); - $title = "submitter $submitter"; - $title .= " in $dist" if defined $dist; - my @submitters = split /,/, $submitter; - @bugs = @{getbugs(sub {my %d=@_; - my @se = getparsedaddrs($d{"submitter"} || ""); - foreach my $try (@submitters) { - return 1 if grep { $_->address eq $try } @se; - } - }, 'submitter-email', @submitters)}; -} elsif (defined($severity) && defined($status)) { - $title = "$status $severity bugs"; - $title .= " in $dist" if defined $dist; - my @severities = split /,/, $severity; - my @statuses = split /,/, $status; - @bugs = @{getbugs(sub {my %d=@_; - return (grep($d{"severity"} eq $_, @severities)) - && (grep($d{"status"} eq $_, @statuses)); - })}; -} elsif (defined($severity)) { - $title = "$severity bugs"; - $title .= " in $dist" if defined $dist; - my @severities = split /,/, $severity; - @bugs = @{getbugs(sub {my %d=@_; - return (grep($d{"severity"} eq $_, @severities)); - }, 'severity', @severities)}; -} elsif (defined($tag)) { - $title = "bugs tagged $tag"; - $title .= " in $dist" if defined $dist; - my @tags = split /,/, $tag; - my %bugs = (); - for my $t (@tags) { - for my $b (@{$ut{$t}}) { - $bugs{$b} = 1; - } - } - @bugs = @{getbugs(sub {my %d = @_; - return 1 if $bugs{$d{"bug"}}; - my %tags = map { $_ => 1 } split ' ', $d{"tags"}; - return grep(exists $tags{$_}, @tags); - })}; -} - -my $result = pkg_htmlizebugs(\@bugs); +# addusers for source and binary packages being searched for +my $pkgsrc = getpkgsrc(); +my $srcpkg = getsrcpkgs(); +for my $package (# For binary packages, add the binary package + # and corresponding source package + make_list($param{package}||[]), + (map {defined $pkgsrc->{$_}?($pkgsrc->{$_}):()} + make_list($param{package}||[]), + ), + # For source packages, add the source package + # and corresponding binary packages + make_list($param{src}||[]), + (map {defined $srcpkg->{$_}?($srcpkg->{$_}):()} + make_list($param{src}||[]), + ), + ) { + next unless defined $package; + add_user($package.'@'.$config{usertag_package_domain}, + \%ut,\%bugusertags,\%seen_users,\%cats,\%hidden) + if defined $config{usertag_package_domain}; +} + + +# walk through the keys and make the right get_bugs query. + +my $form_option_variables = {}; +$form_option_variables->{search_key_order} = [@package_search_key_order]; + +# Set the title sanely and clean up parameters +my @title; +my @temp = @package_search_key_order; +while (my ($key,$value) = splice @temp, 0, 2) { + next unless exists $param{$key}; + my @entries = (); + for my $entry (make_list($param{$key})) { + # we'll handle newest below + next if $key eq 'newest'; + my $extra = ''; + if (exists $param{dist} and ($key eq 'package' or $key eq 'src')) { + my %versions = get_versions(package => $entry, + (exists $param{dist}?(dist => $param{dist}):()), + (exists $param{arch}?(arch => $param{arch}):(arch => $config{default_architectures})), + ($key eq 'src'?(arch => q(source)):()), + no_source_arch => 1, + return_archs => 1, + ); + my $verdesc; + if (keys %versions > 1) { + $verdesc = 'versions '. join(', ', + map { $_ .' ['.join(', ', + sort @{$versions{$_}} + ).']'; + } keys %versions); + } + else { + $verdesc = 'version '.join(', ', + keys %versions + ); + } + $extra= " ($verdesc)" if keys %versions; + } + if ($key eq 'maint' and $entry eq '') { + push @entries, "no one (packages without maintainers)" + } + else { + push @entries, $entry.$extra; + } + } + push @title,$value.' '.join(' or ', @entries) if @entries; +} +if (defined $param{newest}) { + my $newest_bug = newest_bug(); + @bugs = ($newest_bug - $param{newest} + 1) .. $newest_bug; + push @title, 'in '.@bugs.' newest reports'; + $param{bugs} = [exists $param{bugs}?make_list($param{bugs}):(), + @bugs, + ]; +} + +my $title = $gBugs.' '.join(' and ', map {/ or /?"($_)":$_} @title); +@title = (); + +#yeah for magick! +@bugs = get_bugs((map {exists $param{$_}?($_,$param{$_}):()} + grep {$_ ne 'newest'} + keys %package_search_keys, 'archive'), + usertags => \%ut, + ); + +# shove in bugs which affect this package if there is a package or a +# source given (by default), but no affects options given +if (not exists $param{affects} and not exists $param{noaffects} and + (exists $param{src} or + exists $param{package})) { + push @bugs, get_bugs((map {my $key = $_; + exists $param{$key}?($key =~ /^(?:package|src)$/?'affects':$key, + ($key eq 'src'?[map {"src:$_"}make_list($param{$key})]:$param{$_})):()} + grep {$_ ne 'newest'} + keys %package_search_keys, 'archive'), + usertags => \%ut, + ); +} + +# filter out included or excluded bugs + + +if (defined $param{version}) { + $title .= " at version $param{version}"; +} +elsif (defined $param{dist}) { + $title .= " in $param{dist}"; +} + +$title = html_escape($title); + +my @names; my @prior; my @order; +determine_ordering(cats => \%cats, + param => \%param, + ordering => \$ordering, + names => \@names, + prior => \@prior, + title => \@title, + order => \@order, + ); + +# strip out duplicate bugs +my %bugs; +@bugs{@bugs} = @bugs; +@bugs = keys %bugs; + +my $result = pkg_htmlizebugs(bugs => \@bugs, + names => \@names, + title => \@title, + order => \@order, + prior => \@prior, + ordering => $ordering, + bugusertags => \%bugusertags, + bug_rev => $bug_rev, + bug_order => $bug_order, + repeatmerged => $param{repeatmerged}, + include => $include, + exclude => $exclude, + this => $this, + options => \%param, + (exists $param{dist})?(dist => $param{dist}):(), + ); + +print "Cache-Control: public, max-age=300\n"; print "Content-Type: text/html; charset=utf-8\n\n"; print "\n"; print "\n" . - "$debbugs::gProject$Archived $debbugs::gBug report logs: $title\n" . - '' . + "$title -- $gProject$Archived $gBug report logs\n" . + qq() . "\n" . '' . "\n"; -print "

" . "$debbugs::gProject$Archived $debbugs::gBug report logs: $title" . +print qq(
\n); +print "

" . "$gProject$Archived $gBug report logs: $title" . "

\n"; my $showresult = 1; -if (defined $pkg || defined $src) { - my $showpkg = (defined $pkg) ? $pkg : "source package $src"; - my %maintainers = %{getmaintainers()}; - my $maint = $pkg ? $maintainers{$pkg} : $maintainers{$src} ? $maintainers{$src} : undef; - if (defined $maint) { - print '

'; - print htmlmaintlinks(sub { $_[0] == 1 ? "Maintainer for $showpkg is " - : "Maintainers for $showpkg are " - }, - $maint); - print ".

\n"; - } else { - print "

No maintainer for $showpkg. Please do not report new bugs against this package.

\n"; - } - if (defined $maint or @bugs) { - my %pkgsrc = %{getpkgsrc()}; - my $srcforpkg; - if (defined $pkg) { - $srcforpkg = $pkgsrc{$pkg}; - defined $srcforpkg or $srcforpkg = $pkg; - } - my @pkgs = getsrcpkgs($pkg ? $srcforpkg : $src); - undef $srcforpkg unless @pkgs; - @pkgs = grep( !/^\Q$pkg\E$/, @pkgs ) if ( $pkg ); - if ( @pkgs ) { - @pkgs = sort @pkgs; - if ($pkg) { - print "

You may want to refer to the following packages that are part of the same source:\n"; - } else { - print "

You may want to refer to the following individual bug pages:\n"; - } - push @pkgs, $src if ( $src && !grep(/^\Q$src\E$/, @pkgs) ); - print join( ", ", map( "$_", @pkgs ) ); - print ".\n"; - } - my @references; - my $pseudodesc = getpseudodesc(); - if ($pkg and defined($pseudodesc) and exists($pseudodesc->{$pkg})) { - push @references, "to the list of other pseudo-packages"; - } else { - if ($pkg and defined $debbugs::gPackagePages) { - push @references, sprintf "to the %s package page", urlsanit("http://${debbugs::gPackagePages}/$pkg"), htmlsanit("$pkg"); - } - if (defined $debbugs::gSubscriptionDomain) { - my $ptslink = $pkg ? $srcforpkg : $src; - push @references, "to the Package Tracking System"; - } - # Only output this if the source listing is non-trivial. - if ($pkg and $srcforpkg and (@pkgs or $pkg ne $srcforpkg)) { - push @references, sprintf "to the source package %s's bug page", srcurl($srcforpkg), htmlsanit($srcforpkg); - } - } - if ($pkg) { - set_option("archive", !$archive); - push @references, sprintf "to the %s reports for %s", pkgurl($pkg), ($archive ? "active" : "archived"), htmlsanit($pkg); - set_option("archive", $archive); - } - if (@references) { - $references[$#references] = "or $references[$#references]" if @references > 1; - print "

You might like to refer ", join(", ", @references), ".

\n"; - } - print "

If you find a bug not listed here, please\n"; - printf "report it.

\n", - urlsanit("http://${debbugs::gWebDomain}/Reporting${debbugs::gHTMLSuffix}"); - } else { - print "

There is no record of the " . - (defined($pkg) ? htmlsanit($pkg) . " package" - : htmlsanit($src) . " source package") . - ", and no bugs have been filed against it.

"; - $showresult = 0; - } -} elsif (defined $maint || defined $maintenc) { - print "

Note that maintainers may use different Maintainer fields for\n"; - print "different packages, so there may be other reports filed under\n"; - print "different addresses.\n"; -} elsif (defined $submitter) { - print "

Note that people may use different email accounts for\n"; - print "different bugs, so there may be other reports filed under\n"; - print "different addresses.\n"; -} - -print $result if $showresult; - -print pkg_javascript() . "\n"; -print "

Options

\n"; -print "
\n"; -printf "
\n", myurl(); - -print "\n"; - -my ($checked_any, $checked_sui, $checked_ver) = ("", "", ""); -if (defined $dist) { - $checked_sui = "CHECKED"; -} elsif (defined $version) { - $checked_ver = "CHECKED"; -} else { - $checked_any = "CHECKED"; -} - -print "\n"; -print " \n"; -print ""; -print " \n"; - -if (defined $pkg) { - my $v = $version || ""; - print ""; - print " \n"; -} elsif (defined $src) { - my $v = $version || ""; - print ""; - print " \n"; -} -print "\n"; - -my $includetags = join(" ", grep { !m/^subj:/i } split /[\s,]+/, $include); -my $excludetags = join(" ", grep { !m/^subj:/i } split /[\s,]+/, $exclude); -my $includesubj = join(" ", map { s/^subj://i; $_ } grep { m/^subj:/i } split /[\s,]+/, $include); -my $excludesubj = join(" ", map { s/^subj://i; $_ } grep { m/^subj:/i } split /[\s,]+/, $exclude); -my $vismindays = ($mindays == 0 ? "" : $mindays); -my $vismaxdays = ($maxdays == -1 ? "" : $maxdays); - -my $sel_rmy = ($repeatmerged ? " selected" : ""); -my $sel_rmn = ($repeatmerged ? "" : " selected"); -my $sel_ordraw = ($ordering eq "raw" ? " selected" : ""); -my $sel_ordold = ($ordering eq "old" ? " selected" : ""); -my $sel_ordnor = ($ordering eq "normal" ? " selected" : ""); - -my $chk_bugrev = ($bug_rev ? " checked" : ""); -my $chk_pendrev = ($pend_rev ? " checked" : ""); -my $chk_sevrev = ($sev_rev ? " checked" : ""); - -print < - - - - - - -\n"; - -printf "\n", - pkg_htmlselectyesno("pend-rev", "outstanding bugs first", "done bugs first", $pend_rev); -printf "\n", - pkg_htmlselectyesno("sev-rev", "highest severity first", "lowest severity first", $sev_rev); -printf "\n", - pkg_htmlselectyesno("bug-rev", "oldest bugs first", "newest bugs first", $bug_rev); - -print < - -EOF - -print "
Show bugs applicable toanything
" . pkg_htmlselectsuite(1,2,1) . " for " . pkg_htmlselectarch(1,2,2) . "
$pkg version
$src version
 
Only include bugs tagged with or that have in their subject
Exclude bugs tagged with or that have in their subject
Only show bugs older than days, and younger than days
 
Merged bugs should be - -
Categorise bugs by -
Order bugs by%s
%s
%s
 
with new settings
\n"; - -print "

User Categorisations (beta)

\n"; -print "
\n"; -print <This form allows you to define a new categorisation to use to view bugs -against packages. Once defined it will show up as an available category -in the Options section above. Note there are a limited numbering of -categorisations you can define, so you may need to choose a pre-existing -categorisation to replace. Note that this feature currently requires both -Javascript and cookies to be enabled. Some usage information is available -via Anthony Towns' development notes. -

-EOF - -printf "
\n", myurl(); -print "\n"; - -sub get_cat_name { - my $i = shift; - if (defined $param{"cat${i}_nam0"}) { - my @nams = (); - my $j = 0; - while (defined $param{"cat${i}_nam$j"}) { - push @nams, $param{"cat${i}_nam$j"}; - $j++; - } - return join(", ", @nams); - } else { - return undef; - } +my $pseudodesc = getpseudodesc(); +if (defined $pseudodesc and defined $pkg and exists $pseudodesc->{$pkg}) { + delete $param{dist}; } -print "\n"; -print "\n"; -print "\n"; - -for my $level (0..3) { - my $hlevel = $level + 1; - my ($n, $s, $t, $o) = - map { $param{"cat${default}_${_}${level}"} || "" } - ("nam", "pri", "ttl", "ord"); - - print < - - - - - -EOF -} - -print < -EOF - -print "
Categorisation to set\n"; -print "
Include usertags set by\n"; -print "
 
Level$hlevel
Name
Sections
Titles
Ordering
 
Commit new ordering
\n"; - -print "
\n"; -print "

$tail_html"; - -print "\n"; +# output information about the packages -sub pkg_htmlindexentrystatus { - my $s = shift; - my %status = %{$s}; - - my $result = ""; - - my $showseverity; - if ($status{severity} eq 'normal') { - $showseverity = ''; - } elsif (isstrongseverity($status{severity})) { - $showseverity = "Severity: $status{severity};\n"; - } else { - $showseverity = "Severity: $status{severity};\n"; - } - - $result .= pkg_htmlpackagelinks($status{"package"}, 1); - - my $showversions = ''; - if (@{$status{found_versions}}) { - my @found = @{$status{found_versions}}; - local $_; - s{/}{ } foreach @found; - $showversions .= join ', ', map htmlsanit($_), @found; - } - if (@{$status{fixed_versions}}) { - $showversions .= '; ' if length $showversions; - $showversions .= 'fixed: '; - my @fixed = @{$status{fixed_versions}}; - local $_; - s{/}{ } foreach @fixed; - $showversions .= join ', ', map htmlsanit($_), @fixed; - } - $result .= " ($showversions)" if length $showversions; - $result .= ";\n"; - - $result .= $showseverity; - $result .= pkg_htmladdresslinks("Reported by: ", \&submitterurl, - $status{originator}); - $result .= ";\nOwned by: " . htmlsanit($status{owner}) - if length $status{owner}; - $result .= ";\nTags: " - . htmlsanit(join(", ", sort(split(/\s+/, $status{tags})))) - . "" - if (length($status{tags})); - - $result .= buglinklist(";\nMerged with ", ", ", - split(/ /,$status{mergedwith})); - $result .= buglinklist(";\nBlocked by ", ", ", - split(/ /,$status{blockedby})); - $result .= buglinklist(";\nBlocks ", ", ", - split(/ /,$status{blocks})); - - my $days = 0; - if (length($status{done})) { - $result .= "
Done: " . htmlsanit($status{done}); - $days = ceil($debbugs::gRemoveAge - -M buglog($status{id})); - if ($days >= 0) { - $result .= ";\nWill be archived" . ( $days == 0 ? " today" : $days == 1 ? " in $days day" : " in $days days" ) . ""; - } else { - $result .= ";\nArchived"; - } - } - - unless (length($status{done})) { - if (length($status{forwarded})) { - $result .= ";\nForwarded to " - . maybelink($status{forwarded}); - } - my $daysold = int((time - $status{date}) / 86400); # seconds to days - if ($daysold >= 7) { - my $font = ""; - my $efont = ""; - $font = "em" if ($daysold > 30); - $font = "strong" if ($daysold > 60); - $efont = "" if ($font); - $font = "<$font>" if ($font); - - my $yearsold = int($daysold / 365); - $daysold -= $yearsold * 365; - - $result .= ";\n $font"; - my @age; - push @age, "1 year" if ($yearsold == 1); - push @age, "$yearsold years" if ($yearsold > 1); - push @age, "1 day" if ($daysold == 1); - push @age, "$daysold days" if ($daysold > 1); - $result .= join(" and ", @age); - $result .= " old$efont"; - } - } - - $result .= "."; - - return $result; +for my $package (make_list($param{package}||[])) { + print generate_package_info(binary => 1, + package => $package, + options => \%param, + bugs => \@bugs, + ); } - - -sub pkg_htmlizebugs { - $b = $_[0]; - my @bugs = @$b; - - my @status = (); - my %count; - my $header = ''; - my $footer = "

Summary

\n"; - - my @dummy = ($debbugs::gRemoveAge); #, @debbugs::gSeverityList, @debbugs::gSeverityDisplay); #, $debbugs::gHTMLExpireNote); - - if (@bugs == 0) { - return "

No reports found!

\n"; - } - - if ( $bug_rev ) { - @bugs = sort {$b<=>$a} @bugs; - } else { - @bugs = sort {$a<=>$b} @bugs; - } - my %seenmerged; - - my %common = ( - 'show_list_header' => 1, - 'show_list_footer' => 1, - ); - - my %section = (); - - foreach my $bug (@bugs) { - my %status = %{getbugstatus($bug)}; - next unless %status; - next if bugfilter($bug, %status); - - my $html = sprintf "
  • #%d: %s\n
    ", - bugurl($bug), $bug, htmlsanit($status{subject}); - $html .= pkg_htmlindexentrystatus(\%status) . "\n"; - - my $key = ""; - for my $i (0..$#prior) { - my $v = get_bug_order_index($prior[$i], \%status); - my $k = $prior[$i]->[$v]; - $count{"g_${i}_${v}"}++; - $key .= "_$v"; - } - $section{$key} .= $html; - $count{"_$key"}++; - - push @status, [ $bug, \%status, $html ]; - } - - my $result = ""; - if ($ordering eq "raw") { - $result .= "
      \n" . join("", map( { $_->[ 2 ] } @status ) ) . "
    \n"; - } else { - $header .= "
      \n
      \n"; - my @keys_in_order = (""); - for my $o (@order) { - push @keys_in_order, "X"; - while ((my $k = shift @keys_in_order) ne "X") { - for my $k2 (@{$o}) { - push @keys_in_order, "${k}_${k2}"; - } - } - } - for ( my $i = 0; $i <= $#keys_in_order; $i++ ) { - my $order = $keys_in_order[ $i ]; - next unless defined $section{$order}; - my @ttl = split /_/, $order; shift @ttl; - my $title = $title[0]->[$ttl[0]] . " bugs"; - if ($#ttl > 0) { - $title .= " -- "; - $title .= join("; ", grep {$_ ne ""} - map { $title[$_]->[$ttl[$_]] } 1..$#ttl); - } - - my $count = $count{"_$order"}; - my $bugs = $count == 1 ? "bug" : "bugs"; - - $header .= "
    • $title ($count $bugs)
      • \n"; - if ($common{show_list_header}) { - my $count = $count{"_$order"}; - my $bugs = $count == 1 ? "bug" : "bugs"; - $result .= "

      $title ($count $bugs)

      \n"; - } else { - $result .= "

      $title

      \n"; - } - $result .= "
      \n
        \n"; - $result .= "\n\n\n\n"; - $result .= $section{$order}; - $result .= "\n\n\n\n"; - $result .= "
      \n
      \n"; - } - $header .= "
    \n"; - - $footer .= "
      \n
      "; - for my $i (0..$#prior) { - my $local_result = ''; - foreach my $key ( @{$order[$i]} ) { - my $count = $count{"g_${i}_$key"}; - next if !$count or !$title[$i]->[$key]; - $local_result .= "
    • $count $title[$i]->[$key]
      • \n"; - } - if ( $local_result ) { - $footer .= "
    • $names[$i]
        \n$local_result
      • \n"; - } - } - $footer .= "
    \n"; - } - - $result = $header . $result if ( $common{show_list_header} ); - $result .= $footer if ( $common{show_list_footer} ); - return $result; -} - -sub pkg_htmlpackagelinks { - my $pkgs = shift; - return unless defined $pkgs and $pkgs ne ''; - my $strong = shift; - my @pkglist = splitpackages($pkgs); - - $strong = 0; - my $openstrong = $strong ? '' : ''; - my $closestrong = $strong ? '' : ''; - - return 'Package' . (@pkglist > 1 ? 's' : '') . ': ' . - join(', ', - map { - '' . - $openstrong . htmlsanit($_) . $closestrong . '' - } @pkglist - ); -} - -sub pkg_htmladdresslinks { - my ($prefixfunc, $urlfunc, $addresses) = @_; - if (defined $addresses and $addresses ne '') { - my @addrs = getparsedaddrs($addresses); - my $prefix = (ref $prefixfunc) ? $prefixfunc->(scalar @addrs) - : $prefixfunc; - return $prefix . - join ', ', map { sprintf '%s', - $urlfunc->($_->address), - htmlsanit($_->format) || '(unknown)' - } @addrs; - } else { - my $prefix = (ref $prefixfunc) ? $prefixfunc->(1) : $prefixfunc; - return sprintf '%s(unknown)', $prefix, $urlfunc->(''); - } +for my $package (make_list($param{src}||[])) { + print generate_package_info(binary => 0, + package => $package, + options => \%param, + bugs => \@bugs, + ); } -sub pkg_javascript { - return < - - -EOF +if (exists $param{maint} or exists $param{maintenc}) { + print "

    Note that maintainers may use different Maintainer fields for\n"; + print "different packages, so there may be other reports filed under\n"; + print "different addresses.\n"; } - -sub pkg_htmlselectyesno { - my ($name, $n, $y, $default) = @_; - return sprintf('', $name, ($default ? "" : " selected"), $n, ($default ? " selected" : ""), $y); +if (exists $param{submitter}) { + print "

    Note that people may use different email accounts for\n"; + print "different bugs, so there may be other reports filed under\n"; + print "different addresses.\n"; } -sub pkg_htmlselectsuite { - my $id = sprintf "b_%d_%d_%d", $_[0], $_[1], $_[2]; - my @suites = ("stable", "testing", "unstable", "experimental"); - my %suiteaka = ("stable", "sarge", "testing", "etch", "unstable", "sid"); - my $defaultsuite = "unstable"; - - my $result = sprintf ''; - return $result; -} +print $result; -sub pkg_htmlselectarch { - my $id = sprintf "b_%d_%d_%d", $_[0], $_[1], $_[2]; - my @arches = qw(alpha amd64 arm hppa i386 ia64 m68k mips mipsel powerpc s390 sparc); - - my $result = sprintf ''; - return $result; -} +print fill_in_template(template=>'cgi/pkgreport_javascript'); -sub myurl { - return pkg_etc_url($pkg, "pkg", 0) if defined($pkg); - return pkg_etc_url($src, "src", 0) if defined($src); - return pkg_etc_url($maint, "maint", 0) if defined($maint); - return pkg_etc_url($submitter, "submitter", 0) if defined($submitter); - return pkg_etc_url($severity, "severity", 0) if defined($severity); - return pkg_etc_url($tag, "tag", 0) if defined($tag); -} +print qq(

    Options

    \n); -sub make_order_list { - my $vfull = shift; - my @x = (); - - if ($vfull =~ m/^([^:]+):(.*)$/) { - my $v = $1; - for my $vv (split /,/, $2) { - push @x, "$v=$vv"; - } - } else { - for my $v (split /,/, $vfull) { - next unless $v =~ m/.=./; - push @x, $v; - } - } - push @x, ""; # catch all - return @x; -} +print option_form(template => 'cgi/pkgreport_options', + param => \%param, + form_options => $form_options, + variables => $form_option_variables, + ); -sub get_bug_order_index { - my $order = shift; - my $status = shift; - my $pos = -1; - - my %tags = (); - %tags = map { $_, 1 } split / /, $status->{"tags"} - if defined $status->{"tags"}; - - for my $el (@${order}) { - $pos++; - my $match = 1; - for my $item (split /[+]/, $el) { - my ($f, $v) = split /=/, $item, 2; - next unless (defined $f and defined $v); - my $isokay = 0; - $isokay = 1 if (defined $status->{$f} and $v eq $status->{$f}); - $isokay = 1 if ($f eq "tag" && defined $tags{$v}); - unless ($isokay) { - $match = 0; - last; - } - } - if ($match) { - return $pos; - last; - } - } - return -1; -} +print "
    \n"; +print fill_in_template(template=>'html/html_tail', + hole_var => {'&strftime' => \&POSIX::strftime, + }, + ); +print "\n"; -sub buglinklist { - my ($prefix, $infix, @els) = @_; - my $sep = $prefix; - my $r = ""; - for my $e (@els) { - $r .= $sep."#$e"; - $sep = $infix; - } - return $r; -}