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.3514_04'; # TRIAL |
5
|
|
|
|
|
|
|
$Dancer::Handler::VERSION = '1.351404'; |
6
|
168
|
|
|
168
|
|
60637
|
use strict; |
|
168
|
|
|
|
|
317
|
|
|
168
|
|
|
|
|
3975
|
|
7
|
168
|
|
|
168
|
|
716
|
use warnings; |
|
168
|
|
|
|
|
308
|
|
|
168
|
|
|
|
|
3186
|
|
8
|
168
|
|
|
168
|
|
700
|
use Carp; |
|
168
|
|
|
|
|
288
|
|
|
168
|
|
|
|
|
7801
|
|
9
|
|
|
|
|
|
|
|
10
|
168
|
|
|
168
|
|
64062
|
use File::stat; |
|
168
|
|
|
|
|
963183
|
|
|
168
|
|
|
|
|
791
|
|
11
|
168
|
|
|
168
|
|
9970
|
use HTTP::Headers; |
|
168
|
|
|
|
|
12022
|
|
|
168
|
|
|
|
|
3104
|
|
12
|
|
|
|
|
|
|
|
13
|
168
|
|
|
168
|
|
1412
|
use Dancer::Logger; |
|
168
|
|
|
|
|
318
|
|
|
168
|
|
|
|
|
2583
|
|
14
|
168
|
|
|
168
|
|
1744
|
use Dancer::GetOpt; |
|
168
|
|
|
|
|
313
|
|
|
168
|
|
|
|
|
2643
|
|
15
|
168
|
|
|
168
|
|
1496
|
use Dancer::SharedData; |
|
168
|
|
|
|
|
365
|
|
|
168
|
|
|
|
|
2701
|
|
16
|
168
|
|
|
168
|
|
1871
|
use Dancer::Renderer; |
|
168
|
|
|
|
|
306
|
|
|
168
|
|
|
|
|
3565
|
|
17
|
168
|
|
|
168
|
|
792
|
use Dancer::Config 'setting'; |
|
168
|
|
|
|
|
399
|
|
|
168
|
|
|
|
|
6809
|
|
18
|
168
|
|
|
168
|
|
908
|
use Dancer::ModuleLoader; |
|
168
|
|
|
|
|
354
|
|
|
168
|
|
|
|
|
3365
|
|
19
|
168
|
|
|
168
|
|
764
|
use Dancer::Exception qw(:all); |
|
168
|
|
|
|
|
324
|
|
|
168
|
|
|
|
|
16861
|
|
20
|
168
|
|
|
168
|
|
1083
|
use Dancer::Factory::Hook; |
|
168
|
|
|
|
|
318
|
|
|
168
|
|
|
|
|
3726
|
|
21
|
|
|
|
|
|
|
|
22
|
168
|
|
|
168
|
|
847
|
use Encode; |
|
168
|
|
|
|
|
364
|
|
|
168
|
|
|
|
|
143017
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
Dancer::Factory::Hook->instance->install_hooks( |
25
|
|
|
|
|
|
|
qw/on_handler_exception/ |
26
|
|
|
|
|
|
|
); |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# This is where we choose which application handler to return |
29
|
|
|
|
|
|
|
sub get_handler { |
30
|
4
|
|
|
4
|
0
|
15
|
my $handler = 'Dancer::Handler::Standalone'; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
# force PSGI is PLACK_ENV is set |
33
|
4
|
100
|
|
|
|
11
|
if ($ENV{'PLACK_ENV'}) { |
34
|
1
|
|
|
|
|
6
|
Dancer::Logger::core("PLACK_ENV is set (".$ENV{'PLACK_ENV'}.") forcing PSGI handler"); |
35
|
1
|
|
|
|
|
3
|
setting('apphandler' => 'PSGI'); |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
# if Plack is detected or set by conf, use the PSGI handler |
39
|
4
|
50
|
|
|
|
10
|
if ( defined setting('apphandler') ) { |
40
|
4
|
|
|
|
|
8
|
$handler = 'Dancer::Handler::' . setting('apphandler'); |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# load the app handler |
44
|
4
|
|
|
|
|
16
|
my ($loaded, $error) = Dancer::ModuleLoader->load($handler); |
45
|
4
|
100
|
|
|
|
15
|
raise core_handler => "Unable to load app handler `$handler': $error" if $error; |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
# OK, everything's fine, load the handler |
48
|
3
|
|
|
|
|
14
|
Dancer::Logger::core('loading ' . $handler . ' handler'); |
49
|
3
|
|
|
|
|
13
|
return $handler->new; |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
# handle an incoming request, process it and return a response |
53
|
|
|
|
|
|
|
sub handle_request { |
54
|
18
|
|
|
18
|
0
|
48
|
my ($self, $request) = @_; |
55
|
18
|
|
50
|
|
|
38
|
my $ip_addr = $request->remote_address || '-'; |
56
|
|
|
|
|
|
|
|
57
|
18
|
|
|
|
|
164
|
Dancer::SharedData->reset_all( reset_vars => !$request->is_forward); |
58
|
|
|
|
|
|
|
|
59
|
18
|
|
|
|
|
36
|
Dancer::Logger::core("request: " |
60
|
|
|
|
|
|
|
. $request->method . " " |
61
|
|
|
|
|
|
|
. $request->path_info |
62
|
|
|
|
|
|
|
. " from $ip_addr"); |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
# save the request object |
65
|
18
|
|
|
|
|
53
|
Dancer::SharedData->request($request); |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
# deserialize the request body if possible |
68
|
18
|
50
|
|
|
|
45
|
$request = Dancer::Serializer->process_request($request) |
69
|
|
|
|
|
|
|
if Dancer::App->current->setting('serializer'); |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
# read cookies from client |
72
|
|
|
|
|
|
|
|
73
|
18
|
|
|
|
|
56
|
Dancer::Cookies->init; |
74
|
|
|
|
|
|
|
|
75
|
18
|
50
|
|
|
|
43
|
Dancer::App->reload_apps if Dancer::Config::setting('auto_reload'); |
76
|
|
|
|
|
|
|
|
77
|
18
|
|
|
|
|
43
|
render_request($request); |
78
|
18
|
|
|
|
|
49
|
return $self->render_response(); |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub render_request { |
82
|
520
|
|
|
520
|
0
|
796
|
my $request = shift; |
83
|
520
|
|
|
|
|
734
|
my $action; |
84
|
|
|
|
|
|
|
$action = try { |
85
|
520
|
100
|
100
|
520
|
|
17462
|
Dancer::Renderer->render_file |
|
|
|
100
|
|
|
|
|
86
|
|
|
|
|
|
|
|| Dancer::Renderer->render_action |
87
|
|
|
|
|
|
|
|| Dancer::Renderer->render_autopage |
88
|
|
|
|
|
|
|
|| Dancer::Renderer->render_error(404); |
89
|
|
|
|
|
|
|
} continuation { |
90
|
|
|
|
|
|
|
# workflow exception (continuation) |
91
|
13
|
|
|
13
|
|
27
|
my ($continuation) = @_; |
92
|
13
|
50
|
66
|
|
|
53
|
$continuation->isa('Dancer::Continuation::Halted') |
93
|
|
|
|
|
|
|
|| $continuation->isa('Dancer::Continuation::Route') |
94
|
|
|
|
|
|
|
or $continuation->rethrow(); |
95
|
|
|
|
|
|
|
# special case for halted workflow continuation: still render the response |
96
|
13
|
|
|
|
|
47
|
Dancer::Serializer->process_response(Dancer::SharedData->response); |
97
|
|
|
|
|
|
|
} catch { |
98
|
32
|
|
|
32
|
|
75
|
my ($exception) = @_; |
99
|
32
|
|
|
|
|
109
|
Dancer::Factory::Hook->execute_hooks('on_handler_exception', $exception); |
100
|
32
|
|
|
|
|
193
|
Dancer::Logger::error( |
101
|
|
|
|
|
|
|
sprintf( |
102
|
|
|
|
|
|
|
'request to %s %s crashed: %s', |
103
|
|
|
|
|
|
|
$request->method, $request->path_info, $exception |
104
|
|
|
|
|
|
|
) |
105
|
|
|
|
|
|
|
); |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
# use stringification, to get exception message in case of a |
108
|
|
|
|
|
|
|
# Dancer::Exception |
109
|
32
|
|
|
|
|
223
|
Dancer::Error->new( |
110
|
|
|
|
|
|
|
code => 500, |
111
|
|
|
|
|
|
|
title => "Runtime Error", |
112
|
|
|
|
|
|
|
message => "$exception", |
113
|
|
|
|
|
|
|
exception => $exception, |
114
|
|
|
|
|
|
|
)->render(); |
115
|
520
|
|
|
|
|
4640
|
}; |
116
|
520
|
|
|
|
|
10173
|
return $action; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub psgi_app { |
120
|
2
|
|
|
2
|
0
|
12
|
my $self = shift; |
121
|
|
|
|
|
|
|
sub { |
122
|
1
|
|
|
1
|
|
13
|
my $env = shift; |
123
|
1
|
|
|
|
|
4
|
$self->init_request_headers($env); |
124
|
1
|
|
|
|
|
3
|
my $request = Dancer::Request->new(env => $env); |
125
|
1
|
|
|
|
|
3
|
$self->handle_request($request); |
126
|
2
|
|
|
|
|
11
|
}; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub init_request_headers { |
130
|
0
|
|
|
0
|
0
|
0
|
my ($self, $env) = @_; |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
my $psgi_headers = HTTP::Headers->new( |
133
|
|
|
|
|
|
|
map { |
134
|
0
|
|
|
|
|
0
|
(my $field = $_) =~ s/^HTTPS?_//; |
135
|
0
|
|
|
|
|
0
|
($field => $env->{$_}); |
136
|
|
|
|
|
|
|
} |
137
|
0
|
|
|
|
|
0
|
grep {/^(?:HTTP|CONTENT|COOKIE)/i} keys %$env |
|
0
|
|
|
|
|
0
|
|
138
|
|
|
|
|
|
|
); |
139
|
0
|
|
|
|
|
0
|
Dancer::SharedData->headers($psgi_headers); |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
# render a PSGI-formatted response from a response built by |
143
|
|
|
|
|
|
|
# handle_request() |
144
|
|
|
|
|
|
|
sub render_response { |
145
|
25
|
|
|
25
|
0
|
58
|
my $self = shift; |
146
|
25
|
|
|
|
|
60
|
my $response = Dancer::SharedData->response(); |
147
|
|
|
|
|
|
|
|
148
|
25
|
|
|
|
|
53
|
my $content = $response->content; |
149
|
|
|
|
|
|
|
|
150
|
25
|
50
|
|
|
|
58
|
unless ( ref($content) eq 'GLOB' ) { |
151
|
25
|
|
|
|
|
78
|
my $charset = setting('charset'); |
152
|
25
|
|
|
|
|
56
|
my $ctype = $response->header('Content-Type'); |
153
|
|
|
|
|
|
|
|
154
|
25
|
50
|
66
|
|
|
717
|
if ( $charset && $ctype && _is_text($ctype) ) { |
|
|
|
66
|
|
|
|
|
155
|
3
|
50
|
|
|
|
8
|
$content = Encode::encode( $charset, $content ) unless $response->_already_encoded; |
156
|
3
|
100
|
|
|
|
107
|
$response->header( 'Content-Type' => "$ctype; charset=$charset" ) |
157
|
|
|
|
|
|
|
if $ctype !~ /$charset/; |
158
|
|
|
|
|
|
|
} |
159
|
25
|
100
|
|
|
|
120
|
if (!defined $response->header('Content-Length')) { |
160
|
168
|
|
|
168
|
|
1285
|
use bytes; # turn off character semantics |
|
168
|
|
|
|
|
348
|
|
|
168
|
|
|
|
|
1215
|
|
161
|
20
|
|
|
|
|
501
|
$response->header( 'Content-Length' => length($content) ); |
162
|
|
|
|
|
|
|
} |
163
|
25
|
|
|
|
|
725
|
$content = [$content]; |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
else { |
166
|
0
|
0
|
|
|
|
0
|
if ( !defined $response->header('Content-Length') ) { |
167
|
0
|
|
|
|
|
0
|
my $stat = stat $content; |
168
|
0
|
|
|
|
|
0
|
$response->header( 'Content-Length' => $stat->size ); |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
# drop content if request is HEAD |
173
|
25
|
50
|
66
|
|
|
90
|
$content = [''] |
174
|
|
|
|
|
|
|
if ( defined Dancer::SharedData->request |
175
|
|
|
|
|
|
|
&& Dancer::SharedData->request->is_head() ); |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
# drop content AND content_length if response is 1xx or (2|3)04 |
178
|
25
|
50
|
|
|
|
57
|
if ($response->status =~ (/^[23]04$/ )) { |
179
|
0
|
|
|
|
|
0
|
$content = ['']; |
180
|
0
|
|
|
|
|
0
|
$response->header('Content-Length' => 0); |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
25
|
|
|
|
|
65
|
Dancer::Logger::core("response: " . $response->status); |
184
|
|
|
|
|
|
|
|
185
|
25
|
|
|
|
|
67
|
my $status = $response->status(); |
186
|
25
|
|
|
|
|
55
|
my $headers = $response->headers_to_array(); |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
# reverse streaming |
189
|
25
|
50
|
33
|
|
|
62
|
if ( ref $response->streamed and ref $response->streamed eq 'CODE' ) { |
190
|
0
|
|
|
|
|
0
|
return $response->streamed->( |
191
|
|
|
|
|
|
|
$status, $headers |
192
|
|
|
|
|
|
|
); |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
25
|
|
|
|
|
93
|
return [ $status, $headers, $content ]; |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
sub _is_text { |
199
|
8
|
|
|
8
|
|
1134
|
my ($content_type) = @_; |
200
|
8
|
|
|
|
|
68
|
return $content_type =~ /(\bx(?:ht)?ml\b|text|json|javascript)/; |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
# Fancy banner to print on startup |
204
|
|
|
|
|
|
|
sub print_banner { |
205
|
0
|
0
|
|
0
|
0
|
0
|
if (setting('startup_info')) { |
206
|
0
|
|
|
|
|
0
|
my $env = setting('environment'); |
207
|
0
|
|
|
|
|
0
|
print "== Entering the $env dance floor ...\n"; |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
|
211
|
1
|
|
|
1
|
0
|
6
|
sub dance { (shift)->start(@_) } |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
1; |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
__END__ |