Upgrade to CGI-3.20

p4raw-id: //depot/perl@28082

diff --git a/lib/CGI.pm b/lib/CGI.pm
index 98a88a0..3547a78 100644 (file)
--- a/lib/CGI.pm
+++ b/lib/CGI.pm
@@ -18,8 +18,8 @@ use Carp 'croak';
 # The most recent version and complete docs are available at:
 #   http://stein.cshl.org/WWW/software/CGI/
 
-$CGI::revision = '$Id: CGI.pm,v 1.206 2006/04/17 13:53:02 lstein Exp $';
-$CGI::VERSION='3.19';
+$CGI::revision = '$Id: CGI.pm,v 1.208 2006/04/23 14:25:14 lstein Exp $';
+$CGI::VERSION='3.20';
 
 # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
 # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -40,6 +40,7 @@ use constant XHTML_DTD => ['-//W3C//DTD XHTML 1.0 Transitional//EN',
 $MOD_PERL = 0; # no mod_perl by default
 @SAVED_SYMBOLS = ();
 
+
 # >>>>> Here are some globals that you might want to adjust <<<<<<
 sub initialize_globals {
     # Set this to 1 to enable copious autoloader debugging messages
@@ -1825,9 +1826,7 @@ END_OF_FUNC
 sub start_multipart_form {
     my($self,@p) = self_or_default(@_);
     if (defined($p[0]) && substr($p[0],0,1) eq '-') {
-       my(%p) = @p;
-       $p{'-enctype'}=&MULTIPART;
-       return $self->startform(%p);
+      return $self->startform(-enctype=>&MULTIPART,@p);
     } else {
        my($method,$action,@other) = 
            rearrange([METHOD,ACTION],@p);
@@ -2645,7 +2644,7 @@ sub url {
 
     my $uri         =  $rewrite && $request_uri ? $request_uri : $script_name;
     $uri            =~ s/\?.*$//;                                 # remove query string
-    $uri            =~ s/\Q$path\E$//      if defined $path;          # remove path
+    $uri            =~ s/\Q$path\E$//      if defined $path;      # remove path
 
     if ($full) {
        my $protocol = $self->protocol();
@@ -2778,7 +2777,8 @@ sub _name_and_path_from_env {
    my $raw_path_info   = $ENV{PATH_INFO}   || '';
    my $uri             = unescape($self->request_uri) || '';
 
-   $raw_script_name =~ s/\Q$raw_path_info$\E//;
+   my $protected    = quotemeta($raw_path_info);
+   $raw_script_name =~ s/$protected$//;
 
    my @uri_double_slashes  = $uri =~ m^(/{2,}?)^g;
    my @path_double_slashes = "$raw_script_name $raw_path_info" =~ m^(/{2,}?)^g;

diff --git a/lib/CGI/Changes b/lib/CGI/Changes
index 6b33622..cc2d1a3 100644 (file)
--- a/lib/CGI/Changes
+++ b/lib/CGI/Changes
@@ -1,3 +1,11 @@
+  Version 3.20
+  1. Patch from David Wheeler for CGI::Cookie->bake(). Uses mod_perl headers_out->add()
+       rather than headers_out->set().
+  2. Fixed problem identified by Andrei Voronkov in which start_form() output was screwed
+       up when initial argument begins with a dash and subsequent arguments do not.
+  3. Quashed uninitialized variable warnings coming from script_name(), url() and other
+        functions that require access to the PATH_INFO environment variable.
+
   Version 3.19
   1. Added patch from Stephen Frost that allows one to suppress use of the temp file that is
        created during uploads.

diff --git a/lib/CGI/Cookie.pm b/lib/CGI/Cookie.pm
index bdc34bb..f4ba148 100644 (file)
--- a/lib/CGI/Cookie.pm
+++ b/lib/CGI/Cookie.pm
@@ -182,7 +182,7 @@ sub bake {
           : Apache->request
   } if $MOD_PERL;
   if ($r) {
-      $r->headers_out->set('Set-Cookie' => $self->as_string);
+      $r->headers_out->add('Set-Cookie' => $self->as_string);
   } else {
       print CGI::header(-cookie => $self);
   }

diff --git a/lib/CGI/t/cookie.t b/lib/CGI/t/cookie.t
index 4d91d48..539ac7a 100644 (file)
--- a/lib/CGI/t/cookie.t
+++ b/lib/CGI/t/cookie.t
@@ -363,7 +363,7 @@ sub isa {
     return $pkg eq 'Apache';
 }
 sub headers_out { shift }
-sub set { shift->{check} = \@_; }
+sub add { shift->{check} = \@_; }
 
 package Apache2::Faker;
 sub new { bless {}, shift }
@@ -372,4 +372,4 @@ sub isa {
     return $pkg eq 'Apache2::RequestReq';
 }
 sub headers_out { shift }
-sub set { shift->{check} = \@_; }
+sub add { shift->{check} = \@_; }

diff --git a/lib/CGI/t/function.t b/lib/CGI/t/function.t
index 2560df4..4ff67d5 100755 (executable)
--- a/lib/CGI/t/function.t
+++ b/lib/CGI/t/function.t
@@ -4,9 +4,9 @@ use lib qw(t/lib);
 
 # Test ability to retrieve HTTP request info
 ######################### We start with some black magic to print on failure.
-use lib '../blib/lib','../blib/arch';
+use lib '.','..','../blib/lib','../blib/arch';
 
-BEGIN {$| = 1; print "1..31\n"; }
+BEGIN {$| = 1; print "1..32\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Config;
 use CGI (':standard','keywords');
@@ -113,3 +113,5 @@ test(29, charset("UTF-8") && header() eq "Content-Type: text/html; charset=UTF-8
 test(30, !charset("") && header() eq "Content-Type: text/html${CRLF}${CRLF}", "Empty charset");
 
 test(31, header(-foo=>'bar') eq "Foo: bar${CRLF}Content-Type: text/html${CRLF}${CRLF}", "Custom header");
+
+test(32, start_form(-action=>'one',name=>'two',onsubmit=>'three') eq qq(<form method="post" action="one" enctype="multipart/form-data" onsubmit="three" name="two">\n), "initial dash followed by undashed arguments");