- 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
# 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++)
'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,
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 },
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;
? $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 );
# 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});
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}
+ );
}
}
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
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,
+++ /dev/null
-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;
use FindBin;
use lib "$FindBin::Bin/../lib";
-use Test::More tests => 54;
+use Test::More tests => 56;
use Catalyst::Test 'TestApp';
use Catalyst::Request;
{
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'
);
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' );
use Test::More;
use HTTP::Request::Common;
use JSON::MaybeXS;
+use Capture::Tiny qw/:all/;
use lib "$FindBin::Bin/lib";
use Catalyst::Test 'TestDataHandlers';
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;
--- /dev/null
+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();