From: Steve Peters Date: Fri, 28 Mar 2008 19:16:53 +0000 (+0000) Subject: Additional CGI.pm test files that got missed at some point. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0078014ad8fc3a5abc1f091e4a2f0d513ba64590;p=p5sagit%2Fp5-mst-13.2.git Additional CGI.pm test files that got missed at some point. p4raw-id: //depot/perl@33592 --- diff --git a/MANIFEST b/MANIFEST index 32c9c35..d461908 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1572,6 +1572,9 @@ lib/CGI/t/start_end_asterisk.t See if CGI.pm works lib/CGI/t/start_end_end.t See if CGI.pm works lib/CGI/t/start_end_start.t See if CGI.pm works lib/CGI/t/switch.t See if CGI::Switch still loads +lib/CGI/t/uploadInfo.t See if CGI.pm works +lib/CGI/t/upload.t See if CGI.pm works +lib/CGI/t/upload_post_text.txt Test data for CGI.pm lib/CGI/t/util-58.t See if 5.8-dependent features work lib/CGI/t/util.t See if CGI.pm works lib/CGI/Util.pm Utility functions diff --git a/lib/CGI/t/upload.t b/lib/CGI/t/upload.t new file mode 100644 index 0000000..9f92ca4 --- /dev/null +++ b/lib/CGI/t/upload.t @@ -0,0 +1,147 @@ +#!/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 + +my $test_file; +if($ENV{PERL_CORE}) { + chdir 't'; + @INC = '../lib'; + use File::Spec (); + $test_file = File::Spec->catfile(qw(.. lib CGI t), "upload_post_text.txt"); +} else { + use lib qw(. ./blib/lib ./blib/arch); + $test_file = "t/upload_post_text.txt"; +} + +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, "< $test_file" + or die 'missing test file t/upload_post_text.txt'; + binmode STDIN; + $q = CGI->new; +} + +#----------------------------------------------------------------------------- +# Check that the file names retrieved by CGI are correct. +#----------------------------------------------------------------------------- + +is( $q->param('does_not_exist_gif'), 'does_not_exist.gif', 'filename_2' ); +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('does_not_exist_gif'), 'upload_basic_2' ); +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); +} + +# vim: nospell diff --git a/lib/CGI/t/uploadInfo.t b/lib/CGI/t/uploadInfo.t new file mode 100644 index 0000000..b99c57e --- /dev/null +++ b/lib/CGI/t/uploadInfo.t @@ -0,0 +1,86 @@ +#!/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 + +my $test_file; +if($ENV{PERL_CORE}) { + chdir 't'; + @INC = '../lib'; + use File::Spec (); + $test_file = File::Spec->catfile(qw(.. lib CGI t), "upload_post_text.txt"); +} else { + use lib qw(. ./blib/lib ./blib/arch); + $test_file = "t/upload_post_text.txt"; +} + +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, "< $test_file" + 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); +} + diff --git a/lib/CGI/t/upload_post_text.txt b/lib/CGI/t/upload_post_text.txt new file mode 100644 index 0000000..91393f0 Binary files /dev/null and b/lib/CGI/t/upload_post_text.txt differ