- 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
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';
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 $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,
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' );
--- /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();
projects / catagits/Catalyst-Runtime.git / commitdiff