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