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