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