From: Jay Hannah Date: Tue, 16 Jan 2018 22:46:29 +0000 (-0600) Subject: Merge branch 'pr/157' into release-candidates/rc-5.90116 X-Git-Tag: 5.90116~6 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=0739a7ecb8f44518900a7d056d6d2837d553321a;hp=f357811db01e4be78e06e234ddcf78bba3374a6a Merge branch 'pr/157' into release-candidates/rc-5.90116 --- diff --git a/.travis.yml b/.travis.yml index 9a04424..05fa29a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -24,6 +24,15 @@ install: - cpanm --notest --metacpan --skip-satisfied --installdeps . - echo y | perl Makefile.PL + # installing Catalyst::Devel above causes the latest release of + # Catalyst::Runtime to be installed, but the version we're testing might + # have additional deps that aren't yet satisfied. so we should try + # installing deps again now that the MYMETA has been created (and we'll also + # need to delete the now-unneeded cpanfile so that cpanm doesn't choose it + # in preference to the MYMETA) + - rm -f cpanfile + - cpanm --notest --metacpan --skip-satisfied --installdeps . + # enable various test options, including parallel testing - export AUTOMATED_TESTING=1 HARNESS_OPTIONS=j10:c HARNESS_TIMER=1 diff --git a/Makefile.PL b/Makefile.PL index f1d8607..2140deb 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -26,7 +26,7 @@ author 'Sebastian Riedel '; authority('cpan:MSTROUT'); all_from 'lib/Catalyst/Runtime.pm'; -requires 'List::Util' => '1.45'; +requires 'List::Util' => '1.45'; # for uniq() requires 'namespace::autoclean' => '0.28'; requires 'namespace::clean' => '0.23'; requires 'MooseX::Emulate::Class::Accessor::Fast' => '0.00903'; diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 8c598ba..d4701cc 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -27,6 +27,7 @@ use HTML::Entities; use Tree::Simple qw/use_weak_refs/; use Tree::Simple::Visitor::FindByUID; use Class::C3::Adopt::NEXT; +use List::Util qw/uniq/; use attributes; use String::RewritePrefix; use Catalyst::EngineLoader; diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm index 150c269..70f49fb 100644 --- a/lib/Catalyst/Engine.pm +++ b/lib/Catalyst/Engine.pm @@ -592,22 +592,28 @@ sub prepare_query_parameters { ? $env->{QUERY_STRING} : ''; - # Check for keywords (no = signs) - # (yes, index() is faster than a regex :)) - if ( index( $query_string, '=' ) < 0 ) { - my $keywords = $self->unescape_uri($query_string); - $keywords = $decoder->($keywords); - $c->request->query_keywords($keywords); - return; - } - $query_string =~ s/\A[&;]+//; - my $p = Hash::MultiValue->new( - map { defined $_ ? $decoder->($self->unescape_uri($_)) : $_ } - map { ( split /=/, $_, 2 )[0,1] } # slice forces two elements - split /[&;]+/, $query_string - ); + my @unsplit_pairs = split /[&;]+/, $query_string; + my $p = Hash::MultiValue->new(); + + my $is_first_pair = 1; + for my $pair (@unsplit_pairs) { + my ($name, $value) + = map { defined $_ ? $decoder->($self->unescape_uri($_)) : $_ } + ( split /=/, $pair, 2 )[0,1]; # slice forces two elements + + if ($is_first_pair) { + # If the first pair has no equal sign, then it means the isindex + # flag is set. + $c->request->query_keywords($name) unless defined $value; + + $is_first_pair = 0; + } + + $p->add( $name => $value ); + } + $c->encoding($old_encoding) if $old_encoding; $c->request->query_parameters( $c->request->_use_hash_multivalue ? $p : $p->mixed ); diff --git a/lib/Catalyst/Request.pm b/lib/Catalyst/Request.pm index 5403615..e6e8657 100644 --- a/lib/Catalyst/Request.pm +++ b/lib/Catalyst/Request.pm @@ -123,7 +123,7 @@ sub _build_body_data { # Not sure if these returns should not be exceptions... my $content_type = $self->content_type || return; - return unless ($self->method eq 'POST' || $self->method eq 'PUT'); + return unless ($self->method eq 'POST' || $self->method eq 'PUT' || $self->method eq 'PATCH'); my ($match) = grep { $content_type =~/$_/i } keys(%{$self->data_handlers}); diff --git a/lib/Catalyst/Response.pm b/lib/Catalyst/Response.pm index 94ee3f3..e7bc2d3 100644 --- a/lib/Catalyst/Response.pm +++ b/lib/Catalyst/Response.pm @@ -556,7 +556,7 @@ finalized (there isn't one anyway) and you need to call the close method. Prints @data to the output stream, separated by $,. This lets you pass the response object to functions that want to write to an L. -=head2 $self->finalize_headers($c) +=head2 $res->finalize_headers() Writes headers to response if not already written diff --git a/lib/Catalyst/Test.pm b/lib/Catalyst/Test.pm index e121b35..ef2ff18 100644 --- a/lib/Catalyst/Test.pm +++ b/lib/Catalyst/Test.pm @@ -256,6 +256,15 @@ header configuration; currently only supports setting 'host' value. my $res = request('foo/bar?test=1'); my $virtual_res = request('foo/bar?test=1', {host => 'virtualhost.com'}); +Alternately, you can pass in an L object to set arbitrary +request headers. + + my $res = request(GET '/foo/bar', + X-Foo => 'Bar', + Authorization => 'Bearer JWT_HERE', + ... + ); + =head2 ($res, $c) = ctx_request( ... ); Works exactly like L, except it also returns the Catalyst context object, diff --git a/t/aggregate/live_engine_request_parameters.t b/t/aggregate/live_engine_request_parameters.t index c7b4611..d2a91f0 100644 --- a/t/aggregate/live_engine_request_parameters.t +++ b/t/aggregate/live_engine_request_parameters.t @@ -4,7 +4,7 @@ use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; -use Test::More tests => 54; +use Test::More tests => 56; use Catalyst::Test 'TestApp'; use Catalyst::Request; @@ -115,14 +115,21 @@ use HTTP::Request::Common; { my $creq; - my $parameters = { + my $body_parameters = { a => 1, blank => '', }; + my $query_parameters = { + 'query string' => undef + }; + my $parameters = { + %$body_parameters, + %$query_parameters + }; my $request = POST( 'http://localhost/dump/request/a/b?query+string', - 'Content' => $parameters, + 'Content' => $body_parameters, 'Content-Type' => 'application/x-www-form-urlencoded' ); @@ -130,6 +137,8 @@ use HTTP::Request::Common; ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' ); is( $creq->uri->query, 'query+string', 'Catalyst::Request POST query_string' ); is( $creq->query_keywords, 'query string', 'Catalyst::Request query_keywords' ); + is_deeply( $creq->query_parameters, $query_parameters, 'Catalyst::Request query_parameters' ); + is_deeply( $creq->body_parameters, $body_parameters, 'Catalyst::Request body_parameters' ); is_deeply( $creq->parameters, $parameters, 'Catalyst::Request parameters' ); ok( $response = request('http://localhost/dump/request/a/b?x=1&y=1&z=1'), 'Request' ); diff --git a/t/query_keywords_and_parameters.t b/t/query_keywords_and_parameters.t new file mode 100644 index 0000000..27e598b --- /dev/null +++ b/t/query_keywords_and_parameters.t @@ -0,0 +1,84 @@ +use warnings; +use strict; +use Test::More; + +# Test case for reported issue when an action consumes JSON but a +# POST sends nothing we get a hard error + +{ + package MyApp::Controller::Root; + $INC{'MyApp/Controller/Root.pm'} = __FILE__; + + use base 'Catalyst::Controller'; + + sub bar :Local Args(0) GET { + my( $self, $c ) = @_; + } + + package MyApp; + use Catalyst; + MyApp->setup; +} + +use HTTP::Request::Common; +use Catalyst::Test 'MyApp'; + +# These tests assume that the decoding that occurs for the query string follows +# the payload decoding algorithm described here: +# https://www.w3.org/TR/html5/forms.html#url-encoded-form-data + +{ + ok my $req = GET 'root/bar'; + + my ($res, $c) = ctx_request($req); + + ok !defined($c->req->query_keywords), 'query_keywords is not defined when no ?'; + is_deeply $c->req->query_parameters, {}, 'query_parameters defined, but empty for no ?'; +} + + +{ + ok my $req = GET 'root/bar?'; + + my ($res, $c) = ctx_request($req); + + ok !defined $c->req->query_keywords, 'query_keywords is not defined when ? with empty query string'; + is_deeply $c->req->query_parameters, {}, 'query_parameters defined, but empty with empty query string'; +} + + +{ + ok my $req = GET 'root/bar?a=b'; + + my ($res, $c) = ctx_request($req); + + ok !defined($c->req->query_keywords), 'query_keywords undefined when isindex not set'; + is_deeply $c->req->query_parameters, { a => 'b' }, 'query_parameters defined for ?a=b'; +} + + +{ + ok my $req = GET 'root/bar?x'; + + my ($res, $c) = ctx_request($req); + + is $c->req->query_keywords, 'x', 'query_keywords defined for ?x'; + # The algorithm reads like 'x' should be treated as a value, not a name. + # Perl does not support undef as a hash key. I feel this would be the best + # alternative as isindex is moving towards complete deprecation. + is_deeply $c->req->query_parameters, { 'x' => undef }, 'query_parameters defined for ?x'; +} + + +{ + ok my $req = GET 'root/bar?x&a=b'; + + my ($res, $c) = ctx_request($req); + + is $c->req->query_keywords, 'x', 'query_keywords defined for ?x&a=b'; + # See comment above about the 'query_parameters defined for ?x' test case. + is_deeply $c->req->query_parameters, { 'x' => undef, a => 'b' }, 'query_parameters defined for ?x&a=b'; +} + + +done_testing();