Merged 5.49_01 (r1339) from refactored branch to trunk
[catagits/Catalyst-Runtime.git] / t / live / engine / request / parameters.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 => 28;
10 use Catalyst::Test 'TestApp';
11
12 use Catalyst::Request;
13 use HTTP::Headers;
14 use HTTP::Request::Common;
15 use URI;
16
17 {
18     my $creq;
19
20     my $parameters = { 'a' => [qw(A b C d E f G)], };
21
22     my $query = join( '&', map { 'a=' . $_ } @{ $parameters->{a} } );
23
24     ok( my $response = request("http://localhost/dump/request?$query"),
25         'Request' );
26     ok( $response->is_success, 'Response Successful 2xx' );
27     is( $response->content_type, 'text/plain', 'Response Content-Type' );
28     like(
29         $response->content,
30         qr/^bless\( .* 'Catalyst::Request' \)$/s,
31         'Content is a serialized Catalyst::Request'
32     );
33     ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
34     isa_ok( $creq, 'Catalyst::Request' );
35     is( $creq->method, 'GET', 'Catalyst::Request method' );
36     is_deeply( $creq->{parameters}, $parameters,
37         'Catalyst::Request parameters' );
38 }
39
40 {
41     my $creq;
42
43     my $parameters = {
44         'a' => [qw(A b C d E f G)],
45         '%' => [ '%', '"', '& - &' ],
46     };
47
48     my $request = POST(
49         'http://localhost/dump/request/a/b?a=1&a=2&a=3',
50         'Content'      => $parameters,
51         'Content-Type' => 'application/x-www-form-urlencoded'
52     );
53
54     unshift( @{ $parameters->{a} }, 1, 2, 3 );
55
56     ok( my $response = request($request), 'Request' );
57     ok( $response->is_success, 'Response Successful 2xx' );
58     is( $response->content_type, 'text/plain', 'Response Content-Type' );
59     like(
60         $response->content,
61         qr/^bless\( .* 'Catalyst::Request' \)$/s,
62         'Content is a serialized Catalyst::Request'
63     );
64     ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
65     isa_ok( $creq, 'Catalyst::Request' );
66     is( $creq->method, 'POST', 'Catalyst::Request method' );
67     is_deeply( $creq->{parameters}, $parameters,
68         'Catalyst::Request parameters' );
69     is_deeply( $creq->arguments, [qw(a b)], 'Catalyst::Request arguments' );
70     is_deeply( $creq->{uploads}, {}, 'Catalyst::Request uploads' );
71     is_deeply( $creq->cookies,   {}, 'Catalyst::Request cookie' );
72 }
73
74 # http://dev.catalyst.perl.org/ticket/37
75 # multipart/form-data parameters that contain 'http://'
76 # was an HTTP::Message bug, but HTTP::Body handles it properly now
77 {
78     my $creq;
79
80     my $parameters = {
81         'url' => 'http://www.google.com',
82     };
83
84     my $request = POST( 'http://localhost/dump/request',
85         'Content-Type' => 'multipart/form-data',
86         'Content'      => $parameters,
87     );
88
89     ok( my $response = request($request), 'Request' );
90     ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
91     is_deeply( $creq->{parameters}, $parameters, 'Catalyst::Request parameters' );
92 }
93
94 # raw query string support
95 {
96     my $creq;
97     
98     my $parameters = {
99         a => 1,
100     };
101
102     my $request = POST(
103         'http://localhost/dump/request/a/b?query_string',
104         'Content'      => $parameters,
105         'Content-Type' => 'application/x-www-form-urlencoded'
106     );
107     
108     ok( my $response = request($request), 'Request' );
109     ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
110     is( $creq->{uri}->query, 'query_string', 'Catalyst::Request POST query_string' );
111     
112     ok( $response = request('http://localhost/dump/request/a/b?x=1&y=1&z=1'), 'Request' );
113     ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
114     is( $creq->{uri}->query, 'x=1&y=1&z=1', 'Catalyst::Request GET query_string' );
115 }