The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

our $AUTHORITY = 'cpan:SUKRIA';
# ABSTRACT: Dancer request handler
$Dancer::Handler::VERSION = '1.3521';
use strict;
use Carp;
use File::stat;
use Dancer::Config 'setting';
use Dancer::Exception qw(:all);
use Encode;
Dancer::Factory::Hook->instance->install_hooks(
qw/on_handler_exception/
);
# This is where we choose which application handler to return
sub get_handler {
my $handler = 'Dancer::Handler::Standalone';
# force PSGI is PLACK_ENV is set
if ($ENV{'PLACK_ENV'}) {
Dancer::Logger::core("PLACK_ENV is set (".$ENV{'PLACK_ENV'}.") forcing PSGI handler");
setting('apphandler' => 'PSGI');
}
# if Plack is detected or set by conf, use the PSGI handler
if ( defined setting('apphandler') ) {
$handler = 'Dancer::Handler::' . setting('apphandler');
}
# load the app handler
my ($loaded, $error) = Dancer::ModuleLoader->load($handler);
raise core_handler => "Unable to load app handler `$handler': $error" if $error;
# OK, everything's fine, load the handler
Dancer::Logger::core('loading ' . $handler . ' handler');
return $handler->new;
}
# handle an incoming request, process it and return a response
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");
# save the request object
Dancer::SharedData->request($request);
# deserialize the request body if possible
$request = Dancer::Serializer->process_request($request)
if Dancer::App->current->setting('serializer');
# read cookies from client
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 {
# workflow exception (continuation)
my ($continuation) = @_;
$continuation->isa('Dancer::Continuation::Halted')
|| $continuation->isa('Dancer::Continuation::Route')
or $continuation->rethrow();
# special case for halted workflow continuation: still render the response
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
)
);
# use stringification, to get exception message in case of a
# Dancer::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);
}
# render a PSGI-formatted response from a response built by
# handle_request()
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')) {
use bytes; # turn off character semantics
$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 );
}
}
# drop content if request is HEAD
$content = ['']
if ( defined Dancer::SharedData->request
&& Dancer::SharedData->request->is_head() );
# drop content AND content_length if response is 1xx or (2|3)04
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();
# reverse streaming
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)/;
}
# Fancy banner to print on startup
sub print_banner {
if (setting('startup_info')) {
my $env = setting('environment');
print "== Entering the $env dance floor ...\n";
}
}
sub dance { (shift)->start(@_) }
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Dancer::Handler - Dancer request handler
=head1 VERSION
version 1.3521
=head1 AUTHOR
Dancer Core Developers
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2010 by Alexis Sukrieh.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut