X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FCGI.pm;h=13e4557ae062c718e1f095b21faf8c0749594989;hb=fac30aacb5b9a104a1216af15fc04e227f9ef447;hp=73b5bb6b56f4825cd2a58ff007e6fdd419db758c;hpb=66af39a73332329a1227b6b9ea3489cd977f98e9;p=debbugs.git diff --git a/Debbugs/CGI.pm b/Debbugs/CGI.pm index 73b5bb6..13e4557 100644 --- a/Debbugs/CGI.pm +++ b/Debbugs/CGI.pm @@ -1,3 +1,11 @@ +# This module 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 2007 by Don Armstrong . package Debbugs::CGI; @@ -37,7 +45,7 @@ use Mail::Address; use POSIX qw(ceil); use Storable qw(dclone); -my %URL_PARAMS = (); +our %URL_PARAMS = (); BEGIN{ @@ -47,7 +55,7 @@ BEGIN{ @EXPORT = (); %EXPORT_TAGS = (url => [qw(bug_url bug_links bug_linklist maybelink), qw(set_url_params pkg_url version_url), - qw(submitterurl mainturl) + qw(submitterurl mainturl munge_url) ], html => [qw(html_escape htmlize_bugs htmlize_packagelinks), qw(maybelink htmlize_addresslinks htmlize_maintlinks), @@ -55,10 +63,11 @@ BEGIN{ util => [qw(cgi_parameters quitcgi), qw(getpseudodesc) ], + misc => [qw(maint_decode)], #status => [qw(getbugstatus)], ); @EXPORT_OK = (); - Exporter::export_ok_tags(qw(url html util)); + Exporter::export_ok_tags(qw(url html util misc)); $EXPORT_TAGS{all} = [@EXPORT_OK]; } @@ -104,9 +113,7 @@ sub bug_url{ else { %params = @_; } - my $url = Debbugs::URI->new('bugreport.cgi?'); - $url->query_form(bug=>$ref,%params); - return $url->as_string; + return munge_url('bugreport.cgi?',%params,bug=>$ref); } sub pkg_url{ @@ -118,11 +125,31 @@ sub pkg_url{ else { %params = @_; } - my $url = Debbugs::URI->new('pkgreport.cgi?'); - $url->query_form(%params); - return $url->as_string; + return munge_url('pkgreport.cgi?',%params); } +=head2 munge_url + + my $url = munge_url($url,%params_to_munge); + +Munges a url, replacing parameters with %params_to_munge as appropriate. + +=cut + +sub munge_url { + my $url = shift; + my %params = @_; + my $new_url = Debbugs::URI->new($url); + my @old_param = $new_url->query_form(); + my @new_param; + while (my ($key,$value) = splice @old_param,0,2) { + push @new_param,($key,$value) unless exists $params{$key}; + } + $new_url->query_form(@new_param,%params); + return $new_url->as_string; +} + + =head2 version_url version_url($package,$found,$fixed) @@ -138,7 +165,8 @@ sub version_url{ found => $found, fixed => $fixed, (defined $width)?(width => $width):(), - (defined $height)?(height => $height):() + (defined $height)?(height => $height):(), + (defined $width or defined $height)?(collapse => 1):(info => 1), ); return $url->as_string; } @@ -212,10 +240,6 @@ sub quitcgi { } -my %common_bugusertags; - - - =head HTML =head2 htmlize_bugs @@ -458,10 +482,10 @@ sub htmlize_maintlinks { } -my $_maintainer; -my $_maintainer_rev; +our $_maintainer; +our $_maintainer_rev; -my $_pseudodesc; +our $_pseudodesc; sub getpseudodesc { return $_pseudodesc if $_pseudodesc; my %pseudodesc; @@ -531,6 +555,36 @@ sub bug_linklist{ } +=head1 misc + +=cut + +=head2 maint_decode + + maint_decode + +Decodes the funky maintainer encoding. + +Don't ask me what in the world it does. + +=cut + +sub maint_decode { + my @input = @_; + return () unless @input; + my @output; + for my $input (@input) { + my $decoded = $input; + $decoded =~ s/-([^_]+)/-$1_-/g; + $decoded =~ s/_/-20_/g; + $decoded =~ s/^,(.*),(.*),([^,]+)$/$1-40_$2-20_-28_$3-29_/; + $decoded =~ s/^([^,]+),(.*),(.*),/$1-20_-3c_$2-40_$3-3e_/; + $decoded =~ s/\./-2e_/g; + $decoded =~ s/-([0-9a-f]{2})_/pack('H*',$1)/ge; + push @output,$decoded; + } + wantarray ? @output : $output[0]; +} 1;