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 => 88;
  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         SKIP:
  76         {
  77             if ( $ENV{CATALYST_SERVER} ) {
  78                 skip 'Not testing for deleted file on remote server', 1;
  79             }
  80             ok( !-e $upload->tempname, 'Upload temp file was deleted' );
  81         }
  82     }
  83 }
  84
  85 {
  86     my $creq;
  87
  88     my $request = POST(
  89         'http://localhost/dump/request/',
  90         'Content-Type' => 'multipart/form-data',
  91         'Content'      => [
  92             'testfile' => ["$FindBin::Bin/live_engine_request_cookies.t"],
  93             'testfile' => ["$FindBin::Bin/live_engine_request_headers.t"],
  94             'testfile' => ["$FindBin::Bin/live_engine_request_uploads.t"],
  95         ]
  96     );
  97
  98     ok( my $response = request($request), 'Request' );
  99     ok( $response->is_success, 'Response Successful 2xx' );
 100     is( $response->content_type, 'text/plain', 'Response Content-Type' );
 101     like(
 102         $response->content,
 103         qr/^bless\( .* 'Catalyst::Request' \)$/s,
 104         'Content is a serialized Catalyst::Request'
 105     );
 106
 107     {
 108         no strict 'refs';
 109         ok(
 110             eval '$creq = ' . $response->content,
 111             'Unserialize Catalyst::Request'
 112         );
 113     }
 114
 115     isa_ok( $creq, 'Catalyst::Request' );
 116     is( $creq->method, 'POST', 'Catalyst::Request method' );
 117     is( $creq->content_type, 'multipart/form-data',
 118         'Catalyst::Request Content-Type' );
 119     is( $creq->content_length, $request->content_length,
 120         'Catalyst::Request Content-Length' );
 121
 122     my @parts = $request->parts;
 123
 124     for ( my $i = 0 ; $i < @parts ; $i++ ) {
 125
 126         my $part        = $parts[$i];
 127         my $disposition = $part->header('Content-Disposition');
 128         my %parameters  = @{ ( split_header_words($disposition) )[0] };
 129
 130         my $upload = $creq->{uploads}->{ $parameters{name} }->[$i];
 131
 132         isa_ok( $upload, 'Catalyst::Request::Upload' );
 133         is( $upload->type, $part->content_type, 'Upload Content-Type' );
 134         is( $upload->filename, $parameters{filename}, 'Upload filename' );
 135         is( $upload->size, length( $part->content ), 'Upload Content-Length' );
 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
 163 {
 164     my $request = POST(
 165         'http://localhost/dump/request',
 166         'Content-Type' => 'multipart/form-data',
 167         'Content'      =>
 168           [ 'file' => ["$FindBin::Bin/catalyst_130pix.gif"], ]
 169     );
 170
 171     # LWP will auto-correct Content-Length when using a remote server
 172     SKIP:
 173     {
 174         if ( $ENV{CATALYST_SERVER} ) {
 175             skip 'Using remote server', 2;
 176         }
 177
 178         # Sending wrong Content-Length here and see if subequent requests fail
 179         $request->header('Content-Length' => $request->header('Content-Length') + 1);
 180
 181         ok( my $response = request($request), 'Request' );
 182         ok( !$response->is_success, 'Response Error' );
 183     }
 184
 185     $request = POST(
 186         'http://localhost/dump/request',
 187         'Content-Type' => 'multipart/form-data',
 188         'Content'      =>
 189           [ 'file1' => ["$FindBin::Bin/catalyst_130pix.gif"],
 190             'file2' => ["$FindBin::Bin/catalyst_130pix.gif"], ]
 191     );
 192
 193     ok( my $response = request($request), 'Request' );
 194     ok( $response->is_success, 'Response Successful 2xx' );
 195     is( $response->content_type, 'text/plain', 'Response Content-Type' );
 196     like( $response->content, qr/file1 => bless/, 'Upload with name file1');
 197     like( $response->content, qr/file2 => bless/, 'Upload with name file2');
 198 }
 199
 200 {
 201     my $creq;
 202
 203     my $request = POST(
 204         'http://localhost/dump/request/',
 205         'Content-Type' => 'form-data',
 206         'Content'      => [
 207             'testfile' => 'textfield value',
 208             'testfile' => ["$FindBin::Bin/catalyst_130pix.gif"],
 209         ]
 210     );
 211
 212     ok( my $response = request($request), 'Request' );
 213     ok( $response->is_success, 'Response Successful 2xx' );
 214     is( $response->content_type, 'text/plain', 'Response Content-Type' );
 215     like(
 216         $response->content,
 217         qr/^bless\( .* 'Catalyst::Request' \)$/s,
 218         'Content is a serialized Catalyst::Request'
 219     );
 220
 221     {
 222         no strict 'refs';
 223         ok(
 224             eval '$creq = ' . $response->content,
 225             'Unserialize Catalyst::Request'
 226         );
 227     }
 228
 229     isa_ok( $creq, 'Catalyst::Request' );
 230     is( $creq->method, 'POST', 'Catalyst::Request method' );
 231     is( $creq->content_type, 'multipart/form-data',
 232         'Catalyst::Request Content-Type' );
 233     is( $creq->content_length, $request->content_length,
 234         'Catalyst::Request Content-Length' );
 235
 236     my $param = $creq->{parameters}->{testfile};
 237
 238     ok( @$param == 2, '2 values' );
 239     is( $param->[0], 'textfield value', 'correct value' );
 240     like( $param->[1], qr/\Qcatalyst_130pix.gif/, 'filename' );
 241
 242     for my $part ( $request->parts ) {
 243
 244         my $disposition = $part->header('Content-Disposition');
 245         my %parameters  = @{ ( split_header_words($disposition) )[0] };
 246
 247         next unless exists $parameters{filename};
 248
 249         my $upload = $creq->{uploads}->{ $parameters{name} };
 250
 251         isa_ok( $upload, 'Catalyst::Request::Upload' );
 252
 253         is( $upload->type, $part->content_type, 'Upload Content-Type' );
 254         is( $upload->size, length( $part->content ), 'Upload Content-Length' );
 255         is( $upload->filename, 'catalyst_130pix.gif' );
 256     }
 257 }
 258
 259 # test uploadtmp config var
 260 SKIP:
 261 {
 262     if ( $ENV{CATALYST_SERVER} ) {
 263         skip 'Not testing uploadtmp on remote server', 13;
 264     }
 265
 266     my $creq;
 267
 268     my $dir = "$FindBin::Bin/";
 269     local TestApp->config->{ uploadtmp } = $dir;
 270     $dir = Path::Class::Dir->new( $dir );
 271
 272     my $request = POST(
 273         'http://localhost/dump/request/',
 274         'Content-Type' => 'multipart/form-data',
 275         'Content'      => [
 276             'testfile' => ["$FindBin::Bin/live_engine_request_uploads.t"],
 277         ]
 278     );
 279
 280     ok( my $response = request($request), 'Request' );
 281     ok( $response->is_success, 'Response Successful 2xx' );
 282     is( $response->content_type, 'text/plain', 'Response Content-Type' );
 283     like(
 284         $response->content,
 285         qr/^bless\( .* 'Catalyst::Request' \)$/s,
 286         'Content is a serialized Catalyst::Request'
 287     );
 288
 289     {
 290         no strict 'refs';
 291         ok(
 292             eval '$creq = ' . $response->content,
 293             'Unserialize Catalyst::Request'
 294         );
 295     }
 296
 297     isa_ok( $creq, 'Catalyst::Request' );
 298     is( $creq->method, 'POST', 'Catalyst::Request method' );
 299     is( $creq->content_type, 'multipart/form-data',
 300         'Catalyst::Request Content-Type' );
 301     is( $creq->content_length, $request->content_length,
 302         'Catalyst::Request Content-Length' );
 303
 304     for my $part ( $request->parts ) {
 305
 306         my $disposition = $part->header('Content-Disposition');
 307         my %parameters  = @{ ( split_header_words($disposition) )[0] };
 308
 309         next unless exists $parameters{filename};
 310
 311         my $upload = $creq->{uploads}->{ $parameters{name} };
 312
 313         isa_ok( $upload, 'Catalyst::Request::Upload' );
 314
 315         is( $upload->type, $part->content_type, 'Upload Content-Type' );
 316         is( $upload->size, length( $part->content ), 'Upload Content-Length' );
 317
 318         like( $upload->tempname, qr{\Q$dir\E}, 'uploadtmp' );
 319     }
 320 }
 321