Skip some File::Copy tests on Win32 since file permissions do not

[perl5.git] / lib / CGI.pm

diff --git a/lib/CGI.pm b/lib/CGI.pm
index fc29d67..a77a645 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.247 2008/03/14 14:29:36 lstein Exp $';
-$CGI::VERSION='3.34_01';
+$CGI::revision = '$Id: CGI.pm,v 1.251 2008/04/23 13:08:23 lstein Exp $';
+$CGI::VERSION='3.37';
 
 # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
 # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -37,7 +37,12 @@ use constant XHTML_DTD => ['-//W3C//DTD XHTML 1.0 Transitional//EN',
   $TAINTED = substr("$0$^X",0,0);
 }
 
-$MOD_PERL = 0; # no mod_perl by default
+$MOD_PERL            = 0; # no mod_perl by default
+
+#global settings
+$POST_MAX            = -1; # no limit to uploaded files
+$DISABLE_UPLOADS     = 0;
+
 @SAVED_SYMBOLS = ();
 
 
@@ -91,13 +96,6 @@ sub initialize_globals {
     # it can just be renamed, instead of read and written.
     $CLOSE_UPLOAD_FILES = 0;
 
-    # Set this to a positive value to limit the size of a POSTing
-    # to a certain number of bytes:
-    $POST_MAX = -1;
-
-    # Change this to 1 to disable uploads entirely:
-    $DISABLE_UPLOADS = 0;
-
     # Automatically determined -- don't change
     $EBCDIC = 0;
 
@@ -355,6 +353,7 @@ sub new {
       $self->r(Apache->request) unless $self->r;
       my $r = $self->r;
       $r->register_cleanup(\&CGI::_reset_globals);
+      $self->_setup_symbols(@SAVED_SYMBOLS) if @SAVED_SYMBOLS;
     }
     else {
       # XXX: once we have the new API
@@ -363,6 +362,7 @@ sub new {
       my $r = $self->r;
       $r->subprocess_env unless exists $ENV{REQUEST_METHOD};
       $r->pool->cleanup_register(\&CGI::_reset_globals);
+      $self->_setup_symbols(@SAVED_SYMBOLS) if @SAVED_SYMBOLS;
     }
     undef $NPH;
   }
@@ -2569,6 +2569,7 @@ sub scrolling_list {
     $size = $size || scalar(@values);
 
     my(%selected) = $self->previous_or_default($name,$defaults,$override);
+
     my($is_multiple) = $multiple ? qq/ multiple="multiple"/ : '';
     my($has_size) = $size ? qq/ size="$size"/: '';
     my($other) = @other ? " @other" : '';
@@ -3381,12 +3382,12 @@ sub read_multipart {
        my($param)= $header{'Content-Disposition'}=~/ name="([^"]*)"/;
         $param .= $TAINTED;
 
-       # Bug:  Netscape doesn't escape quotation marks in file names!!!
-       # See RFC 1867, 2183, 2045
-       # NB: File content will be loaded into memory should
-       # content-disposition parsing fail.
-       my ($filename) = $header{'Content-Disposition'}=~/ filename=(("[^"]*")|([a-z\d!\#'\*\+,\.^_\`\{\}\|\~]*))/i;
-       $filename =~ s/^"([^"]*)"$/$1/;
+        # See RFC 1867, 2183, 2045
+        # NB: File content will be loaded into memory should
+        # content-disposition parsing fail.
+        my ($filename) = $header{'Content-Disposition'}
+                      =~/ filename=(("[^"]*")|([a-z\d!\#'\*\+,\.^_\`\{\}\|\~]*))/i;
+        $filename =~ s/^"([^"]*)"$/$1/;
        # Test for Opera's multiple upload feature
        my($multipart) = ( defined( $header{'Content-Type'} ) &&
                $header{'Content-Type'} =~ /multipart\/mixed/ ) ?
@@ -3782,7 +3783,7 @@ sub new {
     }
 
     my $self = {LENGTH=>$length,
-               CHUNKED=>!defined $length,
+               CHUNKED=>!$length,
                BOUNDARY=>$boundary,
                INTERFACE=>$interface,
                BUFFER=>'',