+# 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 <don@donarmstrong.com>.
package Debbugs::CGI;
use Debbugs::Common qw(getparsedaddrs);
use Params::Validate qw(validate_with :types);
use Debbugs::Config qw(:config);
-use Debbugs::Status qw(splitpackages);
+use Debbugs::Status qw(splitpackages isstrongseverity);
use Mail::Address;
use POSIX qw(ceil);
use Storable qw(dclone);
-my %URL_PARAMS = ();
+our %URL_PARAMS = ();
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),
],
util => [qw(cgi_parameters quitcgi),
- qw(getmaintainers 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];
}
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{
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)
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;
}
sub html_escape{
my ($string) = @_;
- return HTML::Entities::encode_entities($string)
+ return HTML::Entities::encode_entities($string,q(<>&"'));
}
=head2 cgi_parameters
}
-my %common_bugusertags;
-
-
-
=head HTML
=head2 htmlize_bugs
}
-my $_maintainer;
-my $_maintainer_rev;
-sub getmaintainers {
- return $_maintainer if $_maintainer;
- my %maintainer;
- my %maintainer_rev;
- for my $file (@config{qw(maintainer_file maintainer_file_override)}) {
- next unless defined $file;
- my $maintfile = new IO::File $file,'r' or
- &quitcgi("Unable to open $file: $!");
- while(<$maintfile>) {
- next unless m/^(\S+)\s+(\S.*\S)\s*$/;
- ($a,$b)=($1,$2);
- $a =~ y/A-Z/a-z/;
- $maintainer{$a}= $b;
- for my $maint (map {lc($_->address)} getparsedaddrs($b)) {
- push @{$maintainer_rev{$maint}},$a;
- }
- }
- close($maintfile);
- }
- $_maintainer = \%maintainer;
- $_maintainer_rev = \%maintainer_rev;
- return $_maintainer;
-}
-sub getmaintainers_reverse{
- return $_maintainer_rev if $_maintainer_rev;
- getmaintainers();
- return $_maintainer_rev;
-}
-
-
-my $_pseudodesc;
-sub getpseudodesc {
- return $_pseudodesc if $_pseudodesc;
- my %pseudodesc;
-
- my $pseudo = new IO::File $config{pseudo_desc_file},'r'
- or &quitcgi("Unable to open $config{pseudo_desc_file}: $!");
- while(<$pseudo>) {
- next unless m/^(\S+)\s+(\S.*\S)\s*$/;
- $pseudodesc{lc $1} = $2;
- }
- close($pseudo);
- $_pseudodesc = \%pseudodesc;
- return $_pseudodesc;
-}
-
+our $_maintainer;
+our $_maintainer_rev;
=head2 bug_links
}
+=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;