t/aggregate/live_engine_request_parameters.t

   1 use strict;
   2 use warnings;
   3
   4 use FindBin;
   5 use lib "$FindBin::Bin/../lib";
   6
   7 use Test::More tests => 54;
   8 use Catalyst::Test 'TestApp';
   9
  10 use Catalyst::Request;
  11 use HTTP::Headers;
  12 use 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 $parameters = {
 119         a     => 1,
 120         blank => '',
 121     };
 122
 123     my $request = POST(
 124         'http://localhost/dump/request/a/b?query+string',
 125         'Content'      => $parameters,
 126         'Content-Type' => 'application/x-www-form-urlencoded'
 127     );
 128
 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' );
 134
 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' );
 138 }
 139
 140 {
 141     my $creq;
 142     ok( my $response = request("http://localhost/dump/request?&&q="),
 143         'Request' );
 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' );
 149 }
 150
 151 {
 152     my $creq;
 153     ok( my $response = request("http://localhost/dump/request?&0&q="),
 154         'Request' );
 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' );
 161 }