From: Steve Peters Date: Wed, 3 May 2006 17:56:37 +0000 (+0000) Subject: Upgrade to CGI-3.20 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=adb8659329b6b21c13aee996474236c4f2b2a6a3;p=p5sagit%2Fp5-mst-13.2.git Upgrade to CGI-3.20 p4raw-id: //depot/perl@28082 --- diff --git a/lib/CGI.pm b/lib/CGI.pm index 98a88a0..3547a78 100644 --- 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 --- 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 --- 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 --- 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 --- 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(
\n), "initial dash followed by undashed arguments");