1use strict;
2use warnings;
3
4use FindBin;
5use lib "$FindBin::Bin/../lib";
6
7use Test::More tests => 56;
8use Catalyst::Test 'TestApp';
9
10use Catalyst::Request;
11use HTTP::Headers;
12use HTTP::Request::Common;
13
14{
15    my $creq;
16
17    my $parameters = { 'a' => [qw(A b C d E f G)], };
18
19    my $query = join( '&', map { 'a=' . $_ } @{ $parameters->{a} } );
20
21    ok( my $response = request("http://localhost/dump/request?$query"),
22        'Request' );
23    ok( $response->is_success, 'Response Successful 2xx' );
24    is( $response->content_type, 'text/plain', 'Response Content-Type' );
25    like(
26        $response->content,
27        qr/^bless\( .* 'Catalyst::Request' \)$/s,
28        'Content is a serialized Catalyst::Request'
29    );
30    ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
31    isa_ok( $creq, 'Catalyst::Request' )
32      or fail("EXCEPTION: $@");
33    is( $creq->method, 'GET', 'Catalyst::Request method' );
34    is_deeply( $creq->parameters, $parameters,
35        'Catalyst::Request parameters' );
36}
37{
38    my $creq;
39    ok( my $response = request("http://localhost/dump/request?q=foo%2bbar"),
40        'Request' );
41    ok( $response->is_success, 'Response Successful 2xx' );
42    is( $response->content_type, 'text/plain', 'Response Content-Type' );
43    ok( eval '$creq = ' . $response->content );
44    is $creq->parameters->{q}, 'foo+bar', '%2b not double decoded';
45}
46
47{
48    my $creq;
49    ok( my $response = request("http://localhost/dump/request?q=foo=bar"),
50        'Request' );
51    ok( $response->is_success, 'Response Successful 2xx' );
52    is( $response->content_type, 'text/plain', 'Response Content-Type' );
53    ok( eval '$creq = ' . $response->content );
54    is $creq->parameters->{q}, 'foo=bar', '= not ignored';
55}
56
57{
58    my $creq;
59
60    my $parameters = {
61        'a'     => [qw(A b C d E f G)],
62        '%'     => [ '%', '"', '& - &' ],
63        'blank' => '',
64    };
65
66    my $request = POST(
67        'http://localhost/dump/request/a/b?a=1&a=2&a=3',
68        'Content'      => $parameters,
69        'Content-Type' => 'application/x-www-form-urlencoded'
70    );
71
72    ok( my $response = request($request), 'Request' );
73    ok( $response->is_success, 'Response Successful 2xx' );
74    is( $response->content_type, 'text/plain', 'Response Content-Type' );
75    like(
76        $response->content,
77        qr/^bless\( .* 'Catalyst::Request' \)$/s,
78        'Content is a serialized Catalyst::Request'
79    );
80    ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
81    isa_ok( $creq, 'Catalyst::Request' );
82    is( $creq->method, 'POST', 'Catalyst::Request method' );
83    is_deeply( $creq->body_parameters, $parameters,
84               'Catalyst::Request body_parameters' );
85    unshift( @{ $parameters->{a} }, 1, 2, 3 );
86    is_deeply( $creq->parameters, $parameters,
87        'Catalyst::Request parameters' );
88    is_deeply( $creq->arguments, [qw(a b)], 'Catalyst::Request arguments' );
89    is_deeply( $creq->uploads,   {}, 'Catalyst::Request uploads' );
90    is_deeply( $creq->cookies,   {}, 'Catalyst::Request cookie' );
91}
92
93# http://dev.catalyst.perl.org/ticket/37
94# multipart/form-data parameters that contain 'http://'
95# was an HTTP::Message bug, but HTTP::Body handles it properly now
96{
97    my $creq;
98
99    my $parameters = {
100        'url'   => 'http://www.google.com',
101        'blank' => '',
102    };
103
104    my $request = POST( 'http://localhost/dump/request',
105        'Content-Type' => 'multipart/form-data',
106        'Content'      => $parameters,
107    );
108
109    ok( my $response = request($request), 'Request' );
110    ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
111    is_deeply( $creq->parameters, $parameters, 'Catalyst::Request parameters' );
112}
113
114# raw query string support
115{
116    my $creq;
117
118    my $body_parameters = {
119        a     => 1,
120        blank => '',
121    };
122    my $query_parameters = {
123      'query string' => undef
124    };
125    my $parameters = {
126      %$body_parameters,
127      %$query_parameters
128    };
129
130    my $request = POST(
131        'http://localhost/dump/request/a/b?query+string',
132        'Content'      => $body_parameters,
133        'Content-Type' => 'application/x-www-form-urlencoded'
134    );
135
136    ok( my $response = request($request), 'Request' );
137    ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
138    is( $creq->uri->query, 'query+string', 'Catalyst::Request POST query_string' );
139    is( $creq->query_keywords, 'query string', 'Catalyst::Request query_keywords' );
140    is_deeply( $creq->query_parameters, $query_parameters, 'Catalyst::Request query_parameters' );
141    is_deeply( $creq->body_parameters, $body_parameters, 'Catalyst::Request body_parameters' );
142    is_deeply( $creq->parameters, $parameters, 'Catalyst::Request parameters' );
143
144    ok( $response = request('http://localhost/dump/request/a/b?x=1&y=1&z=1'), 'Request' );
145    ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
146    is( $creq->uri->query, 'x=1&y=1&z=1', 'Catalyst::Request GET query_string' );
147}
148
149{
150    my $creq;
151    ok( my $response = request("http://localhost/dump/request?&&q="),
152        'Request' );
153    ok( $response->is_success, 'Response Successful 2xx' );
154    is( $response->content_type, 'text/plain', 'Response Content-Type' );
155    ok( eval '$creq = ' . $response->content );
156    is( keys %{$creq->{parameters}}, 1, 'remove empty parameter' );
157    is( $creq->{parameters}->{q}, '', 'empty parameter' );
158}
159
160{
161    my $creq;
162    ok( my $response = request("http://localhost/dump/request?&0&q="),
163        'Request' );
164    ok( $response->is_success, 'Response Successful 2xx' );
165    is( $response->content_type, 'text/plain', 'Response Content-Type' );
166    ok( eval '$creq = ' . $response->content );
167    is( keys %{$creq->{parameters}}, 2, 'remove empty parameter' );
168    is( $creq->{parameters}->{q}, '', 'empty parameter' );
169    ok( !defined $creq->{parameters}->{0}, 'empty parameter' );
170}
171