Compiler-Parser
view release on metacpan or search on metacpan
t/app/Plack/Request.t view on Meta::CPAN
=head1 AUTHORS
Tatsuhiko Miyagawa
Kazuhiro Osawa
Tokuhiro Matsuno
=head1 SEE ALSO
L<Plack::Response> L<HTTP::Request>, L<Catalyst::Request>
=head1 LICENSE
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
t/app/Plack/Test.t view on Meta::CPAN
use Plack::Test;
# named params
test_psgi
app => sub {
my $env = shift;
return [ 200, [ 'Content-Type' => 'text/plain' ], [ "Hello World" ] ],
},
client => sub {
my $cb = shift;
my $req = HTTP::Request->new(GET => "http://localhost/hello");
my $res = $cb->($req);
like $res->content, qr/Hello World/;
};
use HTTP::Request::Common;
# positional params (app, client)
my $app = sub { return [ 200, [], [ "Hello "] ] };
test_psgi $app, sub {
my $cb = shift;
my $res = $cb->(GET "/");
is $res->content, "Hello";
};
=head1 DESCRIPTION
Plack::Test is a unified interface to test PSGI applications using
L<HTTP::Request> and L<HTTP::Response> objects. It also allows you to run PSGI
applications in various ways. The default backend is C<Plack::Test::MockHTTP>,
but you may also use any L<Plack::Handler> implementation to run live HTTP
requests against at web server
=head1 FUNCTIONS
=over 4
=item test_psgi
test_psgi $app, $client;
test_psgi app => $app, client => $client;
Runs the client test code C<$client> against a PSGI application
C<$app>. The client callback gets one argument C<$cb>, a
callback that accepts an C<HTTP::Request> object and returns an
C<HTTP::Response> object.
Use L<HTTP::Request::Common> to import shortcuts for creating requests for
C<GET>, C<POST>, C<DELETE>, and C<PUT> operations.
For your convenience, the C<HTTP::Request> given to the callback automatically
uses the HTTP protocol and the localhost (I<127.0.0.1> by default), so the
following code just works:
use HTTP::Request::Common;
test_psgi $app, sub {
my $cb = shift;
my $res = $cb->(GET "/hello");
};
Note that however, it is not a good idea to pass an arbitrary
(i.e. user-input) string to C<GET> or even C<<
HTTP::Request->new >> by assuming that it always represents a path,
because:
my $req = GET "//foo/bar";
would represent a request for a URL that has no scheme, has a hostname
I<foo> and a path I</bar>, instead of a path I<//foo/bar> which you
might actually want.
=back
t/app/Plack/Test.t view on Meta::CPAN
Specify the L<Plack::Test> backend using the environment
variable C<PLACK_TEST_IMPL> or C<$Plack::Test::Impl> package variable.
The available values for the backend are:
=over 4
=item MockHTTP
(Default) Creates a PSGI env hash out of HTTP::Request object, runs
the PSGI application in-process and returns HTTP::Response.
=item Server
Runs one of Plack::Handler backends (C<Standalone> by default) and
sends live HTTP requests to test.
=item ExternalServer
Runs tests against an external server specified in the
t/app/Plack/Test/MockHTTP.t view on Meta::CPAN
Compiler::Parser::AST::Renderer->new->render($ast);
node_ok($ast->root, [
Test::Compiler::Parser::package { 'Plack::Test::MockHTTP',
},
module { 'strict',
},
module { 'warnings',
},
module { 'Carp',
},
module { 'HTTP::Request',
},
module { 'HTTP::Response',
},
module { 'HTTP::Message::PSGI',
},
module { 'Try::Tiny',
},
function { 'test_psgi',
body => [
branch { '=',
t/app/Plack/Test/MockHTTP.t view on Meta::CPAN
};
done_testing;
__DATA__
package Plack::Test::MockHTTP;
use strict;
use warnings;
use Carp;
use HTTP::Request;
use HTTP::Response;
use HTTP::Message::PSGI;
use Try::Tiny;
sub test_psgi {
my %args = @_;
my $client = delete $args{client} or croak "client test code needed";
my $app = delete $args{app} or croak "app needed";
t/app/Plack/Test/MockHTTP.t view on Meta::CPAN
__END__
=head1 NAME
Plack::Test::MockHTTP - Run mocked HTTP tests through PSGI applications
=head1 DESCRIPTION
Plack::Test::MockHTTP is a utility to run PSGI application given
HTTP::Request objects and return HTTP::Response object out of PSGI
application response. See L<Plack::Test> how to use this module.
=head1 AUTHOR
Tatsuhiko Miyagawa
=head1 SEE ALSO
L<Plack::Test>
t/app/Plack/Test/Suite.t view on Meta::CPAN
Test::Compiler::Parser::package { 'Plack::Test::Suite',
},
module { 'strict',
},
module { 'warnings',
},
module { 'Digest::MD5',
},
module { 'File::ShareDir',
},
module { 'HTTP::Request',
},
module { 'HTTP::Request::Common',
},
module { 'LWP::UserAgent',
},
module { 'Test::More',
},
module { 'Test::TCP',
},
module { 'Plack::Loader',
},
module { 'Plack::Middleware::Lint',
t/app/Plack/Test/Suite.t view on Meta::CPAN
branch { '=',
left => leaf '$chunk',
right => branch { 'x',
left => leaf 'abcdefgh',
right => leaf '12000',
},
},
branch { '=',
left => leaf '$req',
right => branch { '->',
left => leaf 'HTTP::Request',
right => function_call { 'new',
args => [
list { '()',
data => branch { '=>',
left => leaf 'POST',
right => leaf 'http://127.0.0.1/',
},
},
],
},
t/app/Plack/Test/Suite.t view on Meta::CPAN
branch { '=',
left => leaf '$cb',
right => function_call { 'shift',
args => [
],
},
},
branch { '=',
left => leaf '$req',
right => branch { '->',
left => leaf 'HTTP::Request',
right => function_call { 'new',
args => [
list { '()',
data => branch { ',',
left => branch { '=>',
left => leaf 'GET',
right => leaf 'http://127.0.0.1/',
},
},
},
t/app/Plack/Test/Suite.t view on Meta::CPAN
args => [
],
},
},
branch { '=',
left => leaf '$res',
right => branch { '->',
left => leaf '$cb',
right => list { '()',
data => branch { '->',
left => leaf 'HTTP::Request',
right => function_call { 'new',
args => [
list { '()',
data => branch { '=>',
left => leaf 'GET',
right => leaf 'http://127.0.0.1/',
},
},
],
},
t/app/Plack/Test/Suite.t view on Meta::CPAN
branch { '=',
left => leaf '$cb',
right => function_call { 'shift',
args => [
],
},
},
branch { '=',
left => leaf '$req',
right => branch { '->',
left => leaf 'HTTP::Request',
right => function_call { 'new',
args => [
list { '()',
data => branch { ',',
left => branch { '=>',
left => leaf 'GET',
right => leaf 'http://127.0.0.1/',
},
},
},
t/app/Plack/Test/Suite.t view on Meta::CPAN
branch { '=',
left => leaf '$cb',
right => function_call { 'shift',
args => [
],
},
},
branch { '=',
left => leaf '$req',
right => branch { '->',
left => leaf 'HTTP::Request',
right => function_call { 'new',
args => [
list { '()',
data => branch { '=>',
left => leaf 'POST',
right => leaf 'http://127.0.0.1/',
},
},
],
},
t/app/Plack/Test/Suite.t view on Meta::CPAN
right => leaf '4',
},
],
},
},
block { '',
body => [
branch { '=',
left => leaf '$req',
right => branch { '->',
left => leaf 'HTTP::Request',
right => function_call { 'new',
args => [
list { '()',
data => branch { ',',
left => branch { '=>',
left => leaf 'GET',
right => leaf 'http://127.0.0.1/',
},
},
},
t/app/Plack/Test/Suite.t view on Meta::CPAN
},
],
},
],
},
block { '',
body => [
branch { '=',
left => leaf '$req',
right => branch { '->',
left => leaf 'HTTP::Request',
right => function_call { 'new',
args => [
list { '()',
data => branch { ',',
left => branch { '=>',
left => leaf 'GET',
right => leaf 'http://127.0.0.1/',
},
},
},
t/app/Plack/Test/Suite.t view on Meta::CPAN
};
done_testing;
__DATA__
package Plack::Test::Suite;
use strict;
use warnings;
use Digest::MD5;
use File::ShareDir;
use HTTP::Request;
use HTTP::Request::Common;
use LWP::UserAgent;
use Test::More;
use Test::TCP;
use Plack::Loader;
use Plack::Middleware::Lint;
use Plack::Util;
use Plack::Request;
use Try::Tiny;
my $share_dir = try { File::ShareDir::dist_dir('Plack') } || 'share';
t/app/Plack/Test/Suite.t view on Meta::CPAN
],
[ 'Hello, ' . $body ],
];
},
],
[
'big POST',
sub {
my $cb = shift;
my $chunk = "abcdefgh" x 12000;
my $req = HTTP::Request->new(POST => "http://127.0.0.1/");
$req->content_length(length $chunk);
$req->content_type('application/octet-stream');
$req->content($chunk);
my $res = $cb->($req);
is $res->code, 200;
is $res->message, 'OK';
is $res->header('Client-Content-Length'), length $chunk;
is length $res->content, length $chunk;
is Digest::MD5::md5_hex($res->content), Digest::MD5::md5_hex($chunk);
t/app/Plack/Test/Suite.t view on Meta::CPAN
my $env = shift;
open my $io, '>', \my $error;
$env->{'psgi.errors'} = $io;
die "Throwing an exception from app handler. Server shouldn't crash.";
},
],
[
'multi headers (request)',
sub {
my $cb = shift;
my $req = HTTP::Request->new(
GET => "http://127.0.0.1/",
);
$req->push_header(Foo => "bar");
$req->push_header(Foo => "baz");
my $res = $cb->($req);
like($res->content, qr/^bar,\s*baz$/);
},
sub {
my $env = shift;
return [
200,
[ 'Content-Type' => 'text/plain', ],
[ $env->{HTTP_FOO} ]
];
},
],
[
'multi headers (response)',
sub {
my $cb = shift;
my $res = $cb->(HTTP::Request->new(GET => "http://127.0.0.1/"));
my $foo = $res->header('X-Foo');
like $foo, qr/foo,\s*bar,\s*baz/;
},
sub {
my $env = shift;
return [
200,
[ 'Content-Type' => 'text/plain', 'X-Foo', 'foo', 'X-Foo', 'bar, baz' ],
[ 'hi' ]
];
},
],
[
'Do not set $env->{COOKIE}',
sub {
my $cb = shift;
my $req = HTTP::Request->new(
GET => "http://127.0.0.1/",
);
$req->push_header(Cookie => "foo=bar");
my $res = $cb->($req);
is($res->header('X-Cookie'), 0);
is $res->content, 'foo=bar';
},
sub {
my $env = shift;
return [
t/app/Plack/Test/Suite.t view on Meta::CPAN
is $res->content, 'Not Found';
},
sub {
return [ 404, [ "Content-Type", "text/plain" ], [ "Not Found" ] ];
},
],
[
'request->input seekable',
sub {
my $cb = shift;
my $req = HTTP::Request->new(POST => "http://127.0.0.1/");
$req->content("body");
$req->content_type('text/plain');
$req->content_length(4);
my $res = $cb->($req);
is $res->content, 'body';
},
sub {
my $req = Plack::Request->new(shift);
return [ 200, [ "Content-Type", "text/plain" ], [ $req->content ] ];
},
t/app/Plack/Test/Suite.t view on Meta::CPAN
},
],
[
'handle Authorization header',
sub {
my $cb = shift;
SKIP: {
skip "Authorization header is unsupported under CGI", 4 if ($ENV{PLACK_TEST_HANDLER} || "") eq "CGI";
{
my $req = HTTP::Request->new(
GET => "http://127.0.0.1/",
);
$req->push_header(Authorization => 'Basic XXXX');
my $res = $cb->($req);
is $res->header('X-AUTHORIZATION'), 1;
is $res->content, 'Basic XXXX';
};
{
my $req = HTTP::Request->new(
GET => "http://127.0.0.1/",
);
my $res = $cb->($req);
is $res->header('X-AUTHORIZATION'), 0;
is $res->content, '';
};
};
},
sub {
my $env = shift;
( run in 0.375 second using v1.01-cache-2.11-cpan-de7293f3b23 )