Merge branch 'distar' into release-candidates/rc-5.90116
John Napiorkowski [Thu, 18 Jan 2018 20:32:28 +0000 (14:32 -0600)]
14 files changed:
.travis.yml
Changes
Makefile.PL
lib/Catalyst.pm
lib/Catalyst/Engine.pm
lib/Catalyst/Request.pm
lib/Catalyst/Response.pm
lib/Catalyst/Test.pm
t/aggregate.t [deleted file]
t/aggregate/live_engine_request_parameters.t
t/data_handler.t
t/query_keywords_and_parameters.t [new file with mode: 0644]
t/something/Makefile.PL [deleted file]
t/something/script/foo/bar/for_dist [deleted file]

index a70dd92..c920b6c 100644 (file)
@@ -15,6 +15,15 @@ install:
    - cpanm --notest --metacpan --skip-satisfied --with-develop --installdeps .
    - 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/Changes b/Changes
index 0fc85ac..e69b8be 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,10 @@
 # This file documents the revision history for Perl extension Catalyst.
 
+5.90116 - TBA
+  - Switch from Module::Install to Distar (solves problems that MI has with newer Perl) haarg++
+  - Killed Test::Aggregate since its clearly doomed
+  -
+
 5.90115 - 2017-05-01
   - fixes for silent bad behavior in Catalyst::ScriptRole and 'ensure_class_loaded'
     (hobbs++)
index 3361aac..16b0097 100644 (file)
@@ -94,7 +94,7 @@ my %META = (
         'Catalyst::Engine::PSGI'  => 0,
         'Test::WWW::Mechanize::Catalyst' => '0.51',
         'Test::TCP'               => '2.00', # ditto, ships Net::EmptyPort
-        'File::Copy::Recursive'   => 0,
+        'File::Copy::Recursive'   => '0.40',
         'Starman'                 => 0,
         'MooseX::Daemonize'       => 0,
         'Test::NoTabs'            => 0,
@@ -165,14 +165,7 @@ my %META = (
   x_authority => 'cpan:MSTROUT',
 );
 
-my $tests = 't/*.t';
-if ($ENV{AGGREGATE_TESTS} && eval { require Test::Aggregate; Test::Aggregate->VERSION(0.364); }) {
-    open my $fh, '>', '.aggregating';
-}
-else {
-    unlink '.aggregating';
-    $tests .= ' t/aggregate/*.t';
-}
+my $tests = 't/*.t t/aggregate/*.t';
 
 my %MM_ARGS = (
   test => { TESTS => $tests },
index 8c598ba..d4701cc 100644 (file)
@@ -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;
index 150c269..70f49fb 100644 (file)
@@ -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 );
index 1306b94..e6e8657 100644 (file)
@@ -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});
@@ -132,8 +132,11 @@ sub _build_body_data {
       my $fh = $self->body;
       local $_ = $fh;
       return $self->data_handlers->{$match}->($fh, $self);
-    } else { 
-      Catalyst::Exception->throw("$content_type is does not have an available data handler");
+    } else {
+      Catalyst::Exception->throw(
+        sprintf '%s does not have an available data handler. Valid data_handlers are %s.',
+          $content_type, join ', ', sort keys %{$self->data_handlers}
+      );
     }
 }
 
index 94ee3f3..e7bc2d3 100644 (file)
@@ -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<IO::Handle>.
 
-=head2 $self->finalize_headers($c)
+=head2 $res->finalize_headers()
 
 Writes headers to response if not already written
 
index e121b35..ef2ff18 100644 (file)
@@ -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<HTTP::Request::Common> 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<request|/"$res = request( ... );">, except it also returns the Catalyst context object,
diff --git a/t/aggregate.t b/t/aggregate.t
deleted file mode 100644 (file)
index e071379..0000000
+++ /dev/null
@@ -1,29 +0,0 @@
-use strict;
-use warnings;
-
-use FindBin;
-use lib "$FindBin::Bin/lib";
-use File::Spec::Functions 'catfile', 'updir';
-
-BEGIN {
-    unless (-e catfile $FindBin::Bin, updir, '.aggregating') {
-        require Test::More;
-        Test::More::plan(skip_all => 'No test aggregation requested');
-    }
-}
-
-BEGIN {
-    unless (eval { require Test::Aggregate; Test::Aggregate->VERSION('0.364'); 1 }) {
-        require Test::More;
-        Test::More::plan(skip_all => 'Test::Aggregate 0.364 required for test aggregation');
-    }
-}
-
-my $tests = Test::Aggregate->new({
-    (@ARGV ? (tests => \@ARGV) : (dirs => 't/aggregate')),
-    verbose       => 0,
-    set_filenames => 1,
-    findbin       => 1,
-});
-
-$tests->run;
index c7b4611..d2a91f0 100644 (file)
@@ -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' );
index 0d4af33..65af48a 100644 (file)
@@ -7,6 +7,7 @@ use FindBin;
 use Test::More;
 use HTTP::Request::Common;
 use JSON::MaybeXS;
+use Capture::Tiny qw/:all/;
 
 use lib "$FindBin::Bin/lib";
 use Catalyst::Test 'TestDataHandlers';
@@ -30,5 +31,13 @@ ok my($res, $c) = ctx_request('/');
   is $response->content, 'expected', 'expected content body';
 }
 
+{
+  my $out;
+  local *STDERR;
+  open(STDERR, ">", \$out) or die "Can't open STDERR: $!";
+  ok my $req = POST $c->uri_for_action('/test_nested_for'), 'Content-Type' => 'multipart/form-data', Content => { die => "a horrible death" };
+  ok my $response = request $req;
+  is($out, "[error] multipart/form-data does not have an available data handler. Valid data_handlers are application/json, application/x-www-form-urlencoded.\n", 'yep we throw the slightly more usefull error');
+}
 
 done_testing;
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
@@ -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();
diff --git a/t/something/Makefile.PL b/t/something/Makefile.PL
deleted file mode 100644 (file)
index e69de29..0000000
diff --git a/t/something/script/foo/bar/for_dist b/t/something/script/foo/bar/for_dist
deleted file mode 100644 (file)
index e69de29..0000000