X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FCGI.pm;h=7dabb1ef47cd394d46c3ad51f3a494067d5b9277;hb=466f7faff129a5699c7674f59900a92aa256175d;hp=c70f6829483e0a020b1f042c740384f2ddbd4c04;hpb=ef8bd23ff686d78c1fbc8e51bdeb0630f1f53fae;p=debbugs.git diff --git a/Debbugs/CGI.pm b/Debbugs/CGI.pm index c70f682..7dabb1e 100644 --- a/Debbugs/CGI.pm +++ b/Debbugs/CGI.pm @@ -17,8 +17,6 @@ Debbugs::CGI -- General routines for the cgi scripts use Debbugs::CGI qw(:url :html); -html_escape(bug_url($ref,mbox=>'yes',mboxstatus=>'yes')); - =head1 DESCRIPTION This module is a replacement for parts of common.pl; subroutines in @@ -36,36 +34,17 @@ use strict; use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT); use Exporter qw(import); -use Debbugs::URI; -use HTML::Entities; -use Debbugs::Common qw(getparsedaddrs make_list); -use Params::Validate qw(validate_with :types); - -use Debbugs::Config qw(:config); -use Debbugs::Status qw(splitpackages isstrongseverity); -use Debbugs::User qw(); - -use Mail::Address; -use POSIX qw(ceil); -use Storable qw(dclone); - -use List::AllUtils qw(max); -use File::stat; -use Digest::MD5 qw(md5_hex); -use Carp; - -use Debbugs::Text qw(fill_in_template); +use feature qw(state); our %URL_PARAMS = (); - BEGIN{ ($VERSION) = q$Revision: 1.3 $ =~ /^Revision:\s+([^\s+])/; $DEBUG = 0 unless defined $DEBUG; @EXPORT = (); - %EXPORT_TAGS = (url => [qw(bug_url bug_links bug_linklist maybelink), - qw(set_url_params pkg_url version_url), + %EXPORT_TAGS = (url => [qw(bug_links bug_linklist maybelink), + qw(set_url_params version_url), qw(submitterurl mainturl munge_url), qw(package_links bug_links), ], @@ -86,6 +65,28 @@ BEGIN{ $EXPORT_TAGS{all} = [@EXPORT_OK]; } +use Debbugs::URI; +use URI::Escape; +use HTML::Entities; +use Debbugs::Common qw(getparsedaddrs make_list); +use Params::Validate qw(validate_with :types); + +use Debbugs::Config qw(:config); +use Debbugs::Status qw(splitpackages isstrongseverity); +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; +use Digest::MD5 qw(md5_hex); +use Carp; + +use Debbugs::Text qw(fill_in_template); + =head2 set_url_params @@ -108,44 +109,6 @@ sub set_url_params{ } -=head2 bug_url - - bug_url($ref,mbox=>'yes',mboxstat=>'yes'); - -Constructs urls which point to a specific - -XXX use Params::Validate - -=cut - -sub bug_url{ - my $ref = shift; - my %params; - if (@_ % 2) { - shift; - %params = (%URL_PARAMS,@_); - } - else { - %params = @_; - } - carp "bug_url is deprecated, use bug_links instead"; - - return munge_url('bugreport.cgi?',%params,bug=>$ref); -} - -sub pkg_url{ - my %params; - if (@_ % 2) { - shift; - %params = (%URL_PARAMS,@_); - } - else { - %params = @_; - } - carp "pkg_url is deprecated, use package_links instead"; - return munge_url('pkgreport.cgi?',%params); -} - =head2 munge_url my $url = munge_url($url,%params_to_munge); @@ -184,6 +147,8 @@ Creates a link to the version cgi script =item fixed -- arrayref of fixed versions +=item format -- optional image format override + =item width -- optional width of graph =item height -- optional height of graph @@ -208,6 +173,9 @@ sub version_url{ fixed => {type => ARRAYREF, default => [], }, + format => {type => SCALAR, + optional => 1, + }, width => {type => SCALAR, optional => 1, }, @@ -367,65 +335,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); @@ -472,36 +474,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 = ''; @@ -616,7 +629,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) = @_; @@ -633,8 +646,7 @@ link class C<$class>. XXX Use L; we want to be able to support query arguments here too; we should be able to combine bug_links and this -function into one. [Hell, bug_url should be one function with this one -too.] +function into one. =cut @@ -862,23 +874,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}):()),