1#!/usr/local/bin/perl -w 2 3################################################################# 4# Emanuele Zeppieri, Mark Stosberg # 5# Shamelessly stolen from Data::FormValidator and CGI::Upload # 6################################################################# 7 8use strict; 9use Test::More 'no_plan'; 10 11use CGI qw/ :form /; 12 13#----------------------------------------------------------------------------- 14# %ENV setup. 15#----------------------------------------------------------------------------- 16 17my %myenv; 18 19BEGIN { 20 %myenv = ( 21 'SCRIPT_NAME' => '/test.cgi', 22 'SERVER_NAME' => 'perl.org', 23 'HTTP_CONNECTION' => 'TE, close', 24 'REQUEST_METHOD' => 'POST', 25 'SCRIPT_URI' => 'http://www.perl.org/test.cgi', 26 'CONTENT_LENGTH' => 3285, 27 'SCRIPT_FILENAME' => '/home/usr/test.cgi', 28 'SERVER_SOFTWARE' => 'Apache/1.3.27 (Unix) ', 29 'HTTP_TE' => 'deflate,gzip;q=0.3', 30 'QUERY_STRING' => '', 31 'REMOTE_PORT' => '1855', 32 'HTTP_USER_AGENT' => 'Mozilla/5.0 (compatible; Konqueror/2.1.1; X11)', 33 'SERVER_PORT' => '80', 34 'REMOTE_ADDR' => '127.0.0.1', 35 'CONTENT_TYPE' => 'multipart/form-data; boundary=xYzZY', 36 'SERVER_PROTOCOL' => 'HTTP/1.1', 37 'PATH' => '/usr/local/bin:/usr/bin:/bin', 38 'REQUEST_URI' => '/test.cgi', 39 'GATEWAY_INTERFACE' => 'CGI/1.1', 40 'SCRIPT_URL' => '/test.cgi', 41 'SERVER_ADDR' => '127.0.0.1', 42 'DOCUMENT_ROOT' => '/home/develop', 43 'HTTP_HOST' => 'www.perl.org' 44 ); 45 46 for my $key (keys %myenv) { 47 $ENV{$key} = $myenv{$key}; 48 } 49} 50 51END { 52 for my $key (keys %myenv) { 53 delete $ENV{$key}; 54 } 55} 56 57 58#----------------------------------------------------------------------------- 59# Simulate the upload (really, multiple uploads contained in a single stream). 60#----------------------------------------------------------------------------- 61 62my $q; 63 64{ 65 local *STDIN; 66 open STDIN, '<t/upload_post_text.txt' 67 or die 'missing test file t/upload_post_text.txt'; 68 binmode STDIN; 69 $q = CGI->new; 70} 71 72{ 73 # That's cheating! We shouldn't do that! 74 my $test = "All temp files are present"; 75 is( scalar(keys %{$q->{'.tmpfiles'}}), 5, $test); 76} 77 78my %uploadinfo_for = ( 79 'does_not_exist_gif' => {type => 'application/octet-stream', size => undef, }, 80 '100;100_gif' => {type => 'image/gif', size => 896, }, 81 '300x300_gif' => {type => 'image/gif', size => 1656, }, 82); 83 84 85foreach my $param_name (sort keys %uploadinfo_for) { 86 my $f_type = $uploadinfo_for{$param_name}->{type}; 87 my $f_size = $uploadinfo_for{$param_name}->{size}; 88 my $test = "uploadInfo: $param_name"; 89 90 my $fh = $q->upload($param_name); 91 is( uploadInfo($fh)->{'Content-Type'}, $f_type, $test); 92 is( $q->uploadInfo($fh)->{'Content-Type'}, $f_type, $test); 93 is( $q->uploadInfo($fh)->{'Content-Length'}, $f_size, $test); 94 95 # access using param 96 my $param_value = $q->param($param_name); 97 ok( ref( $param_value ),'param returns filehandle' ); 98 is( $q->uploadInfo( $param_value )->{'Content-Type'}, $f_type, $test . ' via param'); 99 is( $q->uploadInfo( $param_value )->{'Content-Length'}, $f_size, $test . ' via param'); 100 101 # access using Vars (is not possible) 102 my $vars = $q->Vars; 103 ok( ! ref( $vars->{$param_name} ),'Vars does not return filehandle' ); 104 ok( ! $q->uploadInfo( $vars->{$param_name} ), $test . ' via Vars'); 105} 106 107my $q2 = CGI->new; 108 109{ 110 my $test = "uploadInfo: works with second object instance"; 111 my $fh = $q2->upload('300x300_gif'); 112 is( $q2->uploadInfo($fh)->{'Content-Type'}, "image/gif", $test); 113} 114 115