5 use lib "$FindBin::Bin/../lib";
7 use Test::More tests => 54;
8 use Catalyst::Test 'TestApp';
10 use Catalyst::Request;
12 use HTTP::Request::Common;
17 my $parameters = { 'a' => [qw(A b C d E f G)], };
19 my $query = join( '&', map { 'a=' . $_ } @{ $parameters->{a} } );
21 ok( my $response = request("http://localhost/dump/request?$query"),
23 ok( $response->is_success, 'Response Successful 2xx' );
24 is( $response->content_type, 'text/plain', 'Response Content-Type' );
27 qr/^bless\( .* 'Catalyst::Request' \)$/s,
28 'Content is a serialized Catalyst::Request'
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' );
39 ok( my $response = request("http://localhost/dump/request?q=foo%2bbar"),
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';
49 ok( my $response = request("http://localhost/dump/request?q=foo=bar"),
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';
61 'a' => [qw(A b C d E f G)],
62 '%' => [ '%', '"', '& - &' ],
67 'http://localhost/dump/request/a/b?a=1&a=2&a=3',
68 'Content' => $parameters,
69 'Content-Type' => 'application/x-www-form-urlencoded'
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' );
77 qr/^bless\( .* 'Catalyst::Request' \)$/s,
78 'Content is a serialized Catalyst::Request'
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' );
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
100 'url' => 'http://www.google.com',
104 my $request = POST( 'http://localhost/dump/request',
105 'Content-Type' => 'multipart/form-data',
106 'Content' => $parameters,
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' );
114 # raw query string support
124 'http://localhost/dump/request/a/b?query+string',
125 'Content' => $parameters,
126 'Content-Type' => 'application/x-www-form-urlencoded'
129 ok( my $response = request($request), 'Request' );
130 ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
131 is( $creq->uri->query, 'query+string', 'Catalyst::Request POST query_string' );
132 is( $creq->query_keywords, 'query string', 'Catalyst::Request query_keywords' );
133 is_deeply( $creq->parameters, $parameters, 'Catalyst::Request parameters' );
135 ok( $response = request('http://localhost/dump/request/a/b?x=1&y=1&z=1'), 'Request' );
136 ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
137 is( $creq->uri->query, 'x=1&y=1&z=1', 'Catalyst::Request GET query_string' );
142 ok( my $response = request("http://localhost/dump/request?&&q="),
144 ok( $response->is_success, 'Response Successful 2xx' );
145 is( $response->content_type, 'text/plain', 'Response Content-Type' );
146 ok( eval '$creq = ' . $response->content );
147 is( keys %{$creq->{parameters}}, 1, 'remove empty parameter' );
148 is( $creq->{parameters}->{q}, '', 'empty parameter' );
153 ok( my $response = request("http://localhost/dump/request?&0&q="),
155 ok( $response->is_success, 'Response Successful 2xx' );
156 is( $response->content_type, 'text/plain', 'Response Content-Type' );
157 ok( eval '$creq = ' . $response->content );
158 is( keys %{$creq->{parameters}}, 2, 'remove empty parameter' );
159 is( $creq->{parameters}->{q}, '', 'empty parameter' );
160 ok( !defined $creq->{parameters}->{0}, 'empty parameter' );