From: Nicholas Clark Date: Mon, 8 Sep 2008 19:13:28 +0000 (+0000) Subject: Upgrade to CGI.pm 3.42 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f8a128a908cdb4c1b46abe485eaf50aefccb33f6;p=p5sagit%2Fp5-mst-13.2.git Upgrade to CGI.pm 3.42 p4raw-id: //depot/perl@34320 --- diff --git a/lib/CGI.pm b/lib/CGI.pm index 5b3d3d2..9f32205 100644 --- a/lib/CGI.pm +++ b/lib/CGI.pm @@ -18,13 +18,13 @@ 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.259 2008/08/20 13:45:25 lstein Exp $'; -$CGI::VERSION='3.41_01'; # Changes 34208, 34278 +$CGI::revision = '$Id: CGI.pm,v 1.260 2008/09/08 14:13:23 lstein Exp $'; +$CGI::VERSION='3.42'; # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES. # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING. # $CGITempFile::TMPDIRECTORY = '/usr/tmp'; -use CGI::Util qw(rearrange make_attributes unescape escape expires ebcdic2ascii ascii2ebcdic); +use CGI::Util qw(rearrange rearrange_header make_attributes unescape escape expires ebcdic2ascii ascii2ebcdic); #use constant XHTML_DTD => ['-//W3C//DTD XHTML Basic 1.0//EN', # 'http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd']; @@ -1381,7 +1381,7 @@ END_OF_FUNC 'multipart_init' => <<'END_OF_FUNC', sub multipart_init { my($self,@p) = self_or_default(@_); - my($boundary,@other) = rearrange([BOUNDARY],@p); + my($boundary,@other) = rearrange_header([BOUNDARY],@p); $boundary = $boundary || '------- =_aaaaaaaaaa0'; $self->{'separator'} = "$CRLF--$boundary$CRLF"; $self->{'final_separator'} = "$CRLF--$boundary--$CRLF"; diff --git a/lib/CGI/Changes b/lib/CGI/Changes index e4f05fc..c9064c8 100644 --- a/lib/CGI/Changes +++ b/lib/CGI/Changes @@ -1,3 +1,11 @@ + + Version 3.42 + 1. Added patch from Renee Baecker that makes it possible to subclass + CGI::Pretty. + 2. Added patch from Nicholas Clark to allow ~ characters in temporary directories. + 3. Added patch from Renee Baecker that fixes the inappropriate escaping of fields + in multipart headers. + Version 3.41 1. Fix url() returning incorrect path when query string contains escaped newline. 2. Added additional windows temporary directories and environment variables, courtesy patch from Renee Baecker diff --git a/lib/CGI/Pretty.pm b/lib/CGI/Pretty.pm index 2147143..44e9186 100644 --- a/lib/CGI/Pretty.pm +++ b/lib/CGI/Pretty.pm @@ -176,6 +176,35 @@ sub initialize_globals { } sub _reset_globals { initialize_globals(); } +# ugly, but quick fix +sub import { + my $self = shift; + no strict 'refs'; + ${ "$self\::AutoloadClass" } = 'CGI'; + + # This causes modules to clash. + undef %CGI::EXPORT; + undef %CGI::EXPORT; + + $self->_setup_symbols(@_); + my ($callpack, $callfile, $callline) = caller; + + # To allow overriding, search through the packages + # Till we find one in which the correct subroutine is defined. + my @packages = ($self,@{"$self\:\:ISA"}); + foreach my $sym (keys %CGI::EXPORT) { + my $pck; + my $def = ${"$self\:\:AutoloadClass"} || $CGI::DefaultClass; + foreach $pck (@packages) { + if (defined(&{"$pck\:\:$sym"})) { + $def = $pck; + last; + } + } + *{"${callpack}::$sym"} = \&{"$def\:\:$sym"}; + } +} + 1; =head1 NAME diff --git a/lib/CGI/Util.pm b/lib/CGI/Util.pm index 9230eb9..5f49792 100644 --- a/lib/CGI/Util.pm +++ b/lib/CGI/Util.pm @@ -4,7 +4,7 @@ use strict; use vars qw($VERSION @EXPORT_OK @ISA $EBCDIC @A2E @E2A); require Exporter; @ISA = qw(Exporter); -@EXPORT_OK = qw(rearrange make_attributes unescape escape +@EXPORT_OK = qw(rearrange rearrange_header make_attributes unescape escape expires ebcdic2ascii ascii2ebcdic); $VERSION = '1.5_01'; @@ -70,16 +70,34 @@ elsif ($EBCDIC && ord('^') == 176) { # as in codepage 037 on os400 } # Smart rearrangement of parameters to allow named parameter -# calling. We do the rearangement if: +# calling. We do the rearrangement if: # the first parameter begins with a - + sub rearrange { + my ($order,@param) = @_; + my ($result, $leftover) = _rearrange_params( $order, @param ); + push @$result, make_attributes( $leftover, defined $CGI::Q ? $CGI::Q->{escape} : 1 ) + if keys %$leftover; + @$result; +} + +sub rearrange_header { + my ($order,@param) = @_; + + my ($result,$leftover) = _rearrange_params( $order, @param ); + push @$result, make_attributes( $leftover, 0, 1 ) if keys %$leftover; + + @$result; +} + +sub _rearrange_params { my($order,@param) = @_; - return () unless @param; + return [] unless @param; if (ref($param[0]) eq 'HASH') { @param = %{$param[0]}; } else { - return @param + return \@param unless (defined($param[0]) && substr($param[0],0,1) eq '-'); } @@ -103,14 +121,17 @@ sub rearrange { } } - push (@result,make_attributes(\%leftover,defined $CGI::Q ? $CGI::Q->{escape} : 1)) if %leftover; - @result; + return \@result, \%leftover; } sub make_attributes { my $attr = shift; return () unless $attr && ref($attr) && ref($attr) eq 'HASH'; my $escape = shift || 0; + my $do_not_quote = shift; + + my $quote = $do_not_quote ? '' : '"'; + my(@att); foreach (keys %{$attr}) { my($key) = $_; @@ -122,7 +143,7 @@ sub make_attributes { ($key="\L$key") =~ tr/_/-/; # parameters are lower case, use dashes my $value = $escape ? simple_escape($attr->{$_}) : $attr->{$_}; - push(@att,defined($attr->{$_}) ? qq/$key="$value"/ : qq/$key/); + push(@att,defined($attr->{$_}) ? qq/$key=$quote$value$quote/ : qq/$key/); } return @att; } diff --git a/lib/CGI/t/upload.t b/lib/CGI/t/upload.t index fabff44..58f0971 100644 --- a/lib/CGI/t/upload.t +++ b/lib/CGI/t/upload.t @@ -29,32 +29,45 @@ use CGI; # %ENV setup. #----------------------------------------------------------------------------- -%ENV = ( - %ENV, - 'SCRIPT_NAME' => '/test.cgi', - 'SERVER_NAME' => 'perl.org', - 'HTTP_CONNECTION' => 'TE, close', - 'REQUEST_METHOD' => 'POST', - 'SCRIPT_URI' => 'http://www.perl.org/test.cgi', - 'CONTENT_LENGTH' => 3285, - 'SCRIPT_FILENAME' => '/home/usr/test.cgi', - 'SERVER_SOFTWARE' => 'Apache/1.3.27 (Unix) ', - 'HTTP_TE' => 'deflate,gzip;q=0.3', - 'QUERY_STRING' => '', - 'REMOTE_PORT' => '1855', - 'HTTP_USER_AGENT' => 'Mozilla/5.0 (compatible; Konqueror/2.1.1; X11)', - 'SERVER_PORT' => '80', - 'REMOTE_ADDR' => '127.0.0.1', - 'CONTENT_TYPE' => 'multipart/form-data; boundary=xYzZY', - 'SERVER_PROTOCOL' => 'HTTP/1.1', - 'PATH' => '/usr/local/bin:/usr/bin:/bin', - 'REQUEST_URI' => '/test.cgi', - 'GATEWAY_INTERFACE' => 'CGI/1.1', - 'SCRIPT_URL' => '/test.cgi', - 'SERVER_ADDR' => '127.0.0.1', - 'DOCUMENT_ROOT' => '/home/develop', - 'HTTP_HOST' => 'www.perl.org' -); +my %myenv; + +BEGIN { + %myenv = ( + 'SCRIPT_NAME' => '/test.cgi', + 'SERVER_NAME' => 'perl.org', + 'HTTP_CONNECTION' => 'TE, close', + 'REQUEST_METHOD' => 'POST', + 'SCRIPT_URI' => 'http://www.perl.org/test.cgi', + 'CONTENT_LENGTH' => 3285, + 'SCRIPT_FILENAME' => '/home/usr/test.cgi', + 'SERVER_SOFTWARE' => 'Apache/1.3.27 (Unix) ', + 'HTTP_TE' => 'deflate,gzip;q=0.3', + 'QUERY_STRING' => '', + 'REMOTE_PORT' => '1855', + 'HTTP_USER_AGENT' => 'Mozilla/5.0 (compatible; Konqueror/2.1.1; X11)', + 'SERVER_PORT' => '80', + 'REMOTE_ADDR' => '127.0.0.1', + 'CONTENT_TYPE' => 'multipart/form-data; boundary=xYzZY', + 'SERVER_PROTOCOL' => 'HTTP/1.1', + 'PATH' => '/usr/local/bin:/usr/bin:/bin', + 'REQUEST_URI' => '/test.cgi', + 'GATEWAY_INTERFACE' => 'CGI/1.1', + 'SCRIPT_URL' => '/test.cgi', + 'SERVER_ADDR' => '127.0.0.1', + 'DOCUMENT_ROOT' => '/home/develop', + 'HTTP_HOST' => 'www.perl.org' + ); + + for my $key (keys %myenv) { + $ENV{$key} = $myenv{$key}; + } +} + +END { + for my $key (keys %myenv) { + delete $ENV{$key}; + } +} #----------------------------------------------------------------------------- # Simulate the upload (really, multiple uploads contained in a single stream). diff --git a/lib/CGI/t/uploadInfo.t b/lib/CGI/t/uploadInfo.t index b99c57e..591afa6 100644 --- a/lib/CGI/t/uploadInfo.t +++ b/lib/CGI/t/uploadInfo.t @@ -29,32 +29,46 @@ use CGI; # %ENV setup. #----------------------------------------------------------------------------- -%ENV = ( - %ENV, - 'SCRIPT_NAME' => '/test.cgi', - 'SERVER_NAME' => 'perl.org', - 'HTTP_CONNECTION' => 'TE, close', - 'REQUEST_METHOD' => 'POST', - 'SCRIPT_URI' => 'http://www.perl.org/test.cgi', - 'CONTENT_LENGTH' => 3285, - 'SCRIPT_FILENAME' => '/home/usr/test.cgi', - 'SERVER_SOFTWARE' => 'Apache/1.3.27 (Unix) ', - 'HTTP_TE' => 'deflate,gzip;q=0.3', - 'QUERY_STRING' => '', - 'REMOTE_PORT' => '1855', - 'HTTP_USER_AGENT' => 'Mozilla/5.0 (compatible; Konqueror/2.1.1; X11)', - 'SERVER_PORT' => '80', - 'REMOTE_ADDR' => '127.0.0.1', - 'CONTENT_TYPE' => 'multipart/form-data; boundary=xYzZY', - 'SERVER_PROTOCOL' => 'HTTP/1.1', - 'PATH' => '/usr/local/bin:/usr/bin:/bin', - 'REQUEST_URI' => '/test.cgi', - 'GATEWAY_INTERFACE' => 'CGI/1.1', - 'SCRIPT_URL' => '/test.cgi', - 'SERVER_ADDR' => '127.0.0.1', - 'DOCUMENT_ROOT' => '/home/develop', - 'HTTP_HOST' => 'www.perl.org' -); +my %myenv; + +BEGIN { + %myenv = ( + 'SCRIPT_NAME' => '/test.cgi', + 'SERVER_NAME' => 'perl.org', + 'HTTP_CONNECTION' => 'TE, close', + 'REQUEST_METHOD' => 'POST', + 'SCRIPT_URI' => 'http://www.perl.org/test.cgi', + 'CONTENT_LENGTH' => 3285, + 'SCRIPT_FILENAME' => '/home/usr/test.cgi', + 'SERVER_SOFTWARE' => 'Apache/1.3.27 (Unix) ', + 'HTTP_TE' => 'deflate,gzip;q=0.3', + 'QUERY_STRING' => '', + 'REMOTE_PORT' => '1855', + 'HTTP_USER_AGENT' => 'Mozilla/5.0 (compatible; Konqueror/2.1.1; X11)', + 'SERVER_PORT' => '80', + 'REMOTE_ADDR' => '127.0.0.1', + 'CONTENT_TYPE' => 'multipart/form-data; boundary=xYzZY', + 'SERVER_PROTOCOL' => 'HTTP/1.1', + 'PATH' => '/usr/local/bin:/usr/bin:/bin', + 'REQUEST_URI' => '/test.cgi', + 'GATEWAY_INTERFACE' => 'CGI/1.1', + 'SCRIPT_URL' => '/test.cgi', + 'SERVER_ADDR' => '127.0.0.1', + 'DOCUMENT_ROOT' => '/home/develop', + 'HTTP_HOST' => 'www.perl.org' + ); + + for my $key (keys %myenv) { + $ENV{$key} = $myenv{$key}; + } +} + +END { + for my $key (keys %myenv) { + delete $ENV{$key}; + } +} + #----------------------------------------------------------------------------- # Simulate the upload (really, multiple uploads contained in a single stream).