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