line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Dancer::Handler; |
2
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:SUKRIA'; |
3
|
|
|
|
|
|
|
# ABSTRACT: Dancer request handler |
4
|
|
|
|
|
|
|
$Dancer::Handler::VERSION = '1.3521'; |
5
|
167
|
|
|
167
|
|
70475
|
use strict; |
|
167
|
|
|
|
|
396
|
|
|
167
|
|
|
|
|
4831
|
|
6
|
167
|
|
|
167
|
|
933
|
use warnings; |
|
167
|
|
|
|
|
421
|
|
|
167
|
|
|
|
|
3845
|
|
7
|
167
|
|
|
167
|
|
895
|
use Carp; |
|
167
|
|
|
|
|
437
|
|
|
167
|
|
|
|
|
8867
|
|
8
|
|
|
|
|
|
|
|
9
|
167
|
|
|
167
|
|
81039
|
use File::stat; |
|
167
|
|
|
|
|
1168857
|
|
|
167
|
|
|
|
|
874
|
|
10
|
167
|
|
|
167
|
|
11713
|
use HTTP::Headers; |
|
167
|
|
|
|
|
14488
|
|
|
167
|
|
|
|
|
3739
|
|
11
|
|
|
|
|
|
|
|
12
|
167
|
|
|
167
|
|
1753
|
use Dancer::Logger; |
|
167
|
|
|
|
|
455
|
|
|
167
|
|
|
|
|
3272
|
|
13
|
167
|
|
|
167
|
|
2221
|
use Dancer::GetOpt; |
|
167
|
|
|
|
|
414
|
|
|
167
|
|
|
|
|
3258
|
|
14
|
167
|
|
|
167
|
|
1793
|
use Dancer::SharedData; |
|
167
|
|
|
|
|
437
|
|
|
167
|
|
|
|
|
3076
|
|
15
|
167
|
|
|
167
|
|
2318
|
use Dancer::Renderer; |
|
167
|
|
|
|
|
433
|
|
|
167
|
|
|
|
|
5178
|
|
16
|
167
|
|
|
167
|
|
1059
|
use Dancer::Config 'setting'; |
|
167
|
|
|
|
|
460
|
|
|
167
|
|
|
|
|
7169
|
|
17
|
167
|
|
|
167
|
|
1095
|
use Dancer::ModuleLoader; |
|
167
|
|
|
|
|
477
|
|
|
167
|
|
|
|
|
4065
|
|
18
|
167
|
|
|
167
|
|
929
|
use Dancer::Exception qw(:all); |
|
167
|
|
|
|
|
416
|
|
|
167
|
|
|
|
|
20225
|
|
19
|
167
|
|
|
167
|
|
1251
|
use Dancer::Factory::Hook; |
|
167
|
|
|
|
|
436
|
|
|
167
|
|
|
|
|
4922
|
|
20
|
|
|
|
|
|
|
|
21
|
167
|
|
|
167
|
|
1082
|
use Encode; |
|
167
|
|
|
|
|
516
|
|
|
167
|
|
|
|
|
179535
|
|
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
Dancer::Factory::Hook->instance->install_hooks( |
24
|
|
|
|
|
|
|
qw/on_handler_exception/ |
25
|
|
|
|
|
|
|
); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# This is where we choose which application handler to return |
28
|
|
|
|
|
|
|
sub get_handler { |
29
|
4
|
|
|
4
|
0
|
14
|
my $handler = 'Dancer::Handler::Standalone'; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# force PSGI is PLACK_ENV is set |
32
|
4
|
100
|
|
|
|
15
|
if ($ENV{'PLACK_ENV'}) { |
33
|
1
|
|
|
|
|
11
|
Dancer::Logger::core("PLACK_ENV is set (".$ENV{'PLACK_ENV'}.") forcing PSGI handler"); |
34
|
1
|
|
|
|
|
6
|
setting('apphandler' => 'PSGI'); |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# if Plack is detected or set by conf, use the PSGI handler |
38
|
4
|
50
|
|
|
|
13
|
if ( defined setting('apphandler') ) { |
39
|
4
|
|
|
|
|
11
|
$handler = 'Dancer::Handler::' . setting('apphandler'); |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# load the app handler |
43
|
4
|
|
|
|
|
22
|
my ($loaded, $error) = Dancer::ModuleLoader->load($handler); |
44
|
4
|
100
|
|
|
|
34
|
raise core_handler => "Unable to load app handler `$handler': $error" if $error; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
# OK, everything's fine, load the handler |
47
|
3
|
|
|
|
|
17
|
Dancer::Logger::core('loading ' . $handler . ' handler'); |
48
|
3
|
|
|
|
|
17
|
return $handler->new; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
# handle an incoming request, process it and return a response |
52
|
|
|
|
|
|
|
sub handle_request { |
53
|
18
|
|
|
18
|
0
|
55
|
my ($self, $request) = @_; |
54
|
18
|
|
50
|
|
|
50
|
my $ip_addr = $request->remote_address || '-'; |
55
|
|
|
|
|
|
|
|
56
|
18
|
|
|
|
|
59
|
Dancer::SharedData->reset_all( reset_vars => !$request->is_forward); |
57
|
|
|
|
|
|
|
|
58
|
18
|
|
|
|
|
59
|
Dancer::Logger::core("request: " |
59
|
|
|
|
|
|
|
. $request->method . " " |
60
|
|
|
|
|
|
|
. $request->path_info |
61
|
|
|
|
|
|
|
. " from $ip_addr"); |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
# save the request object |
64
|
18
|
|
|
|
|
75
|
Dancer::SharedData->request($request); |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
# deserialize the request body if possible |
67
|
18
|
50
|
|
|
|
60
|
$request = Dancer::Serializer->process_request($request) |
68
|
|
|
|
|
|
|
if Dancer::App->current->setting('serializer'); |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
# read cookies from client |
71
|
|
|
|
|
|
|
|
72
|
18
|
|
|
|
|
88
|
Dancer::Cookies->init; |
73
|
|
|
|
|
|
|
|
74
|
18
|
50
|
|
|
|
250
|
Dancer::App->reload_apps if Dancer::Config::setting('auto_reload'); |
75
|
|
|
|
|
|
|
|
76
|
18
|
|
|
|
|
63
|
render_request($request); |
77
|
18
|
|
|
|
|
63
|
return $self->render_response(); |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
sub render_request { |
81
|
517
|
|
|
517
|
0
|
881
|
my $request = shift; |
82
|
517
|
|
|
|
|
745
|
my $action; |
83
|
|
|
|
|
|
|
$action = try { |
84
|
517
|
100
|
100
|
517
|
|
19448
|
Dancer::Renderer->render_file |
|
|
|
100
|
|
|
|
|
85
|
|
|
|
|
|
|
|| Dancer::Renderer->render_action |
86
|
|
|
|
|
|
|
|| Dancer::Renderer->render_autopage |
87
|
|
|
|
|
|
|
|| Dancer::Renderer->render_error(404); |
88
|
|
|
|
|
|
|
} continuation { |
89
|
|
|
|
|
|
|
# workflow exception (continuation) |
90
|
13
|
|
|
13
|
|
51
|
my ($continuation) = @_; |
91
|
13
|
50
|
66
|
|
|
84
|
$continuation->isa('Dancer::Continuation::Halted') |
92
|
|
|
|
|
|
|
|| $continuation->isa('Dancer::Continuation::Route') |
93
|
|
|
|
|
|
|
or $continuation->rethrow(); |
94
|
|
|
|
|
|
|
# special case for halted workflow continuation: still render the response |
95
|
13
|
|
|
|
|
48
|
Dancer::Serializer->process_response(Dancer::SharedData->response); |
96
|
|
|
|
|
|
|
} catch { |
97
|
32
|
|
|
32
|
|
125
|
my ($exception) = @_; |
98
|
32
|
|
|
|
|
129
|
Dancer::Factory::Hook->execute_hooks('on_handler_exception', $exception); |
99
|
32
|
|
|
|
|
255
|
Dancer::Logger::error( |
100
|
|
|
|
|
|
|
sprintf( |
101
|
|
|
|
|
|
|
'request to %s %s crashed: %s', |
102
|
|
|
|
|
|
|
$request->method, $request->path_info, $exception |
103
|
|
|
|
|
|
|
) |
104
|
|
|
|
|
|
|
); |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
# use stringification, to get exception message in case of a |
107
|
|
|
|
|
|
|
# Dancer::Exception |
108
|
32
|
|
|
|
|
272
|
Dancer::Error->new( |
109
|
|
|
|
|
|
|
code => 500, |
110
|
|
|
|
|
|
|
title => "Runtime Error", |
111
|
|
|
|
|
|
|
message => "$exception", |
112
|
|
|
|
|
|
|
exception => $exception, |
113
|
|
|
|
|
|
|
)->render(); |
114
|
517
|
|
|
|
|
4797
|
}; |
115
|
517
|
|
|
|
|
11167
|
return $action; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub psgi_app { |
119
|
2
|
|
|
2
|
0
|
17
|
my $self = shift; |
120
|
|
|
|
|
|
|
sub { |
121
|
1
|
|
|
1
|
|
16
|
my $env = shift; |
122
|
1
|
|
|
|
|
5
|
$self->init_request_headers($env); |
123
|
1
|
|
|
|
|
5
|
my $request = Dancer::Request->new(env => $env); |
124
|
1
|
|
|
|
|
5
|
$self->handle_request($request); |
125
|
2
|
|
|
|
|
16
|
}; |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
sub init_request_headers { |
129
|
0
|
|
|
0
|
0
|
0
|
my ($self, $env) = @_; |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
my $psgi_headers = HTTP::Headers->new( |
132
|
|
|
|
|
|
|
map { |
133
|
0
|
|
|
|
|
0
|
(my $field = $_) =~ s/^HTTPS?_//; |
134
|
0
|
|
|
|
|
0
|
($field => $env->{$_}); |
135
|
|
|
|
|
|
|
} |
136
|
0
|
|
|
|
|
0
|
grep {/^(?:HTTP|CONTENT|COOKIE)/i} keys %$env |
|
0
|
|
|
|
|
0
|
|
137
|
|
|
|
|
|
|
); |
138
|
0
|
|
|
|
|
0
|
Dancer::SharedData->headers($psgi_headers); |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
# render a PSGI-formatted response from a response built by |
142
|
|
|
|
|
|
|
# handle_request() |
143
|
|
|
|
|
|
|
sub render_response { |
144
|
25
|
|
|
25
|
0
|
72
|
my $self = shift; |
145
|
25
|
|
|
|
|
93
|
my $response = Dancer::SharedData->response(); |
146
|
|
|
|
|
|
|
|
147
|
25
|
|
|
|
|
84
|
my $content = $response->content; |
148
|
|
|
|
|
|
|
|
149
|
25
|
50
|
|
|
|
81
|
unless ( ref($content) eq 'GLOB' ) { |
150
|
25
|
|
|
|
|
82
|
my $charset = setting('charset'); |
151
|
25
|
|
|
|
|
90
|
my $ctype = $response->header('Content-Type'); |
152
|
|
|
|
|
|
|
|
153
|
25
|
50
|
66
|
|
|
967
|
if ( $charset && $ctype && _is_text($ctype) ) { |
|
|
|
66
|
|
|
|
|
154
|
3
|
50
|
|
|
|
12
|
$content = Encode::encode( $charset, $content ) unless $response->_already_encoded; |
155
|
3
|
100
|
|
|
|
138
|
$response->header( 'Content-Type' => "$ctype; charset=$charset" ) |
156
|
|
|
|
|
|
|
if $ctype !~ /$charset/; |
157
|
|
|
|
|
|
|
} |
158
|
25
|
100
|
|
|
|
179
|
if (!defined $response->header('Content-Length')) { |
159
|
167
|
|
|
167
|
|
1661
|
use bytes; # turn off character semantics |
|
167
|
|
|
|
|
442
|
|
|
167
|
|
|
|
|
1760
|
|
160
|
20
|
|
|
|
|
700
|
$response->header( 'Content-Length' => length($content) ); |
161
|
|
|
|
|
|
|
} |
162
|
25
|
|
|
|
|
981
|
$content = [$content]; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
else { |
165
|
0
|
0
|
|
|
|
0
|
if ( !defined $response->header('Content-Length') ) { |
166
|
0
|
|
|
|
|
0
|
my $stat = stat $content; |
167
|
0
|
|
|
|
|
0
|
$response->header( 'Content-Length' => $stat->size ); |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
# drop content if request is HEAD |
172
|
25
|
50
|
66
|
|
|
137
|
$content = [''] |
173
|
|
|
|
|
|
|
if ( defined Dancer::SharedData->request |
174
|
|
|
|
|
|
|
&& Dancer::SharedData->request->is_head() ); |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
# drop content AND content_length if response is 1xx or (2|3)04 |
177
|
25
|
50
|
|
|
|
86
|
if ($response->status =~ (/^[23]04$/ )) { |
178
|
0
|
|
|
|
|
0
|
$content = ['']; |
179
|
0
|
|
|
|
|
0
|
$response->header('Content-Length' => 0); |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
25
|
|
|
|
|
67
|
Dancer::Logger::core("response: " . $response->status); |
183
|
|
|
|
|
|
|
|
184
|
25
|
|
|
|
|
93
|
my $status = $response->status(); |
185
|
25
|
|
|
|
|
72
|
my $headers = $response->headers_to_array(); |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
# reverse streaming |
188
|
25
|
50
|
33
|
|
|
84
|
if ( ref $response->streamed and ref $response->streamed eq 'CODE' ) { |
189
|
0
|
|
|
|
|
0
|
return $response->streamed->( |
190
|
|
|
|
|
|
|
$status, $headers |
191
|
|
|
|
|
|
|
); |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
25
|
|
|
|
|
132
|
return [ $status, $headers, $content ]; |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
sub _is_text { |
198
|
8
|
|
|
8
|
|
1450
|
my ($content_type) = @_; |
199
|
8
|
|
|
|
|
69
|
return $content_type =~ /(\bx(?:ht)?ml\b|text|json|javascript)/; |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
# Fancy banner to print on startup |
203
|
|
|
|
|
|
|
sub print_banner { |
204
|
0
|
0
|
|
0
|
0
|
0
|
if (setting('startup_info')) { |
205
|
0
|
|
|
|
|
0
|
my $env = setting('environment'); |
206
|
0
|
|
|
|
|
0
|
print "== Entering the $env dance floor ...\n"; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
1
|
|
|
1
|
0
|
8
|
sub dance { (shift)->start(@_) } |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
1; |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
__END__ |