cd57b035684e72c2470b2b6808d5d85e99005287
[catagits/Catalyst-Runtime.git] / t / aggregate / live_engine_request_uploads.t
1 #!perl
2
3 use strict;
4 use warnings;
5
6 use FindBin;
7 use lib "$FindBin::Bin/../lib";
8
9 use Test::More tests => 101;
10 use Catalyst::Test 'TestApp';
11
12 use Catalyst::Request;
13 use Catalyst::Request::Upload;
14 use HTTP::Headers;
15 use HTTP::Headers::Util 'split_header_words';
16 use HTTP::Request::Common;
17 use Path::Class::Dir;
18
19 {
20     my $creq;
21
22     my $request = POST(
23         'http://localhost/dump/request/',
24         'Content-Type' => 'form-data',
25         'Content'      => [
26             'live_engine_request_cookies.t' =>
27               ["$FindBin::Bin/live_engine_request_cookies.t"],
28             'live_engine_request_headers.t' =>
29               ["$FindBin::Bin/live_engine_request_headers.t"],
30             'live_engine_request_uploads.t' =>
31               ["$FindBin::Bin/live_engine_request_uploads.t"],
32         ]
33     );
34
35     ok( my $response = request($request), 'Request' );
36     ok( $response->is_success, 'Response Successful 2xx' );
37     is( $response->content_type, 'text/plain', 'Response Content-Type' );
38     like(
39         $response->content,
40         qr/^bless\( .* 'Catalyst::Request' \)$/s,
41         'Content is a serialized Catalyst::Request'
42     );
43
44     {
45         no strict 'refs';
46         ok(
47             eval '$creq = ' . $response->content,
48             'Unserialize Catalyst::Request'
49         );
50     }
51
52     isa_ok( $creq, 'Catalyst::Request' );
53     is( $creq->method, 'POST', 'Catalyst::Request method' );
54     is( $creq->content_type, 'multipart/form-data',
55         'Catalyst::Request Content-Type' );
56     is( $creq->content_length, $request->content_length,
57         'Catalyst::Request Content-Length' );
58
59     for my $part ( $request->parts ) {
60
61         my $disposition = $part->header('Content-Disposition');
62         my %parameters  = @{ ( split_header_words($disposition) )[0] };
63
64         my $upload = $creq->uploads->{ $parameters{filename} };
65
66         isa_ok( $upload, 'Catalyst::Request::Upload' );
67
68         is( $upload->type, $part->content_type, 'Upload Content-Type' );
69         is( $upload->size, length( $part->content ), 'Upload Content-Length' );
70
71         # make sure upload is accessible via legacy params->{$file}
72         is( $creq->parameters->{ $upload->filename },
73             $upload->filename, 'legacy param method ok' );
74
75         ok( !-e $upload->tempname, 'Upload temp file was deleted' );
76     }
77 }
78
79 {
80     my $creq;
81
82     my $request = POST(
83         'http://localhost/dump/request/',
84         'Content-Type' => 'multipart/form-data',
85         'Content'      => [
86             'testfile' => ["$FindBin::Bin/live_engine_request_cookies.t"],
87             'testfile' => ["$FindBin::Bin/live_engine_request_headers.t"],
88             'testfile' => ["$FindBin::Bin/live_engine_request_uploads.t"],
89         ]
90     );
91
92     ok( my $response = request($request), 'Request' );
93     ok( $response->is_success, 'Response Successful 2xx' );
94     is( $response->content_type, 'text/plain', 'Response Content-Type' );
95     like(
96         $response->content,
97         qr/^bless\( .* 'Catalyst::Request' \)$/s,
98         'Content is a serialized Catalyst::Request'
99     );
100
101     {
102         no strict 'refs';
103         ok(
104             eval '$creq = ' . $response->content,
105             'Unserialize Catalyst::Request'
106         );
107     }
108
109     isa_ok( $creq, 'Catalyst::Request' );
110     is( $creq->method, 'POST', 'Catalyst::Request method' );
111     is( $creq->content_type, 'multipart/form-data',
112         'Catalyst::Request Content-Type' );
113     is( $creq->content_length, $request->content_length,
114         'Catalyst::Request Content-Length' );
115
116     my @parts = $request->parts;
117
118     for ( my $i = 0 ; $i < @parts ; $i++ ) {
119
120         my $part        = $parts[$i];
121         my $disposition = $part->header('Content-Disposition');
122         my %parameters  = @{ ( split_header_words($disposition) )[0] };
123
124         my $upload = $creq->uploads->{ $parameters{name} }->[$i];
125
126         isa_ok( $upload, 'Catalyst::Request::Upload' );
127         is( $upload->type, $part->content_type, 'Upload Content-Type' );
128         is( $upload->filename, $parameters{filename}, 'Upload filename' );
129         is( $upload->size, length( $part->content ), 'Upload Content-Length' );
130
131         ok( !-e $upload->tempname, 'Upload temp file was deleted' );
132     }
133 }
134
135 {
136     my $creq;
137
138     my $request = POST(
139         'http://localhost/engine/request/uploads/slurp',
140         'Content-Type' => 'multipart/form-data',
141         'Content'      =>
142           [ 'slurp' => ["$FindBin::Bin/live_engine_request_uploads.t"], ]
143     );
144
145     ok( my $response = request($request), 'Request' );
146     ok( $response->is_success, 'Response Successful 2xx' );
147     is( $response->content_type, 'text/plain', 'Response Content-Type' );
148     is( $response->content, ( $request->parts )[0]->content, 'Content' );
149     
150     # XXX: no way to test that temporary file for this test was deleted
151 }
152
153 {
154     my $request = POST(
155         'http://localhost/dump/request',
156         'Content-Type' => 'multipart/form-data',
157         'Content'      =>
158           [ 'file' => ["$FindBin::Bin/../catalyst_130pix.gif"], ]
159     );
160
161     # LWP will auto-correct Content-Length when using a remote server
162     SKIP:
163     {
164         if ( $ENV{CATALYST_SERVER} ) {
165             skip 'Using remote server', 2;
166         }
167
168         # Sending wrong Content-Length here and see if subequent requests fail
169         $request->header('Content-Length' => $request->header('Content-Length') + 1);
170
171         ok( my $response = request($request), 'Request' );
172         ok( !$response->is_success, 'Response Error' );
173     }
174
175     $request = POST(
176         'http://localhost/dump/request',
177         'Content-Type' => 'multipart/form-data',
178         'Content'      =>
179           [ 'file1' => ["$FindBin::Bin/../catalyst_130pix.gif"],
180             'file2' => ["$FindBin::Bin/../catalyst_130pix.gif"], ]
181     );
182
183     ok( my $response = request($request), 'Request' );
184     ok( $response->is_success, 'Response Successful 2xx' );
185     is( $response->content_type, 'text/plain', 'Response Content-Type' );
186     like( $response->content, qr/file1 => bless/, 'Upload with name file1');
187     like( $response->content, qr/file2 => bless/, 'Upload with name file2');
188     
189     my $creq;
190     {
191         no strict 'refs';
192         ok(
193             eval '$creq = ' . $response->content,
194             'Unserialize Catalyst::Request'
195         );
196     }
197     
198     for my $file ( $creq->upload ) {
199         my $upload = $creq->upload($file);
200         ok( !-e $upload->tempname, 'Upload temp file was deleted' );
201     }
202 }
203
204 {
205     my $creq;
206
207     my $request = POST(
208         'http://localhost/dump/request/',
209         'Content-Type' => 'form-data',
210         'Content'      => [
211             'testfile' => 'textfield value',
212             'testfile' => ["$FindBin::Bin/../catalyst_130pix.gif"],
213         ]
214     );
215
216     ok( my $response = request($request), 'Request' );
217     ok( $response->is_success, 'Response Successful 2xx' );
218     is( $response->content_type, 'text/plain', 'Response Content-Type' );
219     like(
220         $response->content,
221         qr/^bless\( .* 'Catalyst::Request' \)$/s,
222         'Content is a serialized Catalyst::Request'
223     );
224
225     {
226         no strict 'refs';
227         ok(
228             eval '$creq = ' . $response->content,
229             'Unserialize Catalyst::Request'
230         );
231     }
232
233     isa_ok( $creq, 'Catalyst::Request' );
234     is( $creq->method, 'POST', 'Catalyst::Request method' );
235     is( $creq->content_type, 'multipart/form-data',
236         'Catalyst::Request Content-Type' );
237     is( $creq->content_length, $request->content_length,
238         'Catalyst::Request Content-Length' );
239
240     my $param = $creq->parameters->{testfile};
241
242     ok( @$param == 2, '2 values' );
243     is( $param->[0], 'textfield value', 'correct value' );
244     like( $param->[1], qr/\Qcatalyst_130pix.gif/, 'filename' );
245
246     for my $part ( $request->parts ) {
247
248         my $disposition = $part->header('Content-Disposition');
249         my %parameters  = @{ ( split_header_words($disposition) )[0] };
250
251         next unless exists $parameters{filename};
252
253         my $upload = $creq->uploads->{ $parameters{name} };
254
255         isa_ok( $upload, 'Catalyst::Request::Upload' );
256
257         is( $upload->type, $part->content_type, 'Upload Content-Type' );
258         is( $upload->size, length( $part->content ), 'Upload Content-Length' );
259         is( $upload->filename, 'catalyst_130pix.gif', 'Upload Filename' );
260         ok( !-e $upload->tempname, 'Upload temp file was deleted' );
261     }
262 }
263
264 # Test PUT request with application/octet-stream file gets deleted
265
266 {
267     my $body;
268
269     my $request = PUT(
270         'http://localhost/dump/body/',
271         'Content-Type' => 'application/octet-stream',
272         'Content'      => 'foobarbaz',
273         'Content-Length' => 9,
274     );
275
276     ok( my $response = request($request), 'Request' );
277     ok( $response->is_success, 'Response Successful 2xx' );
278     is( $response->content_type, 'text/plain', 'Response Content-Type' );
279     like(
280        $response->content,
281        qr/bless\( .* 'HTTP::Body::OctetStream' \)/s,
282        'Content is a serialized HTTP::Body::OctetStream'
283     );
284
285     {
286         no strict 'refs';
287         ok(
288             eval '$body = ' . substr( $response->content, 8 ), # FIXME - substr not needed in other test cases?
289             'Unserialize HTTP::Body::OctetStream'
290         ) or warn $@;
291     }
292
293     isa_ok( $body, 'HTTP::Body::OctetStream' );
294     isa_ok($body->body, 'File::Temp');
295
296     ok( !-e $body->body->filename, 'Upload temp file was deleted' );
297 }
298
299 # test uploadtmp config var
300
301 {
302     my $creq;
303
304     my $dir = "$FindBin::Bin/";
305     local TestApp->config->{ uploadtmp } = $dir;
306     $dir = Path::Class::Dir->new( $dir );
307
308     my $request = POST(
309         'http://localhost/dump/request/',
310         'Content-Type' => 'multipart/form-data',
311         'Content'      => [
312             'testfile' => ["$FindBin::Bin/live_engine_request_uploads.t"],
313         ]
314     );
315
316     ok( my $response = request($request), 'Request' );
317     ok( $response->is_success, 'Response Successful 2xx' );
318     is( $response->content_type, 'text/plain', 'Response Content-Type' );
319     like(
320         $response->content,
321         qr/^bless\( .* 'Catalyst::Request' \)$/s,
322         'Content is a serialized Catalyst::Request'
323     );
324
325     {
326         no strict 'refs';
327         ok(
328             eval '$creq = ' . $response->content,
329             'Unserialize Catalyst::Request'
330         );
331     }
332
333     isa_ok( $creq, 'Catalyst::Request' );
334     is( $creq->method, 'POST', 'Catalyst::Request method' );
335     is( $creq->content_type, 'multipart/form-data',
336         'Catalyst::Request Content-Type' );
337     is( $creq->content_length, $request->content_length,
338         'Catalyst::Request Content-Length' );
339
340     for my $part ( $request->parts ) {
341
342         my $disposition = $part->header('Content-Disposition');
343         my %parameters  = @{ ( split_header_words($disposition) )[0] };
344
345         next unless exists $parameters{filename};
346
347         my $upload = $creq->{uploads}->{ $parameters{name} };
348
349         isa_ok( $upload, 'Catalyst::Request::Upload' );
350
351         is( $upload->type, $part->content_type, 'Upload Content-Type' );
352         is( $upload->size, length( $part->content ), 'Upload Content-Length' );
353
354         like( $upload->tempname, qr{\Q$dir\E}, 'uploadtmp' );
355
356         ok( !-e $upload->tempname, 'Upload temp file was deleted' );
357     }
358 }
359