X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FCGI.pm;h=dffa8ec1e021a896f1d42c782f76807dadda395c;hb=b1252b6797aa6a79d00a32165fb2fa8fb1bd9318;hp=8b4959803064eb34a831528d9e2d3a846827304f;hpb=8edbc9d755e3dd3e93c303951a86e78ed22d454d;p=debbugs.git diff --git a/Debbugs/CGI.pm b/Debbugs/CGI.pm index 8b49598..dffa8ec 100644 --- a/Debbugs/CGI.pm +++ b/Debbugs/CGI.pm @@ -34,6 +34,8 @@ use strict; use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT); use Exporter qw(import); +use feature qw(state); + our %URL_PARAMS = (); BEGIN{ @@ -64,6 +66,7 @@ BEGIN{ } use Debbugs::URI; +use URI::Escape; use HTML::Entities; use Debbugs::Common qw(getparsedaddrs make_list); use Params::Validate qw(validate_with :types); @@ -75,6 +78,7 @@ use Debbugs::User qw(); use Mail::Address; use POSIX qw(ceil); use Storable qw(dclone); +use Scalar::Util qw(looks_like_number); use List::AllUtils qw(max); use File::stat; @@ -326,65 +330,99 @@ our @package_search_key_order = (package => 'in package', bugs => 'in bug', ); our %package_search_keys = @package_search_key_order; - +our %package_links_invalid_options = + map {($_,1)} (keys %package_search_keys, + qw(msg att)); sub package_links { + state $spec = + {(map { ($_,{type => SCALAR|ARRAYREF, + optional => 1, + }); + } keys %package_search_keys, + ## these are aliases for package + ## search keys + source => {type => SCALAR|ARRAYREF, + optional => 1, + }, + maintainer => {type => SCALAR|ARRAYREF, + optional => 1, + }, + ), + links_only => {type => BOOLEAN, + default => 0, + }, + class => {type => SCALAR, + default => '', + }, + separator => {type => SCALAR, + default => ', ', + }, + options => {type => HASHREF, + default => {}, + }, + }; my %param = validate_with(params => \@_, - spec => {(map { ($_,{type => SCALAR|ARRAYREF, - optional => 1, - }); - } keys %package_search_keys, - ), - links_only => {type => BOOLEAN, - default => 0, - }, - class => {type => SCALAR, - default => '', - }, - separator => {type => SCALAR, - default => ', ', - }, - options => {type => HASHREF, - default => {}, - }, - }, - normalize_keys => - sub { - my ($key) = @_; - my %map = (source => 'src', - maintainer => 'maint', - pkg => 'package', - ); - return $map{$key} if exists $map{$key}; - return $key; - } + spec => $spec, ); my %options = %{$param{options}}; - for ((keys %package_search_keys,qw(msg att))) { - delete $options{$_} if exists $options{$_}; + for (grep {$package_links_invalid_options{$_}} keys %options) { + delete $options{$_}; + } + ## remove aliases for source and maintainer + if (exists $param{source}) { + $param{src} = [exists $param{src}?make_list($param{src}):(), + make_list($param{source}), + ]; + delete $param{source}; } + if (exists $param{maintainer}) { + $param{maint} = [exists $param{maint}?make_list($param{maint}):(), + make_list($param{maintainer}), + ]; + delete $param{maintainer}; + } + my $has_options = keys %options; my @links = (); for my $type (qw(src package)) { - push @links, map {my $t_type = $type; - if ($_ =~ s/^src://) { - $t_type = 'src'; - } - (munge_url('pkgreport.cgi?', - %options, - $t_type => $_, - ), - ($t_type eq 'src'?'src:':'').$_); - } make_list($param{$type}) if exists $param{$type}; + next unless exists $param{$type}; + for my $target (make_list($param{$type})) { + my $t_type = $type; + if ($target =~ s/^src://) { + $t_type = 'source'; + } elsif ($t_type eq 'source') { + $target = 'src:'.$target; + } + if ($has_options) { + push @links, + (munge_url('pkgreport.cgi?', + %options, + $t_type => $target, + ), + $target); + } else { + push @links, + ('pkgreport.cgi?'.$t_type.'='.uri_escape_utf8($target), + $target); + } + } } for my $type (qw(maint owner submitter correspondent)) { - push @links, map {my $addr = getparsedaddrs($_); - $addr = defined $addr?$addr->address:''; - (munge_url('pkgreport.cgi?', - %options, - $type => $addr, - ), - $_); - } make_list($param{$type}) if exists $param{$type}; + next unless exists $param{$type}; + for my $target (make_list($param{$type})) { + if ($has_options) { + push @links, + (munge_url('pkgreport.cgi?', + %options, + $type => $target), + $target); + } else { + push @links, + ('pkgreport.cgi?'. + $type.'='.uri_escape_utf8($target), + $target); + } + } } my @return = (); my ($link,$link_name); @@ -431,36 +469,47 @@ returning htmlized links. =cut sub bug_links { + state $spec = {bug => {type => SCALAR|ARRAYREF, + optional => 1, + }, + links_only => {type => BOOLEAN, + default => 0, + }, + class => {type => SCALAR, + default => '', + }, + separator => {type => SCALAR, + default => ', ', + }, + options => {type => HASHREF, + default => {}, + }, + }; my %param = validate_with(params => \@_, - spec => {bug => {type => SCALAR|ARRAYREF, - optional => 1, - }, - links_only => {type => BOOLEAN, - default => 0, - }, - class => {type => SCALAR, - default => '', - }, - separator => {type => SCALAR, - default => ', ', - }, - options => {type => HASHREF, - default => {}, - }, - }, + spec => $spec, ); my %options = %{$param{options}}; for (qw(bug)) { delete $options{$_} if exists $options{$_}; } + my $has_options = keys %options; my @links; - push @links, map {(munge_url('bugreport.cgi?', - %options, - bug => $_, - ), - $_); - } make_list($param{bug}) if exists $param{bug}; + if ($has_options) { + push @links, map {(munge_url('bugreport.cgi?', + %options, + bug => $_, + ), + $_); + } make_list($param{bug}) if exists $param{bug}; + } else { + push @links, + map {my $b = ceil($_); + ('bugreport.cgi?bug='.$b, + $b)} + grep {looks_like_number($_)} + make_list($param{bug}) if exists $param{bug}; + } my @return; my ($link,$link_name); my $class = ''; @@ -575,7 +624,7 @@ sub emailfromrfc822{ return $addr; } -sub mainturl { package_links(maint => $_[0], links_only => 1); } +sub mainturl { package_links(maintainer => $_[0], links_only => 1); } sub submitterurl { package_links(submitter => $_[0], links_only => 1); } sub htmlize_maintlinks { my ($prefixfunc, $maints) = @_; @@ -820,23 +869,6 @@ sub option_form{ # we'll add extra comands here once I figure out what they # should be } - # add in a few utility routines - $variables->{output_select_options} = sub { - my ($options,$value) = @_; - my @options = @{$options}; - my $output = ''; - while (my ($o_value,$name) = splice @options,0,2) { - my $selected = ''; - if (defined $value and $o_value eq $value) { - $selected = ' selected'; - } - $output .= q(\n); - } - return $output; - }; - $variables->{make_list} = sub { make_list(@_); - }; # now at this point, we're ready to create the template return Debbugs::Text::fill_in_template(template=>$param{template}, (exists $param{language}?(language=>$param{language}):()),