1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
# who test the tester? We do!
use strict;
use warnings;
use File::Spec;
use File::Basename qw/dirname/;
BEGIN {
# Disable route handlers so we can actually test route_exists
# and route_doesnt_exist. Use config that disables default route handlers.
$ENV{DANCER_CONFDIR} = File::Spec->catdir(dirname(__FILE__), 'dancer-test');
}
use Test::More tests => 49;
use Dancer2;
use Dancer2::Test;
use Dancer2::Core::Request;
use File::Temp;
use Encode;
use URI::Escape;
$Dancer2::Test::NO_WARN = 1;
my @routes = (
'/foo',
[ GET => '/foo' ],
Dancer2::Core::Request->new(
env => {
'psgi.url_scheme' => 'http',
REQUEST_METHOD => 'GET',
QUERY_STRING => '',
SERVER_NAME => 'localhost',
SERVER_PORT => 5000,
SERVER_PROTOCOL => 'HTTP/1.1',
SCRIPT_NAME => '',
PATH_INFO => '/foo',
REQUEST_URI => '/foo',
}
),
);
my $fighter = Dancer2::Core::Response->new(
content => 'fighter',
status => 404,
);
route_doesnt_exist $_ for (@routes, $fighter);
get '/foo' => sub {'fighter'};
route_exists $_, "route $_ exists" for @routes;
$fighter->status(200);
push @routes, $fighter;
for (@routes) {
my $response = dancer_response $_;
isa_ok $response => 'Dancer2::Core::Response';
is $response->content => 'fighter';
}
response_content_is $_ => 'fighter', "response_content_is with $_" for @routes;
response_content_isnt $_ => 'platypus', "response_content_isnt with $_"
for @routes;
response_content_like $_ => qr/igh/ for @routes;
response_content_unlike $_ => qr/ought/ for @routes;
response_status_is $_ => 200 for @routes;
response_status_isnt $_ => 203 for @routes;
response_headers_include $_ => [ Server => "Perl Dancer2 $Dancer2::VERSION" ]
for @routes;
## Check parameters get through ok
get '/param' => sub { param('test') };
my $param_response =
dancer_response( GET => '/param', { params => { test => 'hello' } } );
is $param_response->content, 'hello', 'PARAMS get echoed by route';
post '/upload' => sub {
my $file = upload('test');
return $file->content;
};
## Check we can upload files
my $file_response = dancer_response(
POST => '/upload',
{ files =>
[ { filename => 'test.txt', name => 'test', data => 'testdata' } ]
}
);
is $file_response->content, 'testdata', 'file uploaded with supplied data';
my $temp = File::Temp->new;
print $temp 'testfile';
close($temp);
$file_response =
dancer_response( POST => '/upload',
{ files => [ { filename => $temp->filename, name => 'test' } ] } );
is $file_response->content, 'testfile', 'file uploaded with supplied filename';
## Check multiselect/multi parameters get through ok
get '/multi' => sub {
my $t = param('test');
return 'bad' if ref($t) ne 'ARRAY';
my $p = join( '', @$t );
return $p;
};
$param_response =
dancer_response( GET => '/multi',
{ params => { test => [ 'foo', 'bar' ] } } );
is $param_response->content, 'foobar',
'multi values for same key get echoed back';
my $russian_test =
decode( 'UTF-8',
uri_unescape("%D0%B8%D1%81%D0%BF%D1%8B%D1%82%D0%B0%D0%BD%D0%B8%D0%B5") );
$param_response =
dancer_response( GET => '/multi',
{ params => { test => [ 'test/', $russian_test ] } } );
is $param_response->content, 'test/' . encode( 'UTF-8', $russian_test ),
'multi utf8 value properly merge';
get '/headers' => sub {
join " : ", request->header('X-Sent-By'), request->cookies->{foo};
};
note "extra headers in request"; {
my $sent_by = 'Dancer2::Test';
my $headers_test = dancer_response( GET => '/headers',
{
headers => [
[ 'X-Sent-By' => $sent_by ],
[ 'Cookie' => "foo=bar" ],
],
}
);
is $headers_test->content, "$sent_by : bar",
"extra headers included in request";
}
|
