projects / p5sagit/p5-mst-13.2.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw (from parent 1: 2234743)
Upgrade to CGI.pm 3.42
Nicholas Clark [Mon, 8 Sep 2008 19:13:28 +0000 (19:13 +0000)]
p4raw-id: //depot/perl@34320

lib/CGI.pm patch | blob | blame | history
lib/CGI/Changes patch | blob | blame | history
lib/CGI/Pretty.pm patch | blob | blame | history
lib/CGI/Util.pm patch | blob | blame | history
lib/CGI/t/upload.t patch | blob | blame | history
lib/CGI/t/uploadInfo.t patch | blob | blame | history

diff --git a/lib/CGI.pm b/lib/CGI.pm
index 5b3d3d2..9f32205 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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).
Unnamed repository; edit this file to name it for gitweb.