diff options
Diffstat (limited to 't/uploadInfo.t')
| -rw-r--r-- | t/uploadInfo.t | 114 |
1 files changed, 114 insertions, 0 deletions
diff --git a/t/uploadInfo.t b/t/uploadInfo.t new file mode 100644 index 0000000..f486447 --- /dev/null +++ b/t/uploadInfo.t @@ -0,0 +1,114 @@ +#!/usr/local/bin/perl -w + +################################################################# +# Emanuele Zeppieri, Mark Stosberg # +# Shamelessly stolen from Data::FormValidator and CGI::Upload # +################################################################# + +use strict; +use Test::More 'no_plan'; + +use CGI qw/ :form /; + +#----------------------------------------------------------------------------- +# %ENV setup. +#----------------------------------------------------------------------------- + +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). +#----------------------------------------------------------------------------- + +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; +} + +{ + # That's cheating! We shouldn't do that! + my $test = "All temp files are present"; + is( scalar(keys %{$q->{'.tmpfiles'}}), 5, $test); +} + +my %uploadinfo_for = ( + 'does_not_exist_gif' => {type => 'application/octet-stream', size => undef, }, + '100;100_gif' => {type => 'image/gif', size => 896, }, + '300x300_gif' => {type => 'image/gif', size => 1656, }, +); + + +foreach my $param_name (sort keys %uploadinfo_for) { + my $f_type = $uploadinfo_for{$param_name}->{type}; + my $f_size = $uploadinfo_for{$param_name}->{size}; + my $test = "uploadInfo: $param_name"; + + my $fh = $q->upload($param_name); + is( uploadInfo($fh)->{'Content-Type'}, $f_type, $test); + is( $q->uploadInfo($fh)->{'Content-Type'}, $f_type, $test); + is( $q->uploadInfo($fh)->{'Content-Length'}, $f_size, $test); + + # access using param + my $param_value = $q->param($param_name); + ok( ref( $param_value ),'param returns filehandle' ); + is( $q->uploadInfo( $param_value )->{'Content-Type'}, $f_type, $test . ' via param'); + is( $q->uploadInfo( $param_value )->{'Content-Length'}, $f_size, $test . ' via param'); + + # access using Vars (is not possible) + my $vars = $q->Vars; + ok( ! ref( $vars->{$param_name} ),'Vars does not return filehandle' ); + ok( ! $q->uploadInfo( $vars->{$param_name} ), $test . ' via Vars'); +} + +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); +} + |