Sat Nov 11 12:13:44 EST 2006 Mark Stosberg <mark@summersault.com>
* two bug fixes:
1. The position of file handles is now reset to zero when CGI->new is called.
(Mark Stosberg)
2. uploadInfo() now works across multiple object instances. Also, the first tests
for uploadInfo() were added as part of the fix. (CPAN bug 11895,
with contributions from drfrench and Mark Stosberg).
diff -rN -u CGI.pm-3.25-old/CGI.pm CGI.pm-3.25-new/CGI.pm
--- CGI.pm-3.25-old/CGI.pm 2006-11-11 12:16:22.000000000 -0500
+++ CGI.pm-3.25-new/CGI.pm 2006-11-11 12:04:53.000000000 -0500
@@ -119,6 +119,7 @@
undef %EXPORT;
undef $QUERY_CHARSET;
undef %QUERY_FIELDNAMES;
+ undef %QUERY_TMPFILES;
# prevent complaints by mod_perl
1;
@@ -504,12 +505,20 @@
# ourselves from the original query (which may be gone
# if it was read from STDIN originally.)
if (defined(@QUERY_PARAM) && !defined($initializer)) {
- foreach (@QUERY_PARAM) {
- $self->param('-name'=>$_,'-value'=>$QUERY_PARAM{$_});
- }
- $self->charset($QUERY_CHARSET);
- $self->{'.fieldnames'} = {%QUERY_FIELDNAMES};
- return;
+ for my $name (@QUERY_PARAM) {
+ my $val = $QUERY_PARAM{$name}; # always an arrayref;
+ $self->param('-name'=>$name,'-value'=> $val);
+ if (defined $val and ref $val eq 'ARRAY') {
+ for my $fh (grep {defined(fileno($_))} @$val) {
+ seek($fh,0,0); # reset the filehandle.
+ }
+
+ }
+ }
+ $self->charset($QUERY_CHARSET);
+ $self->{'.fieldnames'} = {%QUERY_FIELDNAMES};
+ $self->{'.tmpfiles'} = {%QUERY_TMPFILES};
+ return;
}
$meth=$ENV{'REQUEST_METHOD'} if defined($ENV{'REQUEST_METHOD'});
@@ -719,6 +728,7 @@
}
$QUERY_CHARSET = $self->charset;
%QUERY_FIELDNAMES = %{$self->{'.fieldnames'}};
+ %QUERY_TMPFILES = %{$self->{'.tmpfiles'}};
}
sub parse_params {
@@ -4139,7 +4149,10 @@
$query = new CGI;
This will parse the input (from both POST and GET methods) and store
-it into a perl5 object called $query.
+it into a perl5 object called $query.
+
+Any filehandles from file uploads will have their position reset to
+the beginning of the file.
=head2 CREATING A NEW QUERY OBJECT FROM AN INPUT FILE
@@ -5848,6 +5861,12 @@
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:
+
+ seek($fh,0,0); # reset postion to beginning of file.
+
When a file is uploaded the browser usually sends along some
information along with it in the format of headers. The information
usually includes the MIME content type. Future browsers may send
diff -rN -u CGI.pm-3.25-old/Changes CGI.pm-3.25-new/Changes
--- CGI.pm-3.25-old/Changes 2006-11-11 12:16:22.000000000 -0500
+++ CGI.pm-3.25-new/Changes 2006-11-11 12:09:35.000000000 -0500
@@ -1,3 +1,9 @@
+ 1. The position of file handles is now reset to zero when CGI->new is called.
+ (Mark Stosberg)
+ 2. uploadInfo() now works across multiple object instances. Also, the first tests
+ for uploadInfo() were added as part of the fix. (CPAN bug 11895,
+ with contributions from drfrench and Mark Stosberg).
+
Version 3.25
1. Fixed the link to the Netscape frames page.
2. Added ability to specify an alternate stylesheet.
diff -rN -u CGI.pm-3.25-old/MANIFEST CGI.pm-3.25-new/MANIFEST
--- CGI.pm-3.25-old/MANIFEST 2006-11-11 12:16:22.000000000 -0500
+++ CGI.pm-3.25-new/MANIFEST 2006-11-11 12:04:53.000000000 -0500
@@ -53,6 +53,7 @@
t/request.t
t/switch.t
t/upload.t
+t/uploadInfo.t
t/upload_post_text.txt
t/util.t
t/util-58.t
diff -rN -u CGI.pm-3.25-old/t/uploadInfo.t CGI.pm-3.25-new/t/uploadInfo.t
--- CGI.pm-3.25-old/t/uploadInfo.t 1969-12-31 19:00:00.000000000 -0500
+++ CGI.pm-3.25-new/t/uploadInfo.t 2006-11-11 12:04:53.000000000 -0500
@@ -0,0 +1,76 @@
+#!/usr/local/bin/perl -w
+
+#################################################################
+# Emanuele Zeppieri, Mark Stosberg #
+# Shamelessly stolen from Data::FormValidator and CGI::Upload #
+#################################################################
+
+# Due to a bug in older versions of MakeMaker & Test::Harness, we must
+# ensure the blib's are in @INC, else we might use the core CGI.pm
+use lib qw(. ./blib/lib ./blib/arch);
+
+use strict;
+
+use Test::More 'no_plan';
+
+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'
+);
+
+#-----------------------------------------------------------------------------
+# Simulate the upload (really, multiple uploads contained in a single stream).
+#-----------------------------------------------------------------------------
+
+my $q;
+
+{
+ local *STDIN;
+ open STDIN, '<t/upload_post_text.txt'
+ or die 'missing test file t/upload_post_text.txt';
+ binmode STDIN;
+ $q = CGI->new;
+}
+
+{
+ my $test = "uploadInfo: basic test";
+ my $fh = $q->upload('300x300_gif');
+ is( $q->uploadInfo($fh)->{'Content-Type'}, "image/gif", $test);
+}
+
+my $q2 = CGI->new;
+
+{
+ my $test = "uploadInfo: works with second object instance";
+ my $fh = $q2->upload('300x300_gif');
+ is( $q2->uploadInfo($fh)->{'Content-Type'}, "image/gif", $test);
+}
+
Files CGI.pm-3.25-old/t/upload_post_text.txt and CGI.pm-3.25-new/t/upload_post_text.txt differ
diff -rN -u CGI.pm-3.25-old/t/upload.t CGI.pm-3.25-new/t/upload.t
--- CGI.pm-3.25-old/t/upload.t 2006-11-11 12:16:22.000000000 -0500
+++ CGI.pm-3.25-new/t/upload.t 2006-11-11 12:04:53.000000000 -0500
@@ -1,7 +1,7 @@
#!/usr/local/bin/perl -w
#################################################################
-# Emanuele Zeppieri #
+# Emanuele Zeppieri, Mark Stosberg #
# Shamelessly stolen from Data::FormValidator and CGI::Upload #
#################################################################
@@ -11,7 +11,7 @@
use strict;
-use Test::More tests => 8;
+use Test::More 'no_plan';
use CGI;
@@ -26,7 +26,7 @@
'HTTP_CONNECTION' => 'TE, close',
'REQUEST_METHOD' => 'POST',
'SCRIPT_URI' => '
http://www.perl.org/test.cgi',
- 'CONTENT_LENGTH' => 3129,
+ 'CONTENT_LENGTH' => 3285,
'SCRIPT_FILENAME' => '/home/usr/test.cgi',
'SERVER_SOFTWARE' => 'Apache/1.3.27 (Unix) ',
'HTTP_TE' => 'deflate,gzip;q=0.3',
@@ -64,17 +64,73 @@
# Check that the file names retrieved by CGI are correct.
#-----------------------------------------------------------------------------
-is( $q->param('hello_world') , 'hello_world.txt' , 'filename_1' );
is( $q->param('does_not_exist_gif'), 'does_not_exist.gif', 'filename_2' );
-is( $q->param('100x100_gif') , '100x100.gif' , 'filename_3' );
+is( $q->param('100;100_gif') , '100;100.gif' , 'filename_3' );
is( $q->param('300x300_gif') , '300x300.gif' , 'filename_4' );
+{
+ my $test = "multiple file names are handled right with same-named upload fields";
+ my @hello_names = $q->param('hello_world');
+ is_deeply(\@hello_names, [ 'goodbye_world.txt','hello_world.txt' ], $test);
+}
+
#-----------------------------------------------------------------------------
# Now check that the upload method works.
#-----------------------------------------------------------------------------
-ok( defined $q->upload('hello_world') , 'upload_basic_1' );
ok( defined $q->upload('does_not_exist_gif'), 'upload_basic_2' );
-ok( defined $q->upload('100x100_gif') , 'upload_basic_3' );
+ok( defined $q->upload('100;100_gif') , 'upload_basic_3' );
ok( defined $q->upload('300x300_gif') , 'upload_basic_4' );
+{
+ my $test = "file handles have expected length for multi-valued field. ";
+ my ($goodbye_fh,$hello_fh) = $q->upload('hello_world');
+
+ # Go to end of file;
+ seek($goodbye_fh,0,2);
+ # How long is the file?
+ is(tell($goodbye_fh), 15, "$test..first file");
+
+ # Go to end of file;
+ seek($hello_fh,0,2);
+ # How long is the file?
+ is(tell($hello_fh), 13, "$test..second file");
+
+}
+
+
+
+{
+ my $test = "300x300_gif has expected length";
+ my $fh1 = $q->upload('300x300_gif');
+ is(tell($fh1), 0, "First object: filehandle starts with position set at zero");
+
+ # Go to end of file;
+ seek($fh1,0,2);
+ # How long is the file?
+ is(tell($fh1), 1656, $test);
+}
+
+my $q2 = CGI->new;
+
+{
+ my $test = "Upload filehandles still work after calling CGI->new a second time";
+ $q->param('new','zoo');
+
+ is($q2->param('new'),undef,
+ "Reality Check: params set in one object instance don't appear in another instance");
+
+ my $fh2 = $q2->upload('300x300_gif');
+ is(tell($fh2), 0, "...so the state of a file handle shouldn't be carried to a new object instance, either.");
+ # Go to end of file;
+ seek($fh2,0,2);
+ # How long is the file?
+ is(tell($fh2), 1656, $test);
+}
+
+{
+ my $test = "multi-valued uploads are reset properly";
+ my ($dont_care, $hello_fh2) = $q2->upload('hello_world');
+ is(tell($hello_fh2), 0, $test);
+}
+
