our
$AUTHORITY
=
'cpan:SUKRIA'
;
$Dancer::Handler::VERSION
=
'1.3521'
;
Dancer::Factory::Hook->instance->install_hooks(
qw/on_handler_exception/
);
sub
get_handler {
my
$handler
=
'Dancer::Handler::Standalone'
;
if
(
$ENV
{
'PLACK_ENV'
}) {
Dancer::Logger::core(
"PLACK_ENV is set ("
.
$ENV
{
'PLACK_ENV'
}.
") forcing PSGI handler"
);
setting(
'apphandler'
=>
'PSGI'
);
}
if
(
defined
setting(
'apphandler'
) ) {
$handler
=
'Dancer::Handler::'
. setting(
'apphandler'
);
}
my
(
$loaded
,
$error
) = Dancer::ModuleLoader->load(
$handler
);
raise
core_handler
=>
"Unable to load app handler `$handler': $error"
if
$error
;
Dancer::Logger::core(
'loading '
.
$handler
.
' handler'
);
return
$handler
->new;
}
sub
handle_request {
my
(
$self
,
$request
) =
@_
;
my
$ip_addr
=
$request
->remote_address ||
'-'
;
Dancer::SharedData->reset_all(
reset_vars
=> !
$request
->is_forward);
Dancer::Logger::core(
"request: "
.
$request
->method .
" "
.
$request
->path_info
.
" from $ip_addr"
);
Dancer::SharedData->request(
$request
);
$request
= Dancer::Serializer->process_request(
$request
)
if
Dancer::App->current->setting(
'serializer'
);
Dancer::Cookies->init;
Dancer::App->reload_apps
if
Dancer::Config::setting(
'auto_reload'
);
render_request(
$request
);
return
$self
->render_response();
}
sub
render_request {
my
$request
=
shift
;
my
$action
;
$action
=
try
{
Dancer::Renderer->render_file
|| Dancer::Renderer->render_action
|| Dancer::Renderer->render_autopage
|| Dancer::Renderer->render_error(404);
} continuation {
my
(
$continuation
) =
@_
;
$continuation
->isa(
'Dancer::Continuation::Halted'
)
||
$continuation
->isa(
'Dancer::Continuation::Route'
)
or
$continuation
->rethrow();
Dancer::Serializer->process_response(Dancer::SharedData->response);
}
catch
{
my
(
$exception
) =
@_
;
Dancer::Factory::Hook->execute_hooks(
'on_handler_exception'
,
$exception
);
Dancer::Logger::error(
sprintf
(
'request to %s %s crashed: %s'
,
$request
->method,
$request
->path_info,
$exception
)
);
Dancer::Error->new(
code
=> 500,
title
=>
"Runtime Error"
,
message
=>
"$exception"
,
exception
=>
$exception
,
)->render();
};
return
$action
;
}
sub
psgi_app {
my
$self
=
shift
;
sub
{
my
$env
=
shift
;
$self
->init_request_headers(
$env
);
my
$request
= Dancer::Request->new(
env
=>
$env
);
$self
->handle_request(
$request
);
};
}
sub
init_request_headers {
my
(
$self
,
$env
) =
@_
;
my
$psgi_headers
= HTTP::Headers->new(
map
{
(
my
$field
=
$_
) =~ s/^HTTPS?_//;
(
$field
=>
$env
->{
$_
});
}
grep
{/^(?:HTTP|CONTENT|COOKIE)/i}
keys
%$env
);
Dancer::SharedData->headers(
$psgi_headers
);
}
sub
render_response {
my
$self
=
shift
;
my
$response
= Dancer::SharedData->response();
my
$content
=
$response
->content;
unless
(
ref
(
$content
) eq
'GLOB'
) {
my
$charset
= setting(
'charset'
);
my
$ctype
=
$response
->header(
'Content-Type'
);
if
(
$charset
&&
$ctype
&& _is_text(
$ctype
) ) {
$content
= Encode::encode(
$charset
,
$content
)
unless
$response
->_already_encoded;
$response
->header(
'Content-Type'
=>
"$ctype; charset=$charset"
)
if
$ctype
!~ /
$charset
/;
}
if
(!
defined
$response
->header(
'Content-Length'
)) {
$response
->header(
'Content-Length'
=>
length
(
$content
) );
}
$content
= [
$content
];
}
else
{
if
( !
defined
$response
->header(
'Content-Length'
) ) {
my
$stat
=
stat
$content
;
$response
->header(
'Content-Length'
=>
$stat
->size );
}
}
$content
= [
''
]
if
(
defined
Dancer::SharedData->request
&& Dancer::SharedData->request->is_head() );
if
(
$response
->status =~ (/^[23]04$/ )) {
$content
= [
''
];
$response
->header(
'Content-Length'
=> 0);
}
Dancer::Logger::core(
"response: "
.
$response
->status);
my
$status
=
$response
->status();
my
$headers
=
$response
->headers_to_array();
if
(
ref
$response
->streamed and
ref
$response
->streamed eq
'CODE'
) {
return
$response
->streamed->(
$status
,
$headers
);
}
return
[
$status
,
$headers
,
$content
];
}
sub
_is_text {
my
(
$content_type
) =
@_
;
return
$content_type
=~ /(\bx(?:ht)?ml\b|text|json|javascript)/;
}
sub
print_banner {
if
(setting(
'startup_info'
)) {
my
$env
= setting(
'environment'
);
print
"== Entering the $env dance floor ...\n"
;
}
}
sub
dance { (
shift
)->start(
@_
) }
1;