From: Don Armstrong Date: Tue, 7 Nov 2006 11:14:26 +0000 (-0800) Subject: * Modularize out cgi_parameters; make it do default values and X-Git-Tag: release/2.6.0~585^2^2~79 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=61a4b41b8593395bd89e8cf57032a3dac6f8df08;p=debbugs.git * Modularize out cgi_parameters; make it do default values and singletons * Redo pkgindex so that it supports indexing by a first value, and indicing results * Adapt versions.cgi and search.cgi to deal with the changes in cgi_parameters * Fix versions.cgi so that it deals properly with source packages --- diff --git a/Debbugs/CGI.pm b/Debbugs/CGI.pm index a38a6a79..5a446914 100644 --- a/Debbugs/CGI.pm +++ b/Debbugs/CGI.pm @@ -34,6 +34,7 @@ use Params::Validate qw(validate_with :types); use Debbugs::Config qw(:config); use Mail::Address; use POSIX qw(ceil); +use Storable qw(dclone); my %URL_PARAMS = (); @@ -49,7 +50,7 @@ BEGIN{ html => [qw(html_escape htmlize_bugs htmlize_packagelinks), qw(maybelink htmlize_addresslinks), ], - util => [qw(getparsedaddrs)] + util => [qw(getparsedaddrs cgi_parameters)] #status => [qw(getbugstatus)], ); @EXPORT_OK = (); @@ -150,6 +151,51 @@ sub html_escape{ return HTML::Entities::encode_entities($string) } +=head2 cgi_parameters + + cgi_parameters + +Returns all of the cgi_parameters from a CGI script using CGI::Simple + +=cut + +sub cgi_parameters { + my %options = validate_with(params => \@_, + spec => {query => {type => OBJECT, + can => 'param', + }, + single => {type => ARRAYREF, + default => [], + }, + default => {type => HASHREF, + default => {}, + }, + }, + ); + my $q = $options{query}; + my %single; + @single{@{$options{single}}} = (1) x @{$options{single}}; + my %param; + for my $paramname ($q->param) { + if ($single{$paramname}) { + $param{$paramname} = $q->param($paramname); + } + else { + $param{$paramname} = [$q->param($paramname)]; + } + } + for my $default (keys %{$options{default}}) { + if (not exists $param{$default}) { + # We'll clone the reference here to avoid surprises later. + $param{$default} = ref($options{default}{$default})? + dclone($options{default}{$default}):$options{default}{$default}; + } + } + return %param; +} + + + my %common_bugusertags; # =head2 get_bug_status diff --git a/cgi/pkgindex.cgi b/cgi/pkgindex.cgi index 60860473..c667aaca 100755 --- a/cgi/pkgindex.cgi +++ b/cgi/pkgindex.cgi @@ -1,55 +1,64 @@ #!/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'; +use Debbugs::Config; +use CGI::Simple; +use Debbugs::CGI qw(cgi_parameters); require './common.pl'; -require '/etc/debbugs/config'; -require '/etc/debbugs/text'; - 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, + }, + ); + +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 $indexon = $param{'indexon'} || 'pkg'; -if ($indexon !~ m/^(pkg|src|maint|submitter|tag)$/) { +my $indexon = $param{indexon}; +if ($param{indexon} !~ m/^(pkg|src|maint|submitter|tag)$/) { quitcgi("You have to choose something to index on"); } -my $repeatmerged = ($param{'repeatmerged'} || "yes") eq "yes"; -my $archive = ($param{'archive'} || "no") eq "yes"; -my $sortby = $param{'sortby'} || 'alpha'; +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"); } -#my $include = $param{'include'} || ""; -#my $exclude = $param{'exclude'} || ""; - 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; +my $dtime = strftime "%a, %e %b %Y %T UTC", gmtime; +my $tail_html = '';#$gHTMLTail; +$tail_html = '';#$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 %count; my $tag; my $note; @@ -58,6 +67,16 @@ my %sortkey = (); if ($indexon eq "pkg") { $tag = "package"; %count = countbugs(sub {my %d=@_; return splitpackages($d{"pkg"})}); + 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) { @@ -72,6 +91,16 @@ if ($indexon eq "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 = countbugs(sub {my %d=@_; return map { $pkgsrc->{$_} || $_ @@ -100,6 +129,16 @@ if ($indexon eq "pkg") { map { $_->address } @me; } splitpackages($d{"pkg"}); }); + 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"; @@ -118,6 +157,16 @@ if ($indexon eq "pkg") { } map { $_->address } @se; }); + 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', @@ -130,6 +179,16 @@ if ($indexon eq "pkg") { } elsif ($indexon eq "tag") { $tag = "tag"; %count = countbugs(sub {my %d=@_; return split ' ', $d{tags}; }); + 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; @@ -146,7 +205,13 @@ if ($sortby eq "count") { } else { # sortby alpha @orderedentries = sort { $sortkey{$a} cmp $sortkey{$b} } keys %count; } +my $skip = $param{skip}; +my $max_results = $param{max_results}; foreach my $x (@orderedentries) { + if (not defined $param{first}) { + $skip-- and next if $skip > 0; + last if --$max_results < 0; + } $result .= "
  • " . $htmldescrip{$x} . " has $count{$x} " . ($count{$x} == 1 ? "bug" : "bugs") . "
    • \n"; } @@ -164,6 +229,28 @@ print "

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

    \n"; print $note; +print < + + + + + + +END +if (defined $param{first}) { + print qq(\n); +} +else { + print q(

    ); + if ($param{skip} > 0) { + print q(); + } + if (keys %count > ($param{skip} + $param{max_results})) { + print q(); + } + print qq(

    \n); +} print $result; print "
    \n"; diff --git a/cgi/search.cgi b/cgi/search.cgi index 554b4ad5..d3f449ea 100755 --- a/cgi/search.cgi +++ b/cgi/search.cgi @@ -19,19 +19,24 @@ use CGI::Alert 'don@donarmstrong.com'; use Search::Estraier; use Debbugs::Config qw(:config); use Debbugs::Estraier; -use Debbugs::CGI qw(htmlize_packagelinks html_escape); +use Debbugs::CGI qw(htmlize_packagelinks html_escape cgi_parameters); use HTML::Entities qw(encode_entities); my $q = new CGI::Simple; #my %var_defaults = (attr => 1,); -my %cgi_var = cgi_parameters($q); +my %cgi_var = cgi_parameters(query => $q, + single => [qw(phrase max_results order_field order_operator), + qw(skip prev next), + ], + default => {phrase => '', + max_results => 10, + skip => 0, + }. + ); -$cgi_var{phrase} = '' if not defined $cgi_var{phrase}; -$cgi_var{max_results} = 10 if not defined $cgi_var{max_results}; $cgi_var{attribute} = parse_attribute(\%cgi_var) || []; -$cgi_var{skip} = 0 if not defined $cgi_var{skip}; my @results; @@ -315,15 +320,3 @@ sub parse_attribute { } return \@attributes; } - - -sub cgi_parameters { - my ($q) = @_; - - my %param; - foreach my $paramname ($q->param) { - my @value = $q->param($paramname); - $param{$paramname} = @value > 1 ? [@value] : $value[0]; - } - return %param; -} diff --git a/cgi/version.cgi b/cgi/version.cgi index e0471a38..d5ebf285 100755 --- a/cgi/version.cgi +++ b/cgi/version.cgi @@ -17,33 +17,37 @@ use CGI::Simple; use CGI::Alert 'don@donarmstrong.com'; use Debbugs::Config qw(:config); -use Debbugs::CGI qw(htmlize_packagelinks html_escape); +use Debbugs::CGI qw(htmlize_packagelinks html_escape cgi_parameters); use Debbugs::Versions; use Debbugs::Versions::Dpkg; -use Debbugs::Packages qw(getversions); +use Debbugs::Packages qw(getversions makesourceversions); use HTML::Entities qw(encode_entities); use File::Temp qw(tempdir); use IO::File; use IO::Handle; +my %img_types = (svg => 'image/svg+xml', + png => 'image/png', + ); my $q = new CGI::Simple; -my %cgi_var = cgi_parameters($q); - -$cgi_var{package} = ['xterm'] if not defined $cgi_var{package}; -$cgi_var{found} = [] if not defined $cgi_var{found}; -$cgi_var{fixed} = [] if not defined $cgi_var{fixed}; - -# we only care about one package -$cgi_var{package} = $cgi_var{package}[0]; +my %cgi_var = cgi_parameters(query => $q, + single => [qw(package format ignore_boring)], + default => {package => 'xterm', + found => [], + fixed => [], + ignore_boring => 1, + format => 'png', + }, + ); # we want to first load the appropriate file, # then figure out which versions are there in which architectures, my %versions; my %version_to_dist; -for my $dist (qw(oldstable stable testing unstable)) { +for my $dist (qw(oldstable stable testing unstable experimental)) { $versions{$dist} = [getversions($cgi_var{package},$dist)]; # make version_to_dist foreach my $version (@{$versions{$dist}}){ @@ -51,11 +55,21 @@ for my $dist (qw(oldstable stable testing unstable)) { } } # then figure out which are affected. - -my $srchash = substr $cgi_var{package}, 0, 1; +# turn found and fixed into full versions +@{$cgi_var{found}} = makesourceversions($cgi_var{package},undef,@{$cgi_var{found}}); +@{$cgi_var{fixed}} = makesourceversions($cgi_var{package},undef,@{$cgi_var{fixed}}); +my @interesting_versions = makesourceversions($cgi_var{package},undef,keys %version_to_dist); + +# We need to be able to rip out leaves which the versions that do not affect the current versions of unstable/testing +my %sources; +@sources{map {m{(.+)/}; $1} @{$cgi_var{found}}} = (1) x @{$cgi_var{found}}; +@sources{map {m{(.+)/}; $1} @{$cgi_var{fixed}}} = (1) x @{$cgi_var{fixed}}; my $version = Debbugs::Versions->new(\&Debbugs::Versions::Dpkg::vercmp); -my $version_fh = new IO::File "$config{version_packages_dir}/$srchash/$cgi_var{package}", 'r'; -$version->load($version_fh); +foreach my $source (keys %sources) { + my $srchash = substr $source, 0, 1; + my $version_fh = new IO::File "$config{version_packages_dir}/$srchash/$source", 'r'; + $version->load($version_fh); +} # Here, we need to generate a short version to full version map my %version_map; foreach my $key (keys %{$version->{parent}}) { @@ -95,6 +109,9 @@ my %state = (found => ['fillcolor="salmon"', ); foreach my $key (keys %all_states) { my ($short_version) = $key =~ m{/(.+)$}; + next if $cgi_var{ignore_boring} and (not defined $all_states{$key} + or $all_states{$key} eq 'absent'); + next if $cgi_var{ignore_boring} and not version_relevant($version,$key,\@interesting_versions); my @attributes = @{$state{$all_states{$key}}}; if (length $short_version and exists $version_to_dist{$short_version}) { push @attributes, 'label="'.$key.'\n'."(".join(', ',@{$version_to_dist{$short_version}}).")\""; @@ -103,6 +120,12 @@ foreach my $key (keys %all_states) { $dot .= $node_attributes; } foreach my $key (keys %{$version->{parent}}) { + next if not defined $version->{parent}{$key}; + next if $cgi_var{ignore_boring} and $all_states{$key} eq 'absent'; + next if $cgi_var{ignore_boring} and (not defined $all_states{$version->{parent}{$key}} + or $all_states{$version->{parent}{$key}} eq 'absent'); + # Ignore branches which are not ancestors of a currently distributed version + next if $cgi_var{ignore_boring} and not version_relevant($version,$key,\@interesting_versions); $dot .= qq("$key").'->'.qq("$version->{parent}{$key}" [dir="back"])."\n" if defined $version->{parent}{$key}; } $dot .= "}\n"; @@ -114,25 +137,28 @@ if (not defined $cgi_var{dot}) { die "Unable to open $temp_dir/temp.dot for writing: $!"; print {$dot_fh} $dot or die "Unable to print output to the dot file: $!"; close $dot_fh or die "Unable to close the dot file: $!"; - system('dot','-Tpng',"$temp_dir/temp.dot",'-o',"$temp_dir/temp.png") == 0 + system('dot','-T'.$cgi_var{format},"$temp_dir/temp.dot",'-o',"$temp_dir/temp.$cgi_var{format}") == 0 or print "Content-Type: text\n\nDot failed." and die "Dot failed: $?"; - my $png_fh = new IO::File "$temp_dir/temp.png", 'r' or - die "Unable to open $temp_dir/temp.png for reading: $!"; - print "Content-Type: image/png\n\n"; - print <$png_fh>; - close $png_fh; + my $img_fh = new IO::File "$temp_dir/temp.$cgi_var{format}", 'r' or + die "Unable to open $temp_dir/temp.$cgi_var{format} for reading: $!"; + print "Content-Type: $img_types{$cgi_var{format}}\n\n"; + print <$img_fh>; + close $img_fh; } else { print "Content-Type: text\n\n"; print $dot; } -sub cgi_parameters { - my ($q) = @_; - my %param; - foreach my $paramname ($q->param) { - $param{$paramname} = [$q->param($paramname)] +my %_version_relevant_cache; +sub version_relevant { + my ($version,$test_version,$relevant_versions) = @_; + for my $dist_version (@{$relevant_versions}) { + print STDERR "Testing $dist_version against $test_version\n"; + return 1 if $version->isancestor($test_version,$dist_version); } - return %param; + return 0; } + +