Merge branch 'pr/135' into release-candidates/rc-5.90116

diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm
index 150c269..70f49fb 100644 (file)
--- 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/t/aggregate/live_engine_request_parameters.t b/t/aggregate/live_engine_request_parameters.t
index c7b4611..d2a91f0 100644 (file)
--- 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 (file)
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();