Change 34343 by [EMAIL PROTECTED] on 2008/09/11 14:14:37
Integrate:
[ 34331]
Integrate:
[ 34208]
Subject: Re: Re: [perl #30524] [PATCH] CGI.pm has poor list of temp
directories on Windows
From: [EMAIL PROTECTED]
Date: Wed, 20 Aug 2008 11:26:02 +0200 (CEST)
Message-Id: <[EMAIL PROTECTED]>
[ 34278]
Fix a couple of failing CGI.pm tests on Win32
(My temporary directory is C:\DOCUME~1\shay\LOCALS~1\Temp, so we need
to allow ~ characters.)
[ 34302]
Upgrade to CGI.pm 3.41
Local change 34208, 34278 remain.
[ 34320]
Upgrade to CGI.pm 3.42
[ 34332]
Integrate:
[ 34282]
Subject: [PATCH] bugfix, AutoLoader 0.67
From: Steffen Mueller <[EMAIL PROTECTED]>
Message-ID: <[EMAIL PROTECTED]>
Date: Fri, 05 Sep 2008 13:56:01 +0200
Affected files ...
... //depot/maint-5.8/perl/lib/AutoLoader.pm#6 integrate
... //depot/maint-5.8/perl/lib/AutoLoader/t/01AutoLoader.t#2 integrate
... //depot/maint-5.8/perl/lib/CGI.pm#25 integrate
... //depot/maint-5.8/perl/lib/CGI/Changes#10 integrate
... //depot/maint-5.8/perl/lib/CGI/Pretty.pm#6 integrate
... //depot/maint-5.8/perl/lib/CGI/Util.pm#13 integrate
... //depot/maint-5.8/perl/lib/CGI/t/upload.t#2 integrate
... //depot/maint-5.8/perl/lib/CGI/t/uploadInfo.t#2 integrate
Differences ...
==== //depot/maint-5.8/perl/lib/AutoLoader.pm#6 (text) ====
Index: perl/lib/AutoLoader.pm
--- perl/lib/AutoLoader.pm#5~33925~ 2008-05-25 13:50:26.000000000 -0700
+++ perl/lib/AutoLoader.pm 2008-09-11 07:14:37.000000000 -0700
@@ -15,7 +15,7 @@
$is_epoc = $^O eq 'epoc';
$is_vms = $^O eq 'VMS';
$is_macos = $^O eq 'MacOS';
- $VERSION = '5.66';
+ $VERSION = '5.67';
}
AUTOLOAD {
@@ -155,17 +155,20 @@
(my $calldir = $callpkg) =~ s#::#/#g;
my $path = $INC{$calldir . '.pm'};
if (defined($path)) {
- # Try absolute path name.
+ # Try absolute path name, but only eval it if the
+ # transformation from module path to autosplit.ix path
+ # succeeded!
+ my $replaced_okay;
if ($is_macos) {
(my $malldir = $calldir) =~ tr#/#:#;
- $path =~ s#^(.*)$malldir\.pm\z#$1auto:$malldir:autosplit.ix#s;
+ $replaced_okay = ($path =~
s#^(.*)$malldir\.pm\z#$1auto:$malldir:autosplit.ix#s);
} else {
- $path =~ s#^(.*)$calldir\.pm\z#$1auto/$calldir/autosplit.ix#;
+ $replaced_okay = ($path =~
s#^(.*)$calldir\.pm\z#$1auto/$calldir/autosplit.ix#);
}
- eval { require $path; };
+ eval { require $path; } if $replaced_okay;
# If that failed, try relative path with normal @INC searching.
- if ($@) {
+ if (!$replaced_okay or $@) {
$path ="auto/$calldir/autosplit.ix";
eval { require $path; };
}
==== //depot/maint-5.8/perl/lib/AutoLoader/t/01AutoLoader.t#2 (xtext) ====
Index: perl/lib/AutoLoader/t/01AutoLoader.t
--- perl/lib/AutoLoader/t/01AutoLoader.t#1~33173~ 2008-02-01
11:33:57.000000000 -0800
+++ perl/lib/AutoLoader/t/01AutoLoader.t 2008-09-11 07:14:37.000000000
-0700
@@ -14,51 +14,44 @@
my $dir;
BEGIN
{
- $dir = File::Spec->catdir( "auto-$$" );
+ $dir = File::Spec->catdir( "auto-$$" );
unshift @INC, $dir;
}
-use Test::More tests => 17;
+use Test::More tests => 18;
+
+sub write_file {
+ my ($file, $text) = @_;
+ open my $fh, '>', $file
+ or die "Could not open file '$file' for writing: $!";
+ print $fh $text;
+ close $fh;
+}
# First we must set up some autoloader files
my $fulldir = File::Spec->catdir( $dir, 'auto', 'Foo' );
mkpath( $fulldir ) or die "Can't mkdir '$fulldir': $!";
-open(FOO, '>', File::Spec->catfile( $fulldir, 'foo.al' ))
- or die "Can't open foo file: $!";
-print FOO <<'EOT';
+write_file( File::Spec->catfile( $fulldir, 'foo.al' ), <<'EOT' );
package Foo;
sub foo { shift; shift || "foo" }
1;
EOT
-close(FOO);
-open(BAZ, '>', File::Spec->catfile( $fulldir, 'bazmarkhian.al' ))
- or die "Can't open bazmarkhian file: $!";
-print BAZ <<'EOT';
+write_file( File::Spec->catfile( $fulldir, 'bazmarkhian.al' ), <<'EOT' );
package Foo;
sub bazmarkhianish { shift; shift || "baz" }
1;
EOT
-close(BAZ);
-open(BLECH, '>', File::Spec->catfile( $fulldir, 'blechanawilla.al' ))
- or die "Can't open blech file: $!";
-print BLECH <<'EOT';
+my $blechanawilla_text = <<'EOT';
package Foo;
sub blechanawilla { compilation error (
EOT
-close(BLECH);
-
+write_file( File::Spec->catfile( $fulldir, 'blechanawilla.al' ),
$blechanawilla_text );
# This is just to keep the old SVR3 systems happy; they may fail
# to find the above file so we duplicate it where they should find it.
-open(BLECH, '>', File::Spec->catfile( $fulldir, 'blechanawil.al' ))
- or die "Can't open blech file: $!";
-print BLECH <<'EOT';
-package Foo;
-sub blechanawilla { compilation error (
-EOT
-close(BLECH);
+write_file( File::Spec->catfile( $fulldir, 'blechanawil.al' ),
$blechanawilla_text );
# Let's define the package
package Foo;
@@ -111,24 +104,18 @@
like( $@, qr/syntax error/i, 'require error propagates' );
# test recursive autoloads
-open(F, '>', File::Spec->catfile( $fulldir, 'a.al'))
- or die "Cannot make 'a' file: $!";
-print F <<'EOT';
+write_file( File::Spec->catfile( $fulldir, 'a.al' ), <<'EOT' );
package Foo;
BEGIN { b() }
sub a { ::ok( 1, 'adding a new autoloaded method' ); }
1;
EOT
-close(F);
-
-open(F, '>', File::Spec->catfile( $fulldir, 'b.al'))
- or die "Cannot make 'b' file: $!";
-print F <<'EOT';
+write_file( File::Spec->catfile( $fulldir, 'b.al' ), <<'EOT' );
package Foo;
sub b { ::ok( 1, 'adding a new autoloaded method' ) }
1;
EOT
-close(F);
+
Foo::a();
package Bar;
@@ -140,7 +127,7 @@
AutoLoader->unimport();
eval { Foo->baz() };
::like( $@, qr/locate object method "baz"/,
- 'unimport() should remove imported AUTOLOAD()' );
+ 'unimport() should remove imported AUTOLOAD()' );
package Baz;
@@ -166,8 +153,70 @@
} # <-- deep recursion in AUTOLOAD looking for SomeClass::DESTROY?
::ok(1, "AutoLoader shouldn't loop forever if \%INC is modified");
+# Now test the bug that lead to AutoLoader 0.67:
+# If the module is loaded from a file name different than normal,
+# we could formerly have trouble finding autosplit.ix
+# Contributed by Christoph Lamprecht.
+# Recreate the following file structure:
+# auto/MyAddon/autosplit.ix
+# auto/MyAddon/testsub.al
+# MyModule.pm
+SCOPE: {
+ my $autopath = File::Spec->catdir( $dir, 'auto', 'MyAddon' );
+ mkpath( $autopath ) or die "Can't mkdir '$autopath': $!";
+ my $autosplit_text = <<'EOT';
+# Index created by AutoSplit for MyModule.pm
+# (file acts as timestamp)
+package MyAddon;
+sub testsub ;
+1;
+EOT
+ write_file( File::Spec->catfile( $autopath, 'autosplit.ix' ),
$autosplit_text );
+
+ my $testsub_text = <<'EOT';
+# NOTE: Derived from MyModule.pm.
+# Changes made here will be lost when autosplit is run again.
+# See AutoSplit.pm.
+package MyAddon;
+
+#line 13 "MyModule.pm (autosplit into auto/MyAddon/testsub.al)"
+sub testsub{
+ return "MyAddon";
+}
+
+1;
+# end of MyAddon::testsub
+EOT
+ write_file( File::Spec->catfile( $autopath, 'testsub.al' ), $testsub_text);
+
+ my $mymodule_text = <<'EOT';
+use strict;
+use warnings;
+package MyModule;
+sub testsub{return 'MyModule';}
+
+package MyAddon;
+our @ISA = ('MyModule');
+BEGIN{$INC{'MyAddon.pm'} = __FILE__}
+use AutoLoader 'AUTOLOAD';
+1;
+__END__
+
+sub testsub{
+ return "MyAddon";
+}
+EOT
+ write_file( File::Spec->catfile( $dir, 'MyModule.pm' ), $mymodule_text);
+
+ require MyModule;
+
+ my $res = MyAddon->testsub();
+ ::is ($res , 'MyAddon', 'invoke MyAddon::testsub');
+}
+
# cleanup
END {
- return unless $dir && -d $dir;
- rmtree $dir;
+ return unless $dir && -d $dir;
+ rmtree $dir;
}
+
==== //depot/maint-5.8/perl/lib/CGI.pm#25 (text) ====
Index: perl/lib/CGI.pm
--- perl/lib/CGI.pm#24~34287~ 2008-09-05 15:36:23.000000000 -0700
+++ perl/lib/CGI.pm 2008-09-11 07:14:37.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.257 2008/08/06 14:01:06 lstein Exp $';
-$CGI::VERSION='3.40';
+$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";
@@ -2720,8 +2720,9 @@
undef $path if $rewrite_in_use && $rewrite; # path not valid when
rewriting active
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/\?.*$//s; # remove
query string
+ $uri =~ s/\Q$ENV{PATH_INFO}\E$// if defined $ENV{PATH_INFO};
+# $uri =~ s/\Q$path\E$// if defined $path; # remove
path
if ($full) {
my $protocol = $self->protocol();
@@ -3709,6 +3710,7 @@
################### Fh -- lightweight filehandle ###############
package Fh;
+
use overload
'""' => \&asString,
'cmp' => \&compare,
@@ -3760,7 +3762,7 @@
(my $safename = $name) =~ s/([':%])/ sprintf '%%%02X', ord $1 /eg;
my $fv = ++$FH . $safename;
my $ref = \*{"Fh::$fv"};
- $file =~ m!^([a-zA-Z0-9_\+ \'\":/.\$\\-]+)$! || return;
+ $file =~ m!^([a-zA-Z0-9_\+ \'\":/.\$\\~-]+)$! || return;
my $safe = $1;
sysopen($ref,$safe,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL(),0600)
|| return;
unlink($safe) if $delete;
@@ -3769,6 +3771,14 @@
}
END_OF_FUNC
+'handle' => <<'END_OF_FUNC',
+sub handle {
+ my $self = shift;
+ eval "require IO::Handle" unless IO::Handle->can('new_from_fd');
+ return IO::Handle->new_from_fd(fileno $self,"<");
+}
+END_OF_FUNC
+
);
END_OF_AUTOLOAD
@@ -4050,6 +4060,14 @@
"${vol}${SL}Temporary Items",
"${SL}WWW_ROOT", "${SL}SYS\$SCRATCH",
"C:${SL}system${SL}temp");
+
+ if( $CGI::OS eq 'WINDOWS' ){
+ unshift @TEMP,
+ $ENV{TEMP},
+ $ENV{TMP},
+ $ENV{WINDIR} . $SL . 'TEMP';
+ }
+
unshift(@TEMP,$ENV{'TMPDIR'}) if defined $ENV{'TMPDIR'};
# this feature was supposed to provide per-user tmpfiles, but
@@ -4078,7 +4096,7 @@
sub DESTROY {
my($self) = @_;
- $$self =~ m!^([a-zA-Z0-9_ \'\":/.\$\\-]+)$! || return;
+ $$self =~ m!^([a-zA-Z0-9_ \'\":/.\$\\~-]+)$! || return;
my $safe = $1; # untaint operation
unlink $safe; # get rid of the file
}
@@ -4099,7 +4117,7 @@
last if ! -f ($filename = sprintf("\%s${SL}CGItemp%d", $TMPDIRECTORY,
$sequence++));
}
# check that it is a more-or-less valid filename
- return unless $filename =~ m!^([a-zA-Z0-9_\+ \'\":/.\$\\-]+)$!;
+ return unless $filename =~ m!^([a-zA-Z0-9_\+ \'\":/.\$\\~-]+)$!;
# this used to untaint, now it doesn't
# $filename = $1;
return bless \$filename;
@@ -6066,24 +6084,27 @@
To be safe, use the I<upload()> function (new in version 2.47). When
called with the name of an upload field, I<upload()> returns a
-filehandle, or undef if the parameter is not a valid filehandle.
+filehandle-like object, or undef if the parameter is not a valid
+filehandle.
$fh = upload('uploaded_file');
while (<$fh>) {
print;
}
-In an list context, upload() will return an array of filehandles.
+In a list context, upload() will return an array of filehandles.
This makes it possible to create forms that use the same name for
multiple upload fields.
This is the recommended idiom.
-For robust code, consider reseting the file handle position to beginning of the
-file. Inside of larger frameworks, other code may have already used the query
-object and changed the filehandle postion:
+The lightweight filehandle returned by CGI.pm is not compatible with
+IO::Handle; for example, it does not have read() or getline()
+functions, but instead must be manipulated using read($fh) or
+<$fh>. To get a compatible IO::Handle object, call the handle's
+handle() method:
- seek($fh,0,0); # reset postion to beginning of file.
+ my $real_io_handle = upload('uploaded_file')->handle;
When a file is uploaded the browser usually sends along some
information along with it in the format of headers. The information
==== //depot/maint-5.8/perl/lib/CGI/Changes#10 (text) ====
Index: perl/lib/CGI/Changes
--- perl/lib/CGI/Changes#9~33587~ 2008-03-28 06:12:32.000000000 -0700
+++ perl/lib/CGI/Changes 2008-09-11 07:14:37.000000000 -0700
@@ -1,3 +1,46 @@
+
+ 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
+ 3. Added a handle() method to the lightweight upload
+ filehandles. This method returns a real IO::Handle object.
+ 4. Added patch from Tony Vanlingen to fix deep recursion warnings in
CGI::Pretty.
+
+ Version 3.40
+ 1. Fixed CGI::Fast docs to eliminate references to a "special"
+ version of Perl.
+ 2. Makefile.PL now depends on FCGI so that CGI::Fast installs properly.
+ 3. Fix script_name() call from Stephane Chazelas.
+
+ Version 3.39
+ 1. Fixed regression in "exists" function when using tied interface to CGI
via $q->Vars.
+
+ Version 3.38
+ 1. Fix annoying warning in http://rt.cpan.org/Ticket/Display.html?id=34551
+ 2. Added nobr() function http://rt.cpan.org/Ticket/Display.html?id=35377
+ 3. popup_menu() allows multiple items to be selected by default, satisfying
+ http://rt.cpan.org/Ticket/Display.html?id=35376
+ 4. Patch from Renee Backer to avoid doubled <http-equiv> headers.
+ 5. Fixed documentation bug that describes what happens when a
+ parameter is empty (e.g. "?test1=").
+ 6. Fixed minor warning described at
http://rt.cpan.org/Public/Bug/Display.html?id=36435
+ 7. Fixed overlap of attribute and parameter space described in
http://rt.perl.org/rt3//Ticket/Display.html?id=24294
+
+ Version 3.37
+ 1. Fix pragmas so that they persist over modperl invocations (e.g. RT 34761)
+ 2. Fixed handling of chunked multipart uploads; thanks to Michael Bernhardt
+ who reported and fixed the problem.
+
+ Version 3.36
+ 1. Fix CGI::Cookie to support cookies that are separated by "," instead of
";".
+
Version 3.35
1. Resync with bleadperl, primarily fixing a bug in parsing semicolons in
uploaded filenames.
==== //depot/maint-5.8/perl/lib/CGI/Pretty.pm#6 (text) ====
Index: perl/lib/CGI/Pretty.pm
--- perl/lib/CGI/Pretty.pm#5~24473~ 2005-05-16 01:27:52.000000000 -0700
+++ perl/lib/CGI/Pretty.pm 2008-09-11 07:14:37.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/maint-5.8/perl/lib/CGI/Util.pm#13 (text) ====
Index: perl/lib/CGI/Util.pm
--- perl/lib/CGI/Util.pm#12~33587~ 2008-03-28 06:12:32.000000000 -0700
+++ perl/lib/CGI/Util.pm 2008-09-11 07:14:37.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/maint-5.8/perl/lib/CGI/t/upload.t#2 (text) ====
Index: perl/lib/CGI/t/upload.t
--- perl/lib/CGI/t/upload.t#1~33819~ 2008-05-11 03:19:04.000000000 -0700
+++ perl/lib/CGI/t/upload.t 2008-09-11 07:14:37.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/maint-5.8/perl/lib/CGI/t/uploadInfo.t#2 (text) ====
Index: perl/lib/CGI/t/uploadInfo.t
--- perl/lib/CGI/t/uploadInfo.t#1~33819~ 2008-05-11 03:19:04.000000000
-0700
+++ perl/lib/CGI/t/uploadInfo.t 2008-09-11 07:14:37.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.
