[catagits/Catalyst-Runtime.git] / t / live_engine_request_uploads.t

#!perl

use strict;
use warnings;

use FindBin;
use lib "$FindBin::Bin/lib";

use Test::More tests => 88;
use Catalyst::Test 'TestApp';

use Catalyst::Request;
use Catalyst::Request::Upload;
use HTTP::Headers;
use HTTP::Headers::Util 'split_header_words';
use HTTP::Request::Common;
use Path::Class::Dir;

{
    my $creq;

    my $request = POST(
        'http://localhost/dump/request/',
        'Content-Type' => 'form-data',
        'Content'      => [
            'live_engine_request_cookies.t' =>
              ["$FindBin::Bin/live_engine_request_cookies.t"],
            'live_engine_request_headers.t' =>
              ["$FindBin::Bin/live_engine_request_headers.t"],
            'live_engine_request_uploads.t' =>
              ["$FindBin::Bin/live_engine_request_uploads.t"],
        ]
    );

    ok( my $response = request($request), 'Request' );
    ok( $response->is_success, 'Response Successful 2xx' );
    is( $response->content_type, 'text/plain', 'Response Content-Type' );
    like(
        $response->content,
        qr/^bless\( .* 'Catalyst::Request' \)$/s,
        'Content is a serialized Catalyst::Request'
    );

    {
        no strict 'refs';
        ok(
            eval '$creq = ' . $response->content,
            'Unserialize Catalyst::Request'
        );
    }

    isa_ok( $creq, 'Catalyst::Request' );
    is( $creq->method, 'POST', 'Catalyst::Request method' );
    is( $creq->content_type, 'multipart/form-data',
        'Catalyst::Request Content-Type' );
    is( $creq->content_length, $request->content_length,
        'Catalyst::Request Content-Length' );

    for my $part ( $request->parts ) {

        my $disposition = $part->header('Content-Disposition');
        my %parameters  = @{ ( split_header_words($disposition) )[0] };

        my $upload = $creq->{uploads}->{ $parameters{filename} };

        isa_ok( $upload, 'Catalyst::Request::Upload' );

        is( $upload->type, $part->content_type, 'Upload Content-Type' );
        is( $upload->size, length( $part->content ), 'Upload Content-Length' );

        # make sure upload is accessible via legacy params->{$file}
        is( $creq->{parameters}->{ $upload->filename },
            $upload->filename, 'legacy param method ok' );

        SKIP:
        {
            if ( $ENV{CATALYST_SERVER} ) {
                skip 'Not testing for deleted file on remote server', 1;
            }
            ok( !-e $upload->tempname, 'Upload temp file was deleted' );
        }
    }
}

{
    my $creq;

    my $request = POST(
        'http://localhost/dump/request/',
        'Content-Type' => 'multipart/form-data',
        'Content'      => [
            'testfile' => ["$FindBin::Bin/live_engine_request_cookies.t"],
            'testfile' => ["$FindBin::Bin/live_engine_request_headers.t"],
            'testfile' => ["$FindBin::Bin/live_engine_request_uploads.t"],
        ]
    );

    ok( my $response = request($request), 'Request' );
    ok( $response->is_success, 'Response Successful 2xx' );
    is( $response->content_type, 'text/plain', 'Response Content-Type' );
    like(
        $response->content,
        qr/^bless\( .* 'Catalyst::Request' \)$/s,
        'Content is a serialized Catalyst::Request'
    );

    {
        no strict 'refs';
        ok(
            eval '$creq = ' . $response->content,
            'Unserialize Catalyst::Request'
        );
    }

    isa_ok( $creq, 'Catalyst::Request' );
    is( $creq->method, 'POST', 'Catalyst::Request method' );
    is( $creq->content_type, 'multipart/form-data',
        'Catalyst::Request Content-Type' );
    is( $creq->content_length, $request->content_length,
        'Catalyst::Request Content-Length' );

    my @parts = $request->parts;

    for ( my $i = 0 ; $i < @parts ; $i++ ) {

        my $part        = $parts[$i];
        my $disposition = $part->header('Content-Disposition');
        my %parameters  = @{ ( split_header_words($disposition) )[0] };

        my $upload = $creq->{uploads}->{ $parameters{name} }->[$i];

        isa_ok( $upload, 'Catalyst::Request::Upload' );
        is( $upload->type, $part->content_type, 'Upload Content-Type' );
        is( $upload->filename, $parameters{filename}, 'Upload filename' );
        is( $upload->size, length( $part->content ), 'Upload Content-Length' );

        SKIP:
        {
            if ( $ENV{CATALYST_SERVER} ) {
                skip 'Not testing for deleted file on remote server', 1;
            }
            ok( !-e $upload->tempname, 'Upload temp file was deleted' );
        }
    }
}

{
    my $creq;

    my $request = POST(
        'http://localhost/engine/request/uploads/slurp',
        'Content-Type' => 'multipart/form-data',
        'Content'      =>
          [ 'slurp' => ["$FindBin::Bin/live_engine_request_uploads.t"], ]
    );

    ok( my $response = request($request), 'Request' );
    ok( $response->is_success, 'Response Successful 2xx' );
    is( $response->content_type, 'text/plain', 'Response Content-Type' );
    is( $response->content, ( $request->parts )[0]->content, 'Content' );
}

{
    my $request = POST(
        'http://localhost/dump/request',
        'Content-Type' => 'multipart/form-data',
        'Content'      =>
          [ 'file' => ["$FindBin::Bin/catalyst_130pix.gif"], ]
    );

    # LWP will auto-correct Content-Length when using a remote server
    SKIP:
    {
        if ( $ENV{CATALYST_SERVER} ) {
            skip 'Using remote server', 2;
        }

        # Sending wrong Content-Length here and see if subequent requests fail
        $request->header('Content-Length' => $request->header('Content-Length') + 1);

        ok( my $response = request($request), 'Request' );
        ok( !$response->is_success, 'Response Error' );
    }

    $request = POST(
        'http://localhost/dump/request',
        'Content-Type' => 'multipart/form-data',
        'Content'      =>
          [ 'file1' => ["$FindBin::Bin/catalyst_130pix.gif"],
            'file2' => ["$FindBin::Bin/catalyst_130pix.gif"], ]
    );

    ok( my $response = request($request), 'Request' );
    ok( $response->is_success, 'Response Successful 2xx' );
    is( $response->content_type, 'text/plain', 'Response Content-Type' );
    like( $response->content, qr/file1 => bless/, 'Upload with name file1');
    like( $response->content, qr/file2 => bless/, 'Upload with name file2');
}

{
    my $creq;

    my $request = POST(
        'http://localhost/dump/request/',
        'Content-Type' => 'form-data',
        'Content'      => [
            'testfile' => 'textfield value',
            'testfile' => ["$FindBin::Bin/catalyst_130pix.gif"],
        ]
    );

    ok( my $response = request($request), 'Request' );
    ok( $response->is_success, 'Response Successful 2xx' );
    is( $response->content_type, 'text/plain', 'Response Content-Type' );
    like(
        $response->content,
        qr/^bless\( .* 'Catalyst::Request' \)$/s,
        'Content is a serialized Catalyst::Request'
    );

    {
        no strict 'refs';
        ok(
            eval '$creq = ' . $response->content,
            'Unserialize Catalyst::Request'
        );
    }

    isa_ok( $creq, 'Catalyst::Request' );
    is( $creq->method, 'POST', 'Catalyst::Request method' );
    is( $creq->content_type, 'multipart/form-data',
        'Catalyst::Request Content-Type' );
    is( $creq->content_length, $request->content_length,
        'Catalyst::Request Content-Length' );

    my $param = $creq->{parameters}->{testfile};

    ok( @$param == 2, '2 values' );
    is( $param->[0], 'textfield value', 'correct value' );
    like( $param->[1], qr/\Qcatalyst_130pix.gif/, 'filename' );

    for my $part ( $request->parts ) {

        my $disposition = $part->header('Content-Disposition');
        my %parameters  = @{ ( split_header_words($disposition) )[0] };

        next unless exists $parameters{filename};

        my $upload = $creq->{uploads}->{ $parameters{name} };

        isa_ok( $upload, 'Catalyst::Request::Upload' );

        is( $upload->type, $part->content_type, 'Upload Content-Type' );
        is( $upload->size, length( $part->content ), 'Upload Content-Length' );
        is( $upload->filename, 'catalyst_130pix.gif' );
    }
}

# test uploadtmp config var
SKIP:
{
    if ( $ENV{CATALYST_SERVER} ) {
        skip 'Not testing uploadtmp on remote server', 13;
    }
    
    my $creq;

    my $dir = "$FindBin::Bin/";
    local TestApp->config->{ uploadtmp } = $dir;
    $dir = Path::Class::Dir->new( $dir );

    my $request = POST(
        'http://localhost/dump/request/',
        'Content-Type' => 'multipart/form-data',
        'Content'      => [
            'testfile' => ["$FindBin::Bin/live_engine_request_uploads.t"],
        ]
    );

    ok( my $response = request($request), 'Request' );
    ok( $response->is_success, 'Response Successful 2xx' );
    is( $response->content_type, 'text/plain', 'Response Content-Type' );
    like(
        $response->content,
        qr/^bless\( .* 'Catalyst::Request' \)$/s,
        'Content is a serialized Catalyst::Request'
    );

    {
        no strict 'refs';
        ok(
            eval '$creq = ' . $response->content,
            'Unserialize Catalyst::Request'
        );
    }

    isa_ok( $creq, 'Catalyst::Request' );
    is( $creq->method, 'POST', 'Catalyst::Request method' );
    is( $creq->content_type, 'multipart/form-data',
        'Catalyst::Request Content-Type' );
    is( $creq->content_length, $request->content_length,
        'Catalyst::Request Content-Length' );

    for my $part ( $request->parts ) {

        my $disposition = $part->header('Content-Disposition');
        my %parameters  = @{ ( split_header_words($disposition) )[0] };

        next unless exists $parameters{filename};

        my $upload = $creq->{uploads}->{ $parameters{name} };

        isa_ok( $upload, 'Catalyst::Request::Upload' );

        is( $upload->type, $part->content_type, 'Upload Content-Type' );
        is( $upload->size, length( $part->content ), 'Upload Content-Length' );

        like( $upload->tempname, qr{\Q$dir\E}, 'uploadtmp' );
    }
}
Commit	Line	Data
dd4e6fd2	1	#!perl
	2
	3	use strict;
	4	use warnings;
	5
	6	use FindBin;
a2e038a1	7	use lib "$FindBin::Bin/lib";
dd4e6fd2	8
3c402610	9	use Test::More tests => 88;
dd4e6fd2	10	use Catalyst::Test 'TestApp';
	11
	12	use Catalyst::Request;
5c0ff128	13	use Catalyst::Request::Upload;
dd4e6fd2	14	use HTTP::Headers;
	15	use HTTP::Headers::Util 'split_header_words';
	16	use HTTP::Request::Common;
6d41c7c3	17	use Path::Class::Dir;
dd4e6fd2	18
	19	{
	20	my $creq;
	21
fbcc39ad	22	my $request = POST(
	23	'http://localhost/dump/request/',
	24	'Content-Type' => 'form-data',
dd4e6fd2	25	'Content' => [
a2e038a1	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"],
fbcc39ad	32	]
dd4e6fd2	33	);
	34
	35	ok( my $response = request($request), 'Request' );
	36	ok( $response->is_success, 'Response Successful 2xx' );
fbcc39ad	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
dd4e6fd2	44	{
dd4e6fd2	45	no strict 'refs';
fbcc39ad	46	ok(
	47	eval '$creq = ' . $response->content,
	48	'Unserialize Catalyst::Request'
	49	);
dd4e6fd2	50	}
	51
	52	isa_ok( $creq, 'Catalyst::Request' );
	53	is( $creq->method, 'POST', 'Catalyst::Request method' );
fbcc39ad	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' );
dd4e6fd2	58
	59	for my $part ( $request->parts ) {
	60
	61	my $disposition = $part->header('Content-Disposition');
	62	my %parameters = @{ ( split_header_words($disposition) )[0] };
	63
fbcc39ad	64	my $upload = $creq->{uploads}->{ $parameters{filename} };
fbcc39ad	65
5c0ff128	66	isa_ok( $upload, 'Catalyst::Request::Upload' );
dd4e6fd2	67
d3fced79	68	is( $upload->type, $part->content_type, 'Upload Content-Type' );
d3fced79	69	is( $upload->size, length( $part->content ), 'Upload Content-Length' );
a2e038a1	70
c4bed79a	71	# make sure upload is accessible via legacy params->{$file}
a2e038a1	72	is( $creq->{parameters}->{ $upload->filename },
	73	$upload->filename, 'legacy param method ok' );
	74
451553f5	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	}
dd4e6fd2	82	}
dd4e6fd2	83	}
1408d0a4	84
	85	{
	86	my $creq;
	87
fbcc39ad	88	my $request = POST(
fbcc39ad	89	'http://localhost/dump/request/',
1408d0a4	90	'Content-Type' => 'multipart/form-data',
1408d0a4	91	'Content' => [
a2e038a1	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"],
fbcc39ad	95	]
1408d0a4	96	);
	97
	98	ok( my $response = request($request), 'Request' );
	99	ok( $response->is_success, 'Response Successful 2xx' );
fbcc39ad	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
1408d0a4	107	{
1408d0a4	108	no strict 'refs';
fbcc39ad	109	ok(
	110	eval '$creq = ' . $response->content,
	111	'Unserialize Catalyst::Request'
	112	);
1408d0a4	113	}
	114
	115	isa_ok( $creq, 'Catalyst::Request' );
	116	is( $creq->method, 'POST', 'Catalyst::Request method' );
fbcc39ad	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
1408d0a4	122	my @parts = $request->parts;
1408d0a4	123
fbcc39ad	124	for ( my $i = 0 ; $i < @parts ; $i++ ) {
fbcc39ad	125
1408d0a4	126	my $part = $parts[$i];
	127	my $disposition = $part->header('Content-Disposition');
	128	my %parameters = @{ ( split_header_words($disposition) )[0] };
fbcc39ad	129
	130	my $upload = $creq->{uploads}->{ $parameters{name} }->[$i];
	131
1408d0a4	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' );
a2e038a1	136
451553f5	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	}
1408d0a4	144	}
1408d0a4	145	}
32d4bba8	146
	147	{
	148	my $creq;
	149
fbcc39ad	150	my $request = POST(
fbcc39ad	151	'http://localhost/engine/request/uploads/slurp',
32d4bba8	152	'Content-Type' => 'multipart/form-data',
a2e038a1	153	'Content' =>
a2e038a1	154	[ 'slurp' => ["$FindBin::Bin/live_engine_request_uploads.t"], ]
32d4bba8	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' );
fbcc39ad	160	is( $response->content, ( $request->parts )[0]->content, 'Content' );
32d4bba8	161	}
fdb3773e	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
c4c4dd19	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	}
fdb3773e	177
c4c4dd19	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	}
fdb3773e	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
c4c4dd19	193	ok( my $response = request($request), 'Request' );
fdb3773e	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	}
a7e05d9d	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	}
3c402610	258
3c402610	259	# test uploadtmp config var
451553f5	260	SKIP:
3c402610	261	{
451553f5	262	if ( $ENV{CATALYST_SERVER} ) {
	263	skip 'Not testing uploadtmp on remote server', 13;
	264	}
	265
3c402610	266	my $creq;
	267
	268	my $dir = "$FindBin::Bin/";
	269	local TestApp->config->{ uploadtmp } = $dir;
6d41c7c3	270	$dir = Path::Class::Dir->new( $dir );
3c402610	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