Change 34320 by [EMAIL PROTECTED] on 2008/09/08 19:13:28
Upgrade to CGI.pm 3.42
Affected files ...
... //depot/perl/lib/CGI.pm#83 edit
... //depot/perl/lib/CGI/Changes#19 edit
... //depot/perl/lib/CGI/Pretty.pm#13 edit
... //depot/perl/lib/CGI/Util.pm#22 edit
... //depot/perl/lib/CGI/t/upload.t#3 edit
... //depot/perl/lib/CGI/t/uploadInfo.t#2 edit
Differences ...
==== //depot/perl/lib/CGI.pm#83 (text) ====
Index: perl/lib/CGI.pm
--- perl/lib/CGI.pm#82~34302~ 2008-09-07 01:46:13.000000000 -0700
+++ perl/lib/CGI.pm 2008-09-08 12:13:28.000000000 -0700
@@ -18,13 +18,13 @@
# 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 @@
'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";
==== //depot/perl/lib/CGI/Changes#19 (text) ====
Index: perl/lib/CGI/Changes
--- perl/lib/CGI/Changes#18~34302~ 2008-09-07 01:46:13.000000000 -0700
+++ perl/lib/CGI/Changes 2008-09-08 12:13:28.000000000 -0700
@@ -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
==== //depot/perl/lib/CGI/Pretty.pm#13 (text) ====
Index: perl/lib/CGI/Pretty.pm
--- perl/lib/CGI/Pretty.pm#12~24326~ 2005-04-26 05:49:03.000000000 -0700
+++ perl/lib/CGI/Pretty.pm 2008-09-08 12:13:28.000000000 -0700
@@ -176,6 +176,35 @@
}
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
==== //depot/perl/lib/CGI/Util.pm#22 (text) ====
Index: perl/lib/CGI/Util.pm
--- perl/lib/CGI/Util.pm#21~33564~ 2008-03-25 08:27:06.000000000 -0700
+++ perl/lib/CGI/Util.pm 2008-09-08 12:13:28.000000000 -0700
@@ -4,7 +4,7 @@
use vars qw($VERSION @EXPORT_OK @ISA $EBCDIC @A2E @E2A);
require Exporter;
@ISA = qw(Exporter);
[EMAIL PROTECTED] = qw(rearrange make_attributes unescape escape
[EMAIL PROTECTED] = qw(rearrange rearrange_header make_attributes unescape
escape
expires ebcdic2ascii ascii2ebcdic);
$VERSION = '1.5_01';
@@ -70,16 +70,34 @@
}
# 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 [EMAIL PROTECTED]
unless (defined($param[0]) && substr($param[0],0,1) eq '-');
}
@@ -103,14 +121,17 @@
}
}
- push (@result,make_attributes(\%leftover,defined $CGI::Q ?
$CGI::Q->{escape} : 1)) if %leftover;
- @result;
+ return [EMAIL PROTECTED], \%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 @@
($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;
}
==== //depot/perl/lib/CGI/t/upload.t#3 (text) ====
Index: perl/lib/CGI/t/upload.t
--- perl/lib/CGI/t/upload.t#2~33773~ 2008-04-30 05:57:38.000000000 -0700
+++ perl/lib/CGI/t/upload.t 2008-09-08 12:13:28.000000000 -0700
@@ -29,32 +29,45 @@
# %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).
==== //depot/perl/lib/CGI/t/uploadInfo.t#2 (text) ====
Index: perl/lib/CGI/t/uploadInfo.t
--- perl/lib/CGI/t/uploadInfo.t#1~33592~ 2008-03-28 12:16:53.000000000
-0700
+++ perl/lib/CGI/t/uploadInfo.t 2008-09-08 12:13:28.000000000 -0700
@@ -29,32 +29,46 @@
# %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).
End of Patch.
