$Dancer2::Core::App::VERSION
=
'1.1.2'
;
use
Ref::Util
qw< is_ref is_arrayref is_globref is_scalarref is_regexpref >
;
our
$EVAL_SHIM
;
$EVAL_SHIM
||=
sub
{
my
$code
=
shift
;
$code
->(
@_
);
};
with
qw<
Dancer2::Core::Role::ConfigReader
>
;
sub
supported_engines { [
qw<logger serializer session template>
] }
sub
with_plugins {
my
(
$self
,
@plugins
) =
@_
;
return
map
$self
->_with_plugin(
$_
),
@plugins
;
}
sub
_with_plugin {
my
(
$self
,
$plugin
) =
@_
;
if
( is_ref(
$plugin
) ) {
if
(
my
(
$already
) =
grep
{
ref
(
$plugin
) eq
ref
$_
; } @{
$self
->plugins } ) {
die
"trying to load two different objects for plugin "
.
ref
$plugin
if
refaddr(
$plugin
) != refaddr
$already
;
}
else
{
push
@{
$self
->plugins },
$plugin
;
}
return
$plugin
;
}
if
(
$plugin
!~ s/^\+// ) {
$plugin
=~ s/^(?!Dancer2::Plugin::)/Dancer2::Plugin::/;
}
if
(
my
(
$already
) =
grep
{
$plugin
eq
ref
$_
} @{
$self
->plugins } ) {
return
$already
;
}
push
@{
$self
->plugins },
$plugin
= use_module(
$plugin
)->new(
app
=>
$self
);
return
$plugin
;
}
sub
with_plugin {
my
(
$self
,
$plugin
) =
@_
;
croak
"expected a single argument"
unless
@_
== 2;
(
$self
->with_plugins(
$plugin
) )[0];
}
has
_factory
=> (
is
=>
'ro'
,
isa
=> InstanceOf[
'Dancer2::Core::Factory'
],
lazy
=> 1,
default
=>
sub
{ Dancer2::Core::Factory->new },
);
has
logger_engine
=> (
is
=>
'ro'
,
isa
=> ConsumerOf[
'Dancer2::Core::Role::Logger'
],
lazy
=> 1,
builder
=>
'_build_logger_engine'
,
writer
=>
'set_logger_engine'
,
);
has
session_engine
=> (
is
=>
'ro'
,
isa
=> ConsumerOf[
'Dancer2::Core::Role::SessionFactory'
],
lazy
=> 1,
builder
=>
'_build_session_engine'
,
writer
=>
'set_session_engine'
,
);
has
template_engine
=> (
is
=>
'ro'
,
isa
=> ConsumerOf[
'Dancer2::Core::Role::Template'
],
lazy
=> 1,
builder
=>
'_build_template_engine'
,
writer
=>
'set_template_engine'
,
);
has
serializer_engine
=> (
is
=>
'ro'
,
isa
=> ConsumerOf[
'Dancer2::Core::Role::Serializer'
],
lazy
=> 1,
builder
=>
'_build_serializer_engine'
,
writer
=>
'set_serializer_engine'
,
predicate
=>
'has_serializer_engine'
,
);
has
'+local_triggers'
=> (
default
=>
sub
{
my
$self
=
shift
;
my
$triggers
= {
views
=>
sub
{
my
$self
=
shift
;
my
$value
=
shift
;
$self
->template_engine->views(
$value
);
},
layout
=>
sub
{
my
$self
=
shift
;
my
$value
=
shift
;
$self
->template_engine->layout(
$value
);
},
layout_dir
=>
sub
{
my
$self
=
shift
;
my
$value
=
shift
;
$self
->template_engine->layout_dir(
$value
);
},
log
=>
sub
{
my
(
$self
,
$value
,
$config
) =
@_
;
$self
->logger_engine->log_level(
$value
);
},
};
foreach
my
$engine
( @{
$self
->supported_engines } ) {
$triggers
->{
$engine
} =
sub
{
my
$self
=
shift
;
my
$value
=
shift
;
my
$config
=
shift
;
is_ref(
$value
) and
return
$value
;
my
$build_method
=
"_build_${engine}_engine"
;
my
$setter_method
=
"set_${engine}_engine"
;
my
$engine_instance
=
$self
->
$build_method
(
$value
,
$config
);
$self
->
$setter_method
(
$engine_instance
);
return
$engine_instance
;
};
}
return
$triggers
;
},
);
sub
_build_logger_engine {
my
$self
=
shift
;
my
$value
=
shift
;
my
$config
=
shift
;
defined
$config
or
$config
=
$self
->config;
defined
$value
or
$value
=
$config
->{logger};
is_ref(
$value
) and
return
$value
;
defined
$value
or
$value
=
'console'
;
is_module_name(
$value
)
or croak
"Cannot load logger engine '$value': illegal module name"
;
my
$engine_options
=
$self
->_get_config_for_engine(
logger
=>
$value
,
$config
);
my
$logger
=
$self
->_factory->create(
logger
=>
$value
,
%{
$engine_options
},
location
=>
$self
->config_location,
environment
=>
$self
->environment,
app_name
=>
$self
->name,
postponed_hooks
=>
$self
->postponed_hooks
);
exists
$config
->{
log
} and
$logger
->log_level(
$config
->{
log
});
return
$logger
;
}
sub
_build_session_engine {
my
$self
=
shift
;
my
$value
=
shift
;
my
$config
=
shift
;
defined
$config
or
$config
=
$self
->config;
defined
$value
or
$value
=
$config
->{
'session'
} ||
'simple'
;
is_ref(
$value
) and
return
$value
;
is_module_name(
$value
)
or croak
"Cannot load session engine '$value': illegal module name"
;
my
$engine_options
=
$self
->_get_config_for_engine(
session
=>
$value
,
$config
);
Scalar::Util::weaken(
my
$weak_self
=
$self
);
return
$self
->_factory->create(
session
=>
$value
,
session_dir
=> path(
$self
->config->{appdir},
'sessions'
),
%{
$engine_options
},
postponed_hooks
=>
$self
->postponed_hooks,
log_cb
=>
sub
{
$weak_self
->
log
(
@_
) },
);
}
sub
_build_template_engine {
my
$self
=
shift
;
my
$value
=
shift
;
my
$config
=
shift
;
defined
$config
or
$config
=
$self
->config;
defined
$value
or
$value
=
$config
->{
'template'
};
defined
$value
or
return
;
is_ref(
$value
) and
return
$value
;
is_module_name(
$value
)
or croak
"Cannot load template engine '$value': illegal module name"
;
my
$engine_options
=
$self
->_get_config_for_engine(
template
=>
$value
,
$config
);
my
$engine_attrs
= {
config
=>
$engine_options
,
layout
=>
$config
->{layout},
layout_dir
=> (
$config
->{layout_dir} ||
'layouts'
),
views
=>
$config
->{views},
};
Scalar::Util::weaken(
my
$weak_self
=
$self
);
return
$self
->_factory->create(
template
=>
$value
,
%{
$engine_attrs
},
postponed_hooks
=>
$self
->postponed_hooks,
log_cb
=>
sub
{
$weak_self
->
log
(
@_
) },
);
}
sub
_build_serializer_engine {
my
$self
=
shift
;
my
$value
=
shift
;
my
$config
=
shift
;
defined
$config
or
$config
=
$self
->config;
defined
$value
or
$value
=
$config
->{serializer};
defined
$value
or
return
;
is_ref(
$value
) and
return
$value
;
my
$engine_options
=
$self
->_get_config_for_engine(
serializer
=>
$value
,
$config
);
Scalar::Util::weaken(
my
$weak_self
=
$self
);
return
$self
->_factory->create(
serializer
=>
$value
,
config
=>
$engine_options
,
postponed_hooks
=>
$self
->postponed_hooks,
log_cb
=>
sub
{
$weak_self
->
log
(
@_
) },
);
}
sub
_get_config_for_engine {
my
$self
=
shift
;
my
$engine
=
shift
;
my
$name
=
shift
;
my
$config
=
shift
;
defined
$config
->{
'engines'
} &&
defined
$config
->{
'engines'
}{
$engine
}
or
return
{};
my
$engine_config
= {};
foreach
my
$engine_name
(
$name
, Dancer2::Core::camelize(
$name
) ) {
if
(
defined
$config
->{
'engines'
}{
$engine
}{
$engine_name
} ) {
$engine_config
=
$config
->{
'engines'
}{
$engine
}{
$engine_name
};
last
;
}
}
return
$engine_config
;
}
has
postponed_hooks
=> (
is
=>
'ro'
,
isa
=> HashRef,
default
=>
sub
{ {} },
);
has
plugins
=> (
is
=>
'rw'
,
isa
=> ArrayRef,
default
=>
sub
{ [] },
);
has
route_handlers
=> (
is
=>
'rw'
,
isa
=> ArrayRef,
default
=>
sub
{ [] },
);
has
name
=> (
is
=>
'ro'
,
isa
=> Str,
default
=>
sub
{ (
caller
(1))[0] },
);
has
request
=> (
is
=>
'ro'
,
isa
=> InstanceOf[
'Dancer2::Core::Request'
],
writer
=>
'_set_request'
,
clearer
=>
'clear_request'
,
predicate
=>
'has_request'
,
);
sub
set_request {
my
(
$self
,
$request
,
$defined_engines
) =
@_
;
$defined_engines
||=
$self
->defined_engines;
$self
->_set_request(
$request
);
Scalar::Util::weaken(
my
$weak_request
=
$request
);
$_
->set_request(
$weak_request
)
for
@{
$defined_engines
};
}
has
response
=> (
is
=>
'ro'
,
isa
=> InstanceOf[
'Dancer2::Core::Response'
],
lazy
=> 1,
writer
=>
'set_response'
,
clearer
=>
'clear_response'
,
builder
=>
'_build_response'
,
predicate
=>
'has_response'
,
);
has
with_return
=> (
is
=>
'ro'
,
predicate
=> 1,
writer
=>
'set_with_return'
,
clearer
=>
'clear_with_return'
,
);
has
session
=> (
is
=>
'ro'
,
isa
=> InstanceOf[
'Dancer2::Core::Session'
],
lazy
=> 1,
builder
=>
'_build_session'
,
writer
=>
'set_session'
,
clearer
=>
'clear_session'
,
predicate
=>
'_has_session'
,
);
around
_build_config
=>
sub
{
my
(
$orig
,
$self
) =
@_
;
my
$config
=
$self
->
$orig
;
if
(
$config
&&
$config
->{
'engines'
} ) {
$self
->_validate_engine(
$_
)
for
keys
%{
$config
->{
'engines'
} };
}
return
$config
;
};
sub
_build_response {
my
$self
=
shift
;
return
Dancer2::Core::Response->new(
server_tokens
=> !
$self
->config->{
'no_server_tokens'
},
$self
->has_serializer_engine
? (
serializer
=>
$self
->serializer_engine )
: (),
);
}
sub
_build_session {
my
$self
=
shift
;
my
$session
;
my
$engine
=
$self
->session_engine;
if
( !
$self
->has_destroyed_session ) {
my
$session_id
;
my
$session_cookie
=
$self
->cookie(
$engine
->cookie_name );
defined
$session_cookie
and
$session_id
=
$session_cookie
->value;
if
(
defined
$session_id
) {
eval
{
$EVAL_SHIM
->(
sub
{
$session
=
$engine
->retrieve(
id
=>
$session_id
);
});
1;
}
or
do
{
my
$err
= $@ ||
"Zombie Error"
;
if
(
$err
!~ /Unable to retrieve session/ ) {
croak
"Failed to retrieve session: $err"
}
else
{
}
};
}
}
return
$session
||=
$engine
->create();
}
sub
has_session {
my
$self
=
shift
;
my
$engine
=
$self
->session_engine;
return
$self
->_has_session
|| (
$self
->cookie(
$engine
->cookie_name )
&& !
$self
->has_destroyed_session );
}
has
destroyed_session
=> (
is
=>
'ro'
,
isa
=> InstanceOf [
'Dancer2::Core::Session'
],
predicate
=> 1,
writer
=>
'set_destroyed_session'
,
clearer
=>
'clear_destroyed_session'
,
);
has
'prep_apps'
=> (
'is'
=>
'ro'
,
'isa'
=> ArrayRef,
'default'
=>
sub
{ [] },
);
sub
find_plugin {
my
(
$self
,
$name
) =
@_
;
my
$plugin
= List::Util::first {
ref
(
$_
) eq
$name
} @{
$self
->plugins };
$plugin
or
return
;
return
$plugin
;
}
sub
destroy_session {
my
$self
=
shift
;
my
$engine
=
$self
->session_engine;
my
$session
=
$self
->session;
$session
->expires(-86400);
$engine
->destroy(
id
=>
$session
->id );
$self
->set_destroyed_session(
$session
);
$self
->clear_session;
$_
->clear_session
for
@{
$self
->defined_engines };
return
;
}
sub
setup_session {
my
$self
=
shift
;
for
my
$engine
( @{
$self
->defined_engines } ) {
$self
->has_session ?
$engine
->set_session(
$self
->session ) :
$engine
->clear_session;
}
}
sub
change_session_id {
my
$self
=
shift
;
my
$session
=
$self
->session;
my
$engine
=
$self
->session_engine;
if
(
$engine
->can(
'_change_id'
)) {
$engine
->change_id(
session
=>
$session
);
}
else
{
my
%data
= %{
$session
->data};
$self
->destroy_session;
$session
=
$self
->session;
while
(
my
(
$key
,
$value
) =
each
%data
) {
$session
->
write
(
$key
=>
$value
)
unless
$key
eq
'id'
;
}
$self
->clear_destroyed_session;
}
return
$session
->id;
}
has
prefix
=> (
is
=>
'rw'
,
isa
=> Maybe [Dancer2Prefix],
predicate
=> 1,
coerce
=>
sub
{
my
$prefix
=
shift
;
defined
(
$prefix
) and
$prefix
eq
"/"
and
return
;
return
$prefix
;
},
);
has
routes
=> (
is
=>
'rw'
,
isa
=> HashRef,
default
=>
sub
{
{
get
=> [],
head
=> [],
post
=> [],
put
=> [],
del
=> [],
options
=> [],
};
},
);
has
'route_names'
=> (
'is'
=>
'rw'
,
'isa'
=> HashRef,
'default'
=>
sub
{ {} },
);
around
add_hook
=>
sub
{
my
$orig
=
shift
;
my
$self
=
shift
;
my
(
$package
,
$file
,
$line
) =
caller
(4);
my
$add_hook_caller
= [
$package
,
$file
,
$line
];
my
(
$hook
) =
@_
;
my
$name
=
$hook
->name;
my
$hook_aliases
=
$self
->all_hook_aliases;
defined
$hook_aliases
->{
$name
} and
$name
=
$hook_aliases
->{
$name
};
$hook
->name(
$name
);
$self
->has_hook(
$name
) and
return
$self
->
$orig
(
@_
);
my
(
$hookable_type
,
$hookable_name
,
$hook_name
) =
split
( /\./,
$name
);
(
defined
$hookable_name
&&
defined
$hook_name
)
or croak
"Invalid hook name `$name'"
;
grep
/^
$hookable_type
$/,
qw(core engine handler plugin)
or croak
"Unknown hook type `$hookable_type'"
;
foreach
my
$hookable
(
$self
->hook_candidates ) {
$hookable
->has_hook(
$name
) and
$hookable
->add_hook(
@_
);
}
my
$postponed_hooks
=
$self
->postponed_hooks;
$postponed_hooks
->{
$hookable_type
}{
$hookable_name
} ||= {};
$postponed_hooks
->{
$hookable_type
}{
$hookable_name
}{
$name
} ||= {};
$postponed_hooks
->{
$hookable_type
}{
$hookable_name
}{
$name
}{hook} =
$hook
;
$postponed_hooks
->{
$hookable_type
}{
$hookable_name
}{
$name
}{
caller
} =
$add_hook_caller
;
};
around
execute_hook
=>
sub
{
my
$orig
=
shift
;
my
$self
=
shift
;
local
$Dancer2::Core::Route::REQUEST
=
$self
->request;
local
$Dancer2::Core::Route::RESPONSE
=
$self
->response;
my
(
$hook
,
@args
) =
@_
;
if
( !
$self
->has_hook(
$hook
) ) {
foreach
my
$cand
(
$self
->hook_candidates ) {
$cand
->has_hook(
$hook
) and
return
$cand
->execute_hook(
@_
);
}
}
return
$self
->
$orig
(
@_
);
};
sub
_build_default_config {
my
$self
=
shift
;
my
$public
=
$ENV
{DANCER_PUBLIC} || path(
$self
->location,
'public'
);
return
{
content_type
=> (
$ENV
{DANCER_CONTENT_TYPE} ||
'text/html'
),
charset
=> (
$ENV
{DANCER_CHARSET} ||
''
),
logger
=> (
$ENV
{DANCER_LOGGER} ||
'console'
),
views
=> (
$ENV
{DANCER_VIEWS}
|| path(
$self
->location,
'views'
) ),
environment
=>
$self
->environment,
appdir
=>
$self
->location,
public_dir
=>
$public
,
template
=>
'Tiny'
,
route_handlers
=> [
[
AutoPage
=> 1
],
],
};
}
sub
_init_hooks {
my
$self
=
shift
;
Scalar::Util::weaken(
my
$app
=
$self
);
$self
->add_hook(
Dancer2::Core::Hook->new(
name
=>
'core.app.after_request'
,
code
=>
sub
{
my
$response
=
$Dancer2::Core::Route::RESPONSE
;
my
$engine
=
$app
->session_engine;
defined
$engine
or
return
;
if
(
$app
->has_session ) {
my
$session
;
if
(
$app
->_has_session ) {
$session
=
$app
->session;
$session
->is_dirty and
$engine
->flush(
session
=>
$session
);
}
else
{
my
$cookie
=
$app
->cookie(
$engine
->cookie_name );
my
$session_id
=
$cookie
->value;
$session
= Dancer2::Core::Session->new(
id
=>
$session_id
);
}
$engine
->set_cookie_header(
response
=>
$response
,
session
=>
$session
);
}
elsif
(
$app
->has_destroyed_session ) {
my
$session
=
$app
->destroyed_session;
$engine
->set_cookie_header(
response
=>
$response
,
session
=>
$session
,
destroyed
=> 1
);
}
},
)
);
}
sub
supported_hooks {
qw/
core.app.before_request
core.app.after_request
core.app.route_exception
core.app.before_file_render
core.app.after_file_render
core.error.before
core.error.after
core.error.init
/
;
}
sub
hook_aliases {
my
$self
=
shift
;
$self
->{
'hook_aliases'
} ||= {
before
=>
'core.app.before_request'
,
before_request
=>
'core.app.before_request'
,
after
=>
'core.app.after_request'
,
after_request
=>
'core.app.after_request'
,
init_error
=>
'core.error.init'
,
before_error
=>
'core.error.before'
,
after_error
=>
'core.error.after'
,
on_route_exception
=>
'core.app.route_exception'
,
before_file_render
=>
'core.app.before_file_render'
,
after_file_render
=>
'core.app.after_file_render'
,
before_handler_file_render
=>
'handler.file.before_render'
,
after_handler_file_render
=>
'handler.file.after_render'
,
before_error_render
=>
'core.error.before'
,
after_error_render
=>
'core.error.after'
,
before_error_init
=>
'core.error.init'
,
before_template_render
=>
'engine.template.before_render'
,
after_template_render
=>
'engine.template.after_render'
,
before_layout_render
=>
'engine.template.before_layout_render'
,
after_layout_render
=>
'engine.template.after_layout_render'
,
before_serializer
=>
'engine.serializer.before'
,
after_serializer
=>
'engine.serializer.after'
,
};
}
sub
defined_engines {
my
$self
=
shift
;
return
[
$self
->template_engine,
$self
->session_engine,
$self
->logger_engine,
$self
->has_serializer_engine
?
$self
->serializer_engine
: (),
];
}
sub
api_version {2}
sub
register_plugin {
my
$self
=
shift
;
my
$plugin
=
shift
;
$self
->
log
(
core
=>
"Registered $plugin"
);
push
@{
$self
->plugins },
$plugin
;
}
sub
settings {
my
$self
=
shift
;
+{ %{ Dancer2::runner()->config }, %{
$self
->config } };
}
sub
cleanup {
my
$self
=
shift
;
$self
->clear_request;
$self
->clear_response;
$self
->clear_session;
$self
->clear_destroyed_session;
for
my
$engine
( @{
$self
->defined_engines } ) {
$engine
->clear_session;
$engine
->clear_request;
}
}
sub
_validate_engine {
my
$self
=
shift
;
my
$name
=
shift
;
grep
+(
$_
eq
$name
), @{
$self
->supported_engines }
or croak
"Engine '$name' is not supported."
;
}
sub
engine {
my
$self
=
shift
;
my
$name
=
shift
;
$self
->_validate_engine(
$name
);
my
$attr_name
=
"${name}_engine"
;
return
$self
->
$attr_name
;
}
sub
template {
my
$self
=
shift
;
my
$template
=
$self
->template_engine;
$template
->set_settings(
$self
->config );
$self
->has_request &&
$self
->has_session && !
$template
->has_session
and
$self
->setup_session;
if
(
$self
->has_with_return) {
my
$old_with_return
=
$self
->with_return;
my
$local_response
;
$self
->set_with_return(
sub
{
$local_response
||=
shift
;
});
my
$content
=
eval
{
$template
->process(
@_
) };
my
$eval_result
= $@;
$self
->set_with_return(
$old_with_return
);
if
(
$local_response
) {
$self
->with_return->(
$local_response
);
}
elsif
(
$eval_result
) {
die
$eval_result
;
}
return
$content
;
}
return
$template
->process(
@_
);
}
sub
hook_candidates {
my
$self
=
shift
;
my
@engines
= @{
$self
->defined_engines };
my
@route_handlers
;
for
my
$handler
( @{
$self
->route_handlers } ) {
my
$handler_code
=
$handler
->{handler};
blessed
$handler_code
and
$handler_code
->can(
'supported_hooks'
)
and
push
@route_handlers
,
$handler_code
;
}
my
@plugins
= @{
$self
->plugins };
(
@route_handlers
,
@engines
,
@plugins
);
}
sub
all_hook_aliases {
my
$self
=
shift
;
my
$aliases
=
$self
->hook_aliases;
for
my
$plugin
(
grep
{
$_
->can(
'hook_aliases'
) } @{
$self
->plugins } ) {
$aliases
= { %{
$aliases
}, %{
$plugin
->hook_aliases } };
}
return
$aliases
;
}
sub
mime_type {
my
$self
=
shift
;
my
$runner
= Dancer2::runner();
exists
$self
->config->{default_mime_type}
?
$runner
->mime_type->
default
(
$self
->config->{default_mime_type} )
:
$runner
->mime_type->reset_default;
$runner
->mime_type;
}
sub
log
{
my
$self
=
shift
;
my
$level
=
shift
;
my
$logger
=
$self
->logger_engine
or croak
"No logger defined"
;
$logger
->
$level
(
@_
);
}
sub
send_as {
my
$self
=
shift
;
my
(
$type
,
$data
,
$options
) =
@_
;
$options
||= {};
$type
or croak
"Can not send_as using an undefined type"
;
if
(
lc
(
$type
) eq
'html'
||
lc
(
$type
) eq
'plain'
) {
if
(
$type
ne
lc
$type
) {
local
$Carp::CarpLevel
= 2;
carp
sprintf
(
"Please use %s as the type for 'send_as', not %s"
,
lc
(
$type
),
$type
);
}
$options
->{charset} =
$self
->config->{charset} ||
'UTF-8'
;
my
$content
= Encode::encode(
$options
->{charset},
$data
);
$options
->{content_type} ||=
join
'/'
,
'text'
,
lc
$type
;
return
$self
->send_file( \
$content
,
%$options
);
}
my
$serializer_class
=
"Dancer2::Serializer::$type"
;
eval
{
$EVAL_SHIM
->(
sub
{
require_module(
$serializer_class
);
});
1;
} or
do
{
my
$err
= $@ ||
"Zombie Error"
;
croak
"Unable to load serializer class for $type: $err"
;
};
my
$engine_options
=
$self
->_get_config_for_engine(
serializer
=>
$type
,
$self
->config ) || {};
my
$serializer
=
$serializer_class
->new(
config
=>
$engine_options
);
my
$content
=
$serializer
->serialize(
$data
);
$options
->{content_type} ||=
$serializer
->content_type;
$self
->send_file( \
$content
,
%$options
);
}
sub
send_error {
my
$self
=
shift
;
my
(
$message
,
$status
) =
@_
;
my
$err
= Dancer2::Core::Error->new(
message
=>
$message
,
app
=>
$self
,
(
status
=>
$status
)x!!
$status
,
$self
->has_serializer_engine
? (
serializer
=>
$self
->serializer_engine )
: (),
)->throw;
$self
->has_with_return &&
$self
->with_return->(
$err
);
return
$err
;
}
sub
send_file {
my
$self
=
shift
;
my
$thing
=
shift
;
my
%options
=
@_
;
my
(
$content_type
,
$charset
,
$file_path
);
my
$is_filehandle
= Plack::Util::is_real_fh(
$thing
)
|| ( is_globref(
$thing
) && *{
$thing
}{IO} && *{
$thing
}{IO}->can(
'getline'
) )
|| ( Scalar::Util::blessed(
$thing
) &&
$thing
->can(
'getline'
) );
my
(
$fh
) = (
$thing
)x!!
$is_filehandle
;
if
(Scalar::Util::blessed(
$thing
) &&
$thing
->isa(
'IO::Scalar'
)) {
$thing
=
$thing
->sref;
}
if
( is_scalarref(
$thing
) ) {
open
$fh
,
"<"
,
$thing
;
}
if
(!
$fh
) {
my
$path
=
$thing
;
my
$prefix
=
$self
->prefix;
if
(
$prefix
&&
$prefix
ne
'/'
) {
$path
=~ s/^\Q
$prefix
\E//;
}
my
$dir
=
$options
{system_path}
? File::Spec->rootdir
:
$ENV
{DANCER_PUBLIC}
||
$self
->config->{public_dir}
|| path(
$self
->location,
'public'
);
$file_path
= Dancer2::Handler::File->merge_paths(
$path
,
$dir
);
my
$err_response
=
sub
{
my
$status
=
shift
;
$self
->response->status(
$status
);
$self
->response->header(
'Content-Type'
,
'text/plain'
);
$self
->response->content( Dancer2::Core::HTTP->status_message(
$status
) );
$self
->with_return->(
$self
->response );
};
$err_response
->(403)
if
!
defined
$file_path
;
$err_response
->(404)
if
!-f
$file_path
;
$err_response
->(403)
if
!-r
$file_path
;
$fh
= Dancer2::FileUtils::open_file(
"<"
,
$file_path
);
binmode
$fh
;
$content_type
= Dancer2::runner()->mime_type->for_file(
$file_path
) ||
'text/plain'
;
if
(
$content_type
=~ m!^text/! ) {
$charset
=
$self
->config->{charset} ||
"utf-8"
;
}
}
$self
->execute_hook(
'core.app.before_file_render'
,
$file_path
);
(
exists
$options
{
'content_type'
} ) and
$content_type
=
$options
{
'content_type'
};
(
exists
$options
{
'charset'
} ) and
$charset
=
$options
{
'charset'
};
$content_type
.=
"; charset=$charset"
if
$content_type
and
$charset
;
(
defined
$content_type
)
and
$self
->response->header(
'Content-Type'
=>
$content_type
);
(
exists
$options
{filename} )
and
$self
->response->header(
'Content-Disposition'
=>
(
$options
{content_disposition} ||
"attachment"
) .
"; filename=\"$options{filename}\""
);
my
$use_streaming
=
exists
$options
{streaming} ?
$options
{streaming} : 1;
my
$response
;
my
$env
=
$self
->request->env;
if
(
$env
->{
'psgi.streaming'
} &&
$use_streaming
) {
my
$cb
=
sub
{
my
$responder
=
$Dancer2::Core::Route::RESPONDER
;
my
$res
=
$Dancer2::Core::Route::RESPONSE
;
return
$responder
->(
[
$res
->status,
$res
->headers_to_array,
$fh
]
);
};
Scalar::Util::weaken(
my
$weak_self
=
$self
);
$response
= Dancer2::Core::Response::Delayed->new(
error_cb
=>
sub
{
$weak_self
->logger_engine->
log
(
warning
=>
@_
) },
cb
=>
$cb
,
request
=>
$Dancer2::Core::Route::REQUEST
,
response
=>
$Dancer2::Core::Route::RESPONSE
,
);
}
else
{
$response
=
$self
->response;
$response
->{content} = Dancer2::FileUtils::read_glob_content(
$fh
);
$response
->is_encoded(1);
}
$self
->execute_hook(
'core.app.after_file_render'
,
$response
);
$self
->with_return->(
$response
);
}
sub
BUILD {
my
$self
=
shift
;
$self
->init_route_handlers();
$self
->_init_hooks();
$self
->
log
(
core
=>
'Built config from files: '
.
join
(
' '
, @{
$self
->config_files}));
}
sub
finish {
my
$self
=
shift
;
defined
$self
->config->{
'static_handler'
}
or
$self
->config->{
'static_handler'
} = -d
$self
->config->{
'public_dir'
};
$self
->register_route_handlers;
$self
->compile_hooks;
@{
$self
->plugins}
&&
$self
->plugins->[0]->can(
'_add_postponed_plugin_hooks'
)
&&
$self
->plugins->[0]->_add_postponed_plugin_hooks(
$self
->postponed_hooks
);
foreach
my
$prep_cb
( @{
$self
->prep_apps } ) {
$prep_cb
->(
$self
);
}
}
sub
init_route_handlers {
my
$self
=
shift
;
my
$handlers_config
=
$self
->config->{route_handlers};
for
my
$handler_data
( @{
$handlers_config
} ) {
my
(
$handler_name
,
$config
) = @{
$handler_data
};
$config
= {}
if
!is_ref(
$config
);
my
$handler
=
$self
->_factory->create(
Handler
=>
$handler_name
,
app
=>
$self
,
%$config
,
postponed_hooks
=>
$self
->postponed_hooks,
);
push
@{
$self
->route_handlers }, {
name
=>
$handler_name
,
handler
=>
$handler
,
};
}
}
sub
register_route_handlers {
my
$self
=
shift
;
for
my
$handler
( @{
$self
->route_handlers} ) {
my
$handler_code
=
$handler
->{handler};
$handler_code
->register(
$self
);
}
}
sub
compile_hooks {
my
(
$self
) =
@_
;
for
my
$position
(
$self
->supported_hooks ) {
my
$compiled_hooks
= [];
for
my
$hook
( @{
$self
->hooks->{
$position
} } ) {
Scalar::Util::weaken(
my
$app
=
$self
);
my
$compiled
=
sub
{
$Dancer2::Core::Route::RESPONSE
&&
$Dancer2::Core::Route::RESPONSE
->is_halted
and
return
;
eval
{
$EVAL_SHIM
->(
$hook
,
@_
); 1; }
or
do
{
my
$err
= $@ ||
"Zombie Error"
;
$app
->cleanup;
$app
->
log
(
'error'
,
"Exception caught in '$position' filter: $err"
);
croak
"Exception caught in '$position' filter: $err"
;
};
};
push
@{
$compiled_hooks
},
$compiled
;
}
$self
->replace_hook(
$position
,
$compiled_hooks
);
}
}
sub
lexical_prefix {
my
$self
=
shift
;
my
$prefix
=
shift
;
my
$cb
=
shift
;
$prefix
eq
'/'
and
undef
$prefix
;
my
$app_prefix
=
$self
->prefix;
my
$new_prefix
=
(
defined
$app_prefix
?
$app_prefix
:
''
)
. (
defined
$prefix
?
$prefix
:
''
);
length
$new_prefix
and
$self
->prefix(
$new_prefix
);
my
$err
;
my
$ok
=
eval
{
$EVAL_SHIM
->(
$cb
); 1 }
or
do
{
$err
= $@ ||
"Zombie Error"
; };
$self
->prefix(
$app_prefix
);
$ok
or croak
"Unable to run the callback for prefix '$prefix': $err"
;
}
sub
add_route {
my
$self
=
shift
;
my
%route_attrs
=
@_
;
my
$route
= Dancer2::Core::Route->new(
type_library
=>
$self
->config->{type_library},
prefix
=>
$self
->prefix,
%route_attrs
,
);
my
$method
=
$route
->method;
push
@{
$self
->routes->{
$method
} },
$route
;
if
(
$method
ne
'head'
&&
$route
->has_name() ) {
my
$name
=
$route
->name;
$self
->route_names->{
$name
}
and
die
"Route with this name ($name) already exists"
;
$self
->route_names->{
$name
} =
$route
;
}
return
$route
;
}
sub
route_exists {
my
$self
=
shift
;
my
$route
=
shift
;
my
$routes
=
$self
->routes->{
$route
->method };
foreach
my
$existing_route
(
@$routes
) {
$existing_route
->spec_route eq
$route
->spec_route
and
return
1;
}
return
0;
}
sub
routes_regexps_for {
my
$self
=
shift
;
my
$method
=
shift
;
return
[
map
$_
->regexp, @{
$self
->routes->{
$method
} } ];
}
sub
cookie {
my
$self
=
shift
;
@_
== 1 and
return
$self
->request->cookies->{
$_
[0] };
my
(
$name
,
$value
,
%options
) =
@_
;
my
$c
=
Dancer2::Core::Cookie->new(
name
=>
$name
,
value
=>
$value
,
%options
);
$self
->response->push_header(
'Set-Cookie'
=>
$c
->to_header );
}
sub
redirect {
my
$self
=
shift
;
my
$destination
=
shift
;
my
$status
=
shift
;
if
(
$destination
=~ m{^/(?!/)}) {
my
$script_name
=
$self
->request->script_name;
$script_name
=~ s{/$}{};
$destination
=
$script_name
.
$destination
;
}
$self
->response->redirect(
$destination
,
$status
);
$self
->has_with_return
and
$self
->with_return->(
$self
->response);
}
sub
halt {
my
$self
=
shift
;
$self
->response->halt(
@_
);
$self
->has_with_return
and
$self
->with_return->(
$self
->response);
}
sub
pass {
my
$self
=
shift
;
$self
->response->pass;
$self
->has_with_return
and
$self
->with_return->(
$self
->response);
}
sub
forward {
my
$self
=
shift
;
my
$url
=
shift
;
my
$params
=
shift
;
my
$options
=
shift
;
my
$new_request
=
$self
->make_forward_to(
$url
,
$params
,
$options
);
$self
->has_with_return
and
$self
->with_return->(
$new_request
);
}
sub
make_forward_to {
my
$self
=
shift
;
my
$url
=
shift
;
my
$params
=
shift
;
my
$options
=
shift
;
my
$overrides
= {
PATH_INFO
=>
$url
};
exists
$options
->{method} and
$overrides
->{REQUEST_METHOD} =
$options
->{method};
my
$new_request
=
$self
->request->_shallow_clone(
$params
,
$overrides
);
my
$engine
=
$self
->session_engine;
$engine
&&
$self
->_has_session or
return
$new_request
;
my
$name
=
$engine
->cookie_name;
exists
$new_request
->cookies->{
$name
} and
return
$new_request
;
$new_request
->cookies->{
$name
} =
Dancer2::Core::Cookie->new(
name
=>
$name
,
value
=>
$self
->session->id );
return
$new_request
;
}
sub
app {
shift
}
sub
to_app {
my
$self
=
shift
;
{
for
(
qw<logger session template>
) {
my
$attr
=
"${_}_engine"
;
$self
->
$attr
;
}
if
(
$self
->config->{
'serializer'
} ) {
$self
->serializer_engine;
}
}
$self
->finish;
my
$psgi
=
sub
{
my
$env
=
shift
;
my
$method
=
uc
$env
->{
'REQUEST_METHOD'
};
$Dancer2::Core::Types::supported_http_methods
{
$method
}
or
return
[
405,
[
'Content-Type'
=>
'text/plain'
],
[
"Method Not Allowed\n\n$method is not supported."
]
];
my
$response
;
eval
{
$EVAL_SHIM
->(
sub
{
$response
=
$self
->dispatch(
$env
)->to_psgi });
1;
} or
do
{
my
$err
= $@ ||
"Zombie Error"
;
return
[
500,
[
'Content-Type'
=>
'text/plain'
],
[
"Internal Server Error\n\n$err"
],
];
};
return
$response
;
};
if
(
$self
->config->{
'static_handler'
} ) {
my
$static_app
= Plack::App::File->new(
root
=>
$self
->config->{public_dir},
content_type
=>
sub
{
$self
->mime_type->for_file(
$_
[0] ) },
)->to_app;
$psgi
= Plack::Middleware::Conditional->wrap(
$psgi
,
condition
=>
sub
{ -f path(
$self
->config->{public_dir},
shift
->{PATH_INFO} ) },
builder
=>
sub
{ Plack::Middleware::ConditionalGET->wrap(
$static_app
) },
);
}
if
( !
$self
->config->{
'no_default_middleware'
} ) {
$psgi
= Plack::Middleware::FixMissingBodyInRedirect->wrap(
$psgi
);
$psgi
= Plack::Middleware::Head->wrap(
$psgi
);
}
return
$psgi
;
}
sub
dispatch {
my
$self
=
shift
;
my
$env
=
shift
;
my
$runner
= Dancer2::runner();
my
$request
;
my
$request_built_successfully
=
eval
{
$EVAL_SHIM
->(
sub
{
$request
=
$runner
->{
'internal_request'
} ||
$self
->build_request(
$env
);
});
1;
};
if
( !
$request_built_successfully
) {
my
$err
= $@;
Scalar::Util::weaken(
my
$app
=
$self
);
return
Dancer2::Core::Error->new(
app
=>
$app
,
message
=>
$err
,
status
=> 400,
)->throw;
}
my
$cname
=
$self
->session_engine->cookie_name;
my
$defined_engines
=
$self
->defined_engines;
DISPATCH:
while
(1) {
my
$http_method
=
lc
$request
->method;
my
$path_info
=
$request
->path_info;
$self
->set_request(
$request
,
$defined_engines
);
$self
->
log
(
core
=>
"looking for $http_method $path_info"
);
ROUTE:
foreach
my
$route
( @{
$self
->routes->{
$http_method
} } ) {
my
$match
=
$route
->match(
$request
)
or
next
ROUTE;
$request
->_set_route_params(
$match
);
$request
->_set_route_parameters(
$match
);
$request
->_set_route(
$route
);
if
(
my
$sess
=
$runner
->{
'internal_sessions'
}{
$cname
} ) {
$self
->set_session(
$sess
);
}
my
$response
;
DANCER2_CORE_APP_ROUTE_RETURN: {
if
(!
$self
->has_with_return) {
$self
->set_with_return(
sub
{
$response
=
shift
;
no
warnings
'exiting'
;
last
DANCER2_CORE_APP_ROUTE_RETURN;
});
}
$response
=
$self
->_dispatch_route(
$route
);
};
$self
->clear_with_return;
if
(
ref
$response
eq
'Dancer2::Core::Request'
) {
$self
->clear_request;
$self
->clear_response;
if
(
$runner
->{
'internal_dispatch'
} ) {
$self
->_has_session
and
$runner
->{
'internal_sessions'
}{
$cname
} =
$self
->session;
$runner
->{
'internal_forward'
} = 1;
$runner
->{
'internal_request'
} =
$response
;
return
$self
->response_not_found(
$request
);
}
$request
=
$response
;
next
DISPATCH;
}
if
(
$response
->is_halted ) {
$self
->cleanup;
delete
$runner
->{
'internal_request'
};
return
$response
;
}
if
(
$response
->has_passed ) {
exists
$request
->{_params}{splat}
and
delete
$request
->{_params}{splat};
$response
->has_passed(0);
$response
->clear_content;
next
ROUTE;
}
$self
->execute_hook(
'core.app.after_request'
,
$response
);
$self
->cleanup;
delete
$runner
->{
'internal_request'
};
return
$response
;
}
last
;
}
if
(
$runner
->{
'internal_dispatch'
} ) {
$runner
->{
'internal_404'
} = 1;
$runner
->{
'internal_request'
} =
$request
;
}
my
$response
=
$self
->response_not_found(
$request
);
$self
->cleanup;
return
$response
;
}
sub
build_request {
my
(
$self
,
$env
) =
@_
;
Scalar::Util::weaken(
my
$weak_self
=
$self
);
my
$request
= Dancer2::Core::Request->new(
env
=>
$env
,
is_behind_proxy
=>
$self
->settings->{
'behind_proxy'
} || 0,
uri_for_route
=>
sub
{
shift
;
$weak_self
->uri_for_route(
@_
) },
$self
->has_serializer_engine
? (
serializer
=>
$self
->serializer_engine )
: (),
);
return
$request
;
}
sub
_dispatch_route {
my
(
$self
,
$route
) =
@_
;
local
$@;
eval
{
$EVAL_SHIM
->(
sub
{
$self
->execute_hook(
'core.app.before_request'
,
$self
);
});
1;
} or
do
{
my
$err
= $@ ||
"Zombie Error"
;
return
$self
->response_internal_error(
$err
);
};
my
$response
=
$self
->response;
if
(
$response
->is_halted ) {
return
$self
->_prep_response(
$response
);
}
eval
{
$EVAL_SHIM
->(
sub
{
$response
=
$route
->execute(
$self
) });
1;
} or
do
{
my
$err
= $@ ||
"Zombie Error"
;
return
$self
->response_internal_error(
$err
);
};
return
$response
;
}
sub
_prep_response {
my
(
$self
,
$response
,
$content
) =
@_
;
my
$config
=
$self
->config;
if
(
exists
$config
->{content_type}
and
my
$ct
=
$config
->{content_type} ) {
$response
->default_content_type(
$ct
);
}
defined
$content
&&
$response
->content(
$content
);
return
$response
;
}
sub
response_internal_error {
my
(
$self
,
$error
) =
@_
;
$self
->execute_hook(
'core.app.route_exception'
,
$self
,
$error
);
$self
->
log
(
error
=>
"Route exception: $error"
);
local
$Dancer2::Core::Route::REQUEST
=
$self
->request;
local
$Dancer2::Core::Route::RESPONSE
=
$self
->response;
return
Dancer2::Core::Error->new(
app
=>
$self
,
status
=> 500,
exception
=>
$error
,
)->throw;
}
sub
response_not_found {
my
(
$self
,
$request
) =
@_
;
$self
->set_request(
$request
);
local
$Dancer2::Core::Route::REQUEST
=
$self
->request;
local
$Dancer2::Core::Route::RESPONSE
=
$self
->response;
my
$response
= Dancer2::Core::Error->new(
app
=>
$self
,
status
=> 404,
message
=>
$request
->path,
)->throw;
$self
->cleanup;
return
$response
;
}
sub
uri_for_route {
my
(
$self
,
$route_name
,
$route_params
,
$query_params
,
$dont_escape
) =
@_
;
my
$route
=
$self
->route_names->{
$route_name
}
or
die
"Cannot find route named '$route_name'"
;
my
$string
=
$route
->spec_route;
is_regexpref(
$string
)
and
die
"uri_for_route() does not support regexp route paths"
;
if
( is_arrayref(
$route_params
) ) {
$route_params
= {
'splat'
=>
$route_params
};
}
my
@params
=
$string
=~ m{:([^/.\?]+)}xmsg;
foreach
my
$param
(
@params
) {
$param
=~ s{^([^\[]+).*}{$1}xms;
my
$value
=
$route_params
->{
$param
}
or
die
"Route $route_name uses the parameter '${param}', which was not provided"
;
$string
=~ s!\Q:
$param
\E(\[[^\]]+\])?!
$value
!xmsg;
}
$string
=~ s!\Q**\E!(?
$string
=~ s!\*!(?
my
@token_or_splat
=
$string
=~ /\(\?
my
$splat_params
=
$route_params
->{
'splat'
};
if
(
$splat_params
&&
@token_or_splat
) {
$
or
die
'Mismatch in amount of splat args and splat elements'
;
for
(
my
$i
= 0;
$i
< @{
$splat_params
};
$i
++ ) {
if
( is_arrayref(
$splat_params
->[
$i
]) ){
my
$megasplat
=
join
'/'
, @{
$splat_params
->[
$i
] };
$string
=~ s{\Q(?
}
else
{
$string
=~ s{\Q(?
}
}
}
return
$self
->request->uri_for(
$string
,
$query_params
,
$dont_escape
);
}
1;