t/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 => 75;
  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
  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         ok( !-e $upload->tempname, 'Upload temp file was deleted' );
  75     }
  76 }
  77
  78 {
  79     my $creq;
  80
  81     my $request = POST(
  82         'http://localhost/dump/request/',
  83         'Content-Type' => 'multipart/form-data',
  84         'Content'      => [
  85             'testfile' => ["$FindBin::Bin/live_engine_request_cookies.t"],
  86             'testfile' => ["$FindBin::Bin/live_engine_request_headers.t"],
  87             'testfile' => ["$FindBin::Bin/live_engine_request_uploads.t"],
  88         ]
  89     );
  90
  91     ok( my $response = request($request), 'Request' );
  92     ok( $response->is_success, 'Response Successful 2xx' );
  93     is( $response->content_type, 'text/plain', 'Response Content-Type' );
  94     like(
  95         $response->content,
  96         qr/^bless\( .* 'Catalyst::Request' \)$/s,
  97         'Content is a serialized Catalyst::Request'
  98     );
  99
 100     {
 101         no strict 'refs';
 102         ok(
 103             eval '$creq = ' . $response->content,
 104             'Unserialize Catalyst::Request'
 105         );
 106     }
 107
 108     isa_ok( $creq, 'Catalyst::Request' );
 109     is( $creq->method, 'POST', 'Catalyst::Request method' );
 110     is( $creq->content_type, 'multipart/form-data',
 111         'Catalyst::Request Content-Type' );
 112     is( $creq->content_length, $request->content_length,
 113         'Catalyst::Request Content-Length' );
 114
 115     my @parts = $request->parts;
 116
 117     for ( my $i = 0 ; $i < @parts ; $i++ ) {
 118
 119         my $part        = $parts[$i];
 120         my $disposition = $part->header('Content-Disposition');
 121         my %parameters  = @{ ( split_header_words($disposition) )[0] };
 122
 123         my $upload = $creq->uploads->{ $parameters{name} }->[$i];
 124
 125         isa_ok( $upload, 'Catalyst::Request::Upload' );
 126         is( $upload->type, $part->content_type, 'Upload Content-Type' );
 127         is( $upload->filename, $parameters{filename}, 'Upload filename' );
 128         is( $upload->size, length( $part->content ), 'Upload Content-Length' );
 129
 130         ok( !-e $upload->tempname, 'Upload temp file was deleted' );
 131     }
 132 }
 133
 134 {
 135     my $creq;
 136
 137     my $request = POST(
 138         'http://localhost/engine/request/uploads/slurp',
 139         'Content-Type' => 'multipart/form-data',
 140         'Content'      =>
 141           [ 'slurp' => ["$FindBin::Bin/live_engine_request_uploads.t"], ]
 142     );
 143
 144     ok( my $response = request($request), 'Request' );
 145     ok( $response->is_success, 'Response Successful 2xx' );
 146     is( $response->content_type, 'text/plain', 'Response Content-Type' );
 147     is( $response->content, ( $request->parts )[0]->content, 'Content' );
 148 }
 149
 150 {
 151     my $request = POST(
 152         'http://localhost/dump/request',
 153         'Content-Type' => 'multipart/form-data',
 154         'Content'      =>
 155           [ 'file' => ["$FindBin::Bin/catalyst_130pix.gif"], ]
 156     );
 157
 158     # LWP will auto-correct Content-Length when using a remote server
 159     SKIP:
 160     {
 161         if ( $ENV{CATALYST_SERVER} ) {
 162             skip 'Using remote server', 2;
 163         }
 164
 165         # Sending wrong Content-Length here and see if subequent requests fail
 166         $request->header('Content-Length' => $request->header('Content-Length') + 1);
 167
 168         ok( my $response = request($request), 'Request' );
 169         ok( !$response->is_success, 'Response Error' );
 170     }
 171
 172     $request = POST(
 173         'http://localhost/dump/request',
 174         'Content-Type' => 'multipart/form-data',
 175         'Content'      =>
 176           [ 'file1' => ["$FindBin::Bin/catalyst_130pix.gif"],
 177             'file2' => ["$FindBin::Bin/catalyst_130pix.gif"], ]
 178     );
 179
 180     ok( my $response = request($request), 'Request' );
 181     ok( $response->is_success, 'Response Successful 2xx' );
 182     is( $response->content_type, 'text/plain', 'Response Content-Type' );
 183     like( $response->content, qr/file1 => bless/, 'Upload with name file1');
 184     like( $response->content, qr/file2 => bless/, 'Upload with name file2');
 185 }
 186
 187 {
 188     my $creq;
 189
 190     my $request = POST(
 191         'http://localhost/dump/request/',
 192         'Content-Type' => 'form-data',
 193         'Content'      => [
 194             'testfile' => 'textfield value',
 195             'testfile' => ["$FindBin::Bin/catalyst_130pix.gif"],
 196         ]
 197     );
 198
 199     ok( my $response = request($request), 'Request' );
 200     ok( $response->is_success, 'Response Successful 2xx' );
 201     is( $response->content_type, 'text/plain', 'Response Content-Type' );
 202     like(
 203         $response->content,
 204         qr/^bless\( .* 'Catalyst::Request' \)$/s,
 205         'Content is a serialized Catalyst::Request'
 206     );
 207
 208     {
 209         no strict 'refs';
 210         ok(
 211             eval '$creq = ' . $response->content,
 212             'Unserialize Catalyst::Request'
 213         );
 214     }
 215
 216     isa_ok( $creq, 'Catalyst::Request' );
 217     is( $creq->method, 'POST', 'Catalyst::Request method' );
 218     is( $creq->content_type, 'multipart/form-data',
 219         'Catalyst::Request Content-Type' );
 220     is( $creq->content_length, $request->content_length,
 221         'Catalyst::Request Content-Length' );
 222
 223     my $param = $creq->parameters->{testfile};
 224
 225     ok( @$param == 2, '2 values' );
 226     is( $param->[0], 'textfield value', 'correct value' );
 227     like( $param->[1], qr/\Qcatalyst_130pix.gif/, 'filename' );
 228
 229     for my $part ( $request->parts ) {
 230
 231         my $disposition = $part->header('Content-Disposition');
 232         my %parameters  = @{ ( split_header_words($disposition) )[0] };
 233
 234         next unless exists $parameters{filename};
 235
 236         my $upload = $creq->uploads->{ $parameters{name} };
 237
 238         isa_ok( $upload, 'Catalyst::Request::Upload' );
 239
 240         is( $upload->type, $part->content_type, 'Upload Content-Type' );
 241         is( $upload->size, length( $part->content ), 'Upload Content-Length' );
 242         is( $upload->filename, 'catalyst_130pix.gif' );
 243     }
 244 }