Create branch register_actions.
[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 => 105;
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         is( $upload->basename, $parameters{filename}, 'Upload basename' );
138
139         SKIP:
140         {
141             if ( $ENV{CATALYST_SERVER} ) {
142                 skip 'Not testing for deleted file on remote server', 1;
143             }
144             ok( !-e $upload->tempname, 'Upload temp file was deleted' );
145         }
146     }
147 }
148
149 {
150     my $creq;
151
152     my $request = POST(
153         'http://localhost/engine/request/uploads/slurp',
154         'Content-Type' => 'multipart/form-data',
155         'Content'      =>
156           [ 'slurp' => ["$FindBin::Bin/live_engine_request_uploads.t"], ]
157     );
158
159     ok( my $response = request($request), 'Request' );
160     ok( $response->is_success, 'Response Successful 2xx' );
161     is( $response->content_type, 'text/plain', 'Response Content-Type' );
162     is( $response->content, ( $request->parts )[0]->content, 'Content' );
163     
164     # XXX: no way to test that temporary file for this test was deleted
165 }
166
167 {
168     my $request = POST(
169         'http://localhost/dump/request',
170         'Content-Type' => 'multipart/form-data',
171         'Content'      =>
172           [ 'file' => ["$FindBin::Bin/../catalyst_130pix.gif"], ]
173     );
174
175     # LWP will auto-correct Content-Length when using a remote server
176     SKIP:
177     {
178         if ( $ENV{CATALYST_SERVER} ) {
179             skip 'Using remote server', 2;
180         }
181
182         # Sending wrong Content-Length here and see if subequent requests fail
183         $request->header('Content-Length' => $request->header('Content-Length') + 1);
184
185         ok( my $response = request($request), 'Request' );
186         ok( !$response->is_success, 'Response Error' );
187     }
188
189     $request = POST(
190         'http://localhost/dump/request',
191         'Content-Type' => 'multipart/form-data',
192         'Content'      =>
193           [ 'file1' => ["$FindBin::Bin/../catalyst_130pix.gif"],
194             'file2' => ["$FindBin::Bin/../catalyst_130pix.gif"], ]
195     );
196
197     ok( my $response = request($request), 'Request' );
198     ok( $response->is_success, 'Response Successful 2xx' );
199     is( $response->content_type, 'text/plain', 'Response Content-Type' );
200     like( $response->content, qr/file1 => bless/, 'Upload with name file1');
201     like( $response->content, qr/file2 => bless/, 'Upload with name file2');
202     
203     my $creq;
204     {
205         no strict 'refs';
206         ok(
207             eval '$creq = ' . $response->content,
208             'Unserialize Catalyst::Request'
209         );
210     }
211     
212     for my $file ( $creq->upload ) {
213         my $upload = $creq->upload($file);
214         SKIP:
215         {
216             if ( $ENV{CATALYST_SERVER} ) {
217                 skip 'Not testing for deleted file on remote server', 1;
218             }
219             ok( !-e $upload->tempname, 'Upload temp file was deleted' );
220         }
221     }
222 }
223
224 {
225     my $creq;
226
227     my $request = POST(
228         'http://localhost/dump/request/',
229         'Content-Type' => 'form-data',
230         'Content'      => [
231             'testfile' => 'textfield value',
232             'testfile' => ["$FindBin::Bin/../catalyst_130pix.gif"],
233         ]
234     );
235
236     ok( my $response = request($request), 'Request' );
237     ok( $response->is_success, 'Response Successful 2xx' );
238     is( $response->content_type, 'text/plain', 'Response Content-Type' );
239     like(
240         $response->content,
241         qr/^bless\( .* 'Catalyst::Request' \)$/s,
242         'Content is a serialized Catalyst::Request'
243     );
244
245     {
246         no strict 'refs';
247         ok(
248             eval '$creq = ' . $response->content,
249             'Unserialize Catalyst::Request'
250         );
251     }
252
253     isa_ok( $creq, 'Catalyst::Request' );
254     is( $creq->method, 'POST', 'Catalyst::Request method' );
255     is( $creq->content_type, 'multipart/form-data',
256         'Catalyst::Request Content-Type' );
257     is( $creq->content_length, $request->content_length,
258         'Catalyst::Request Content-Length' );
259
260     my $param = $creq->parameters->{testfile};
261
262     ok( @$param == 2, '2 values' );
263     is( $param->[0], 'textfield value', 'correct value' );
264     like( $param->[1], qr/\Qcatalyst_130pix.gif/, 'filename' );
265
266     for my $part ( $request->parts ) {
267
268         my $disposition = $part->header('Content-Disposition');
269         my %parameters  = @{ ( split_header_words($disposition) )[0] };
270
271         next unless exists $parameters{filename};
272
273         my $upload = $creq->uploads->{ $parameters{name} };
274
275         isa_ok( $upload, 'Catalyst::Request::Upload' );
276
277         is( $upload->type, $part->content_type, 'Upload Content-Type' );
278         is( $upload->size, length( $part->content ), 'Upload Content-Length' );
279         is( $upload->filename, 'catalyst_130pix.gif', 'Upload Filename' );
280         is( $upload->basename, 'catalyst_130pix.gif', 'Upload basename' );
281         
282         SKIP:
283         {
284             if ( $ENV{CATALYST_SERVER} ) {
285                 skip 'Not testing for deleted file on remote server', 1;
286             }
287             ok( !-e $upload->tempname, 'Upload temp file was deleted' );
288         }
289     }
290 }
291
292 # Test PUT request with application/octet-stream file gets deleted
293
294 {
295     my $body;
296
297     my $request = PUT(
298         'http://localhost/dump/body/',
299         'Content-Type' => 'application/octet-stream',
300         'Content'      => 'foobarbaz',
301         'Content-Length' => 9,
302     );
303
304     ok( my $response = request($request), 'Request' );
305     ok( $response->is_success, 'Response Successful 2xx' );
306     is( $response->content_type, 'text/plain', 'Response Content-Type' );
307     like(
308        $response->content,
309        qr/bless\( .* 'HTTP::Body::OctetStream' \)/s,
310        'Content is a serialized HTTP::Body::OctetStream'
311     );
312
313     {
314         no strict 'refs';
315         ok(
316             eval '$body = ' . substr( $response->content, 8 ), # FIXME - substr not needed in other test cases?
317             'Unserialize HTTP::Body::OctetStream'
318         ) or warn $@;
319     }
320
321     isa_ok( $body, 'HTTP::Body::OctetStream' );
322     isa_ok($body->body, 'File::Temp');
323
324     SKIP:
325     {
326         if ( $ENV{CATALYST_SERVER} ) {
327             skip 'Not testing for deleted file on remote server', 1;
328         }
329         ok( !-e $body->body->filename, 'Upload temp file was deleted' );
330     }
331 }
332
333 # test uploadtmp config var
334 SKIP:
335 {
336     if ( $ENV{CATALYST_SERVER} ) {
337         skip 'Not testing uploadtmp on remote server', 14;
338     }
339     
340     my $creq;
341
342     my $dir = "$FindBin::Bin/";
343     local TestApp->config->{ uploadtmp } = $dir;
344     $dir = Path::Class::Dir->new( $dir );
345
346     my $request = POST(
347         'http://localhost/dump/request/',
348         'Content-Type' => 'multipart/form-data',
349         'Content'      => [
350             'testfile' => ["$FindBin::Bin/live_engine_request_uploads.t"],
351         ]
352     );
353
354     ok( my $response = request($request), 'Request' );
355     ok( $response->is_success, 'Response Successful 2xx' );
356     is( $response->content_type, 'text/plain', 'Response Content-Type' );
357     like(
358         $response->content,
359         qr/^bless\( .* 'Catalyst::Request' \)$/s,
360         'Content is a serialized Catalyst::Request'
361     );
362
363     {
364         no strict 'refs';
365         ok(
366             eval '$creq = ' . $response->content,
367             'Unserialize Catalyst::Request'
368         );
369     }
370
371     isa_ok( $creq, 'Catalyst::Request' );
372     is( $creq->method, 'POST', 'Catalyst::Request method' );
373     is( $creq->content_type, 'multipart/form-data',
374         'Catalyst::Request Content-Type' );
375     is( $creq->content_length, $request->content_length,
376         'Catalyst::Request Content-Length' );
377
378     for my $part ( $request->parts ) {
379
380         my $disposition = $part->header('Content-Disposition');
381         my %parameters  = @{ ( split_header_words($disposition) )[0] };
382
383         next unless exists $parameters{filename};
384
385         my $upload = $creq->{uploads}->{ $parameters{name} };
386
387         isa_ok( $upload, 'Catalyst::Request::Upload' );
388
389         is( $upload->type, $part->content_type, 'Upload Content-Type' );
390         is( $upload->size, length( $part->content ), 'Upload Content-Length' );
391
392         like( $upload->tempname, qr{\Q$dir\E}, 'uploadtmp' );
393
394         ok( !-e $upload->tempname, 'Upload temp file was deleted' );
395     }
396 }
397