X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FCGI.pm;h=8fc14f28289c27815e38723b37b06878cdf046a9;hb=851b0a55706a2d56ca26879d90c6e8f3eca4d69c;hp=e8321299cc7debab922a980e108df2dbedc0a9f5;hpb=58e4bee353b3570f306e84567f1e38efa00f80f8;p=debbugs.git

diff --git a/Debbugs/CGI.pm b/Debbugs/CGI.pm
index e832129..8fc14f2 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 <don@donarmstrong.com>.
 
 package Debbugs::CGI;
 
@@ -32,12 +40,12 @@ use HTML::Entities;
 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{
@@ -47,18 +55,18 @@ 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];
 }
 
@@ -104,9 +112,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 +124,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 +164,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;
 }
@@ -154,7 +181,7 @@ Escapes html entities by calling HTML::Entities::encode_entities;
 sub html_escape{
      my ($string) = @_;
 
-     return HTML::Entities::encode_entities($string)
+     return HTML::Entities::encode_entities($string,q(<>&"'));
 }
 
 =head2 cgi_parameters
@@ -212,10 +239,6 @@ sub quitcgi {
 }
 
 
-my %common_bugusertags;
-
-
-
 =head HTML
 
 =head2 htmlize_bugs
@@ -458,54 +481,8 @@ sub htmlize_maintlinks {
 }
 
 
-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
 
@@ -560,6 +537,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;