t/aggregate/live_engine_request_uploads.t

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