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
141
142
143
144
145
146
147
148
149
150
151
152
153
|
# who test the tester? We do!
use strict;
use warnings;
use File::Spec;
use File::Basename qw/dirname/;
use Ref::Util qw<is_arrayref>;
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 => 50;
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 !is_arrayref($t);
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";
sub extra_headers {
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";
}
note "Run extra_headers test with XS_HTTP_COOKIES"
if $Dancer2::Core::Request::XS_HTTP_COOKIES;
extra_headers();
SKIP: {
skip "HTTP::XSCookies not installed", 1
if !$Dancer2::Core::Request::XS_HTTP_COOKIES;
note "Run extra_headers test without XS_HTTP_COOKIES";
$Dancer2::Core::Request::XS_HTTP_COOKIES = 0;
extra_headers();
}
|
