1#!/usr/local/bin/perl -w 2 3################################################################# 4# Emanuele Zeppieri, Mark Stosberg # 5# Shamelessly stolen from Data::FormValidator and CGI::Upload # 6# Anonymous Monk says me too # 7################################################################# 8 9use strict; 10use Test::More tests => 42; 11 12use CGI; 13$CGI::DEBUG=1; 14 15#----------------------------------------------------------------------------- 16# %ENV setup. 17#----------------------------------------------------------------------------- 18 19my %myenv; 20 21BEGIN { 22 %myenv = ( 23 'SCRIPT_NAME' => '/test.cgi', 24 'SERVER_NAME' => 'perl.org', 25 'HTTP_CONNECTION' => 'TE, close', 26 'REQUEST_METHOD' => 'POST', 27 'SCRIPT_URI' => 'http://www.perl.org/test.cgi', 28 'CONTENT_LENGTH' => 35, 29 'SCRIPT_FILENAME' => '/home/usr/test.cgi', 30 'SERVER_SOFTWARE' => 'Apache/1.3.27 (Unix) ', 31 'HTTP_TE' => 'deflate,gzip;q=0.3', 32 'QUERY_STRING' => '', 33 'REMOTE_PORT' => '1855', 34 'HTTP_USER_AGENT' => 'Mozilla/5.0 (compatible; Konqueror/2.1.1; X11)', 35 'SERVER_PORT' => '80', 36 'REMOTE_ADDR' => '127.0.0.1', 37 'CONTENT_TYPE' => 'application/octet-stream', ##dd 38 'X_File_Name' => 'tiny.gif', ##dd 39 'SERVER_PROTOCOL' => 'HTTP/1.1', 40 'PATH' => '/usr/local/bin:/usr/bin:/bin', 41 'REQUEST_URI' => '/test.cgi', 42 'GATEWAY_INTERFACE' => 'CGI/1.1', 43 'SCRIPT_URL' => '/test.cgi', 44 'SERVER_ADDR' => '127.0.0.1', 45 'DOCUMENT_ROOT' => '/home/develop', 46 'HTTP_HOST' => 'www.perl.org' 47 ); 48 49 for my $key (keys %myenv) { 50 $ENV{$key} = $myenv{$key}; 51 } 52} 53 54END { 55 for my $key (keys %myenv) { 56 delete $ENV{$key}; 57 } 58} 59 60 61 62for my $pdata ( qw' POST PUT PATCH' ){ 63 local $ENV{REQUEST_METHOD} = $pdata; 64 my $pdata = $pdata.'DATA'; 65 CGI::initialize_globals(); #### IMPORTANT 66 ok( ! $CGI::PUTDATA_UPLOAD , "-\L$pdata\E_upload default is off"); 67 local *STDIN; 68 open STDIN, "<", \"GIF89a\1\0\1\0\x90\0\0\xFF\0\0\0\0\0,\0\0\0\0\1\0\1\0\0\2\2\4\1\0;" 69 or die "In-memory filehandle failed\n"; 70 binmode STDIN; 71 my $q = CGI->new; 72 ok( scalar $q->param( $pdata ), "we have $pdata param" ); 73 ok( ! ref $q->param( $pdata ), 'and it is not filehandle'); 74 ok( "GIF89a\1\0\1\0\x90\0\0\xFF\0\0\0\0\0,\0\0\0\0\1\0\1\0\0\2\2\4\1\0;" eq $q->param( $pdata ), "and the value isn't corrupted" ); 75} 76 77for my $pdata ( qw' POST PUT PATCH' ){ 78 local $ENV{REQUEST_METHOD} = $pdata; 79 my $pdata = $pdata.'DATA'; 80 local *STDIN; 81 open STDIN, "<", \"GIF89a\1\0\1\0\x90\0\0\xFF\0\0\0\0\0,\0\0\0\0\1\0\1\0\0\2\2\4\1\0;" 82 or die "In-memory filehandle failed\n"; 83 binmode STDIN; 84 85 CGI::initialize_globals(); #### IMPORTANT 86 local $CGI::PUTDATA_UPLOAD; 87 CGI->import( lc "-$pdata\_upload" ); 88 ok( !!$CGI::PUTDATA_UPLOAD, "-\L$pdata\E_upload default is on"); 89 90 my $q = CGI->new; 91 foreach my $class ( 'File::Temp','CGI::File::Temp','Fh' ) { 92 isa_ok( $q->param( $pdata ),$class,"$pdata param" ); 93 } 94 95 my $filename = $q->param($pdata); 96 my $tmpfilename = $q->tmpFileName( $filename ); 97 ok( $tmpfilename , "and tmpFileName returns the filename" ); 98} 99 100 101for my $pdata ( qw' POST PUT PATCH' ){ 102 local $ENV{REQUEST_METHOD} = $pdata; 103 my $pdata = $pdata.'DATA'; 104 local *STDIN; 105 open STDIN, "<", \"GIF89a\1\0\1\0\x90\0\0\xFF\0\0\0\0\0,\0\0\0\0\1\0\1\0\0\2\2\4\1\0;" 106 or die "In-memory filehandle failed\n"; 107 binmode STDIN; 108 109 CGI::initialize_globals(); #### IMPORTANT 110 111 my $yourang = 0; 112 my $callback = sub { 113 $yourang++; 114 }; 115 my $q = CGI->new( $callback ); 116 ok( ref $q, "got query"); 117 foreach my $class ( 'File::Temp','CGI::File::Temp','Fh' ) { 118 isa_ok( $q->param( $pdata ),$class,"$pdata param" ); 119 } 120 ok( $yourang, "and callback invoked"); 121} 122