use strict;
use warnings;
use Test::More import => ['!pass'];
use Carp 'croak';
use Dancer2;
use Dancer2::Core::App;
use Dancer2::Core::Route;
use Dancer2::Core::Dispatcher;
use Dancer2::Core::Hook;
set logger => 'Null';
# init our test fixture
my $buffer = {};
my $app = Dancer2::Core::App->new( name => 'main' );
$app->setting( logger => engine('logger') );
$app->setting( show_errors => 1 );
# a simple / route
$app->add_route(
method => 'get',
regexp => '/',
code => sub {"home"},
);
# an error route
$app->add_route(
method => 'get',
regexp => '/error',
code => sub { Fail->fail; },
);
# A chain of two route for /user/$foo
$app->add_route(
method => 'get',
regexp => '/user/:name',
code => sub {
my $ctx = shift;
$buffer->{user} = $ctx->request->params->{'name'};
$ctx->response->has_passed(1);
},
);
$app->add_route(
method => 'get',
regexp => '/user/*?',
code => sub {
my $ctx = shift;
"Hello " . $ctx->request->params->{'name'};
},
);
# the tests
my @tests = (
{ env => {
REQUEST_METHOD => 'GET',
PATH_INFO => '/',
},
expected => [
200,
[ 'Content-Length' => 4,
'Content-Type' => 'text/html; charset=UTF-8',
'Server' => "Perl Dancer2 $Dancer2::VERSION",
],
["home"]
]
},
{ env => {
REQUEST_METHOD => 'GET',
PATH_INFO => '/user/Johnny',
},
expected => [
200,
[ 'Content-Length' => 12,
'Content-Type' => 'text/html; charset=UTF-8',
'Server' => "Perl Dancer2 $Dancer2::VERSION",
],
["Hello Johnny"]
]
},
{ env => {
REQUEST_METHOD => 'GET',
PATH_INFO => '/haltme',
},
expected => [
302,
[ 'Location' => 'http://perldancer.org',
'Content-Length' => '0',
'Content-Type' => 'text/html',
'Server' => "Perl Dancer2 $Dancer2::VERSION",
],
['']
]
},
# NOT SUPPORTED YET
# { env => {
# REQUEST_METHOD => 'GET',
# PATH_INFO => '/admin',
# },
# expected => [200, [], ["home"]]
# },
);
# simulates a redirect with halt
$app->add_hook(
Dancer2::Core::Hook->new(
name => 'before',
code => sub {
my $ctx = shift;
if ( $ctx->request->path_info eq '/haltme' ) {
$ctx->response->header( Location => 'http://perldancer.org' );
$ctx->response->status(302);
$ctx->response->is_halted(1);
}
},
)
);
my $was_in_second_filter = 0;
$app->add_hook(
Dancer2::Core::Hook->new(
name => 'before',
code => sub {
my $ctx = shift;
if ( $ctx->request->path_info eq '/haltme' ) {
$was_in_second_filter =
1; # should not happen because first filter halted the flow
}
},
)
);
$app->add_route(
method => 'get',
regexp => '/haltme',
code => sub {"should not get there"},
);
$app->compile_hooks;
plan tests => 13;
my $dispatcher = Dancer2::Core::Dispatcher->new( apps => [$app] );
my $counter = 0;
foreach my $test (@tests) {
my $env = $test->{env};
my $expected = $test->{expected};
my $resp = $dispatcher->dispatch($env)->to_psgi;
is( $resp->[0], $expected->[0], 'Return code ok' );
my %got_headers = @{ $resp->[1] };
my %exp_headers = @{ $expected->[1] };
is_deeply( \%got_headers, \%exp_headers, 'Correct headers' );
if ( ref( $expected->[2] ) eq "Regexp" ) {
like $resp->[2][0] => $expected->[2], "Contents ok. (test $counter)";
}
else {
is_deeply $resp->[2] => $expected->[2], "Contents ok. (test $counter)";
}
$counter++;
}
foreach my $test (
{ env => {
REQUEST_METHOD => 'GET',
PATH_INFO => '/error',
'psgi.uri_scheme' => 'http',
SERVER_NAME => 'localhost',
SERVER_PORT => 5000,
SERVER_PROTOCOL => 'HTTP/1.1',
},
expected => [
500,
[ 'Content-Length', "Content-Type", 'text/html' ],
qr{Internal Server Error.*Can't locate object method "fail" via package "Fail" \(perhaps you forgot to load "Fail"\?\) at t/dispatcher\.t line \d+.*$}ms
]
}
)
{
my $env = $test->{env};
my $expected = $test->{expected};
my $resp = $dispatcher->dispatch($env);
is $resp->status => $expected->[0], "Return code ok.";
ok( $resp->header('Content-Length') >= 140, "Length ok." );
like $resp->content, $expected->[2], "contents ok";
}
is $was_in_second_filter, 0, "didnt enter the second filter, because of halt";