| HTTP-Engine-Middleware documentation | Contained in the HTTP-Engine-Middleware distribution. |
HTTP::Engine::Middleware::DebugScreen - dump stack-trace when die
my $mw = HTTP::Engine::Middleware->new;
$mw->install(qw/ HTTP::Engine::Middleware::DebugScreen /);
HTTP::Engine->new(
interface => {
module => 'YourFavoriteInterfaceHere',
request_handler => $mw->handler( \&handler ),
}
)->run();
yappo
kan
and more?
Scope::Upper, CGI::ExceptionManager::StackTrace
| HTTP-Engine-Middleware documentation | Contained in the HTTP-Engine-Middleware distribution. |
package HTTP::Engine::Middleware::DebugScreen; use HTTP::Engine::Middleware; use HTTP::Engine::Response; use Scope::Upper qw( localize_elem :words ); has 'powerd_by' => ( is => 'rw', default => __PACKAGE__, ); has 'renderer' => ( is => 'rw', ); has 'err_info' => ( is => 'rw', ); has 'response' => ( is => 'rw', ); has 'stacktrace_required' => ( is => 'rw', isa => 'Bool', ); before_handle { my($c, $self, $req) = @_; $self->response(undef); $self->err_info(undef); $self->stacktrace_required(0); localize_elem '%SIG', '__DIE__' => sub { $c->diecatch(1); died($self, @_) } => SUB UP; $req; }; after_handle { my($c, $self, $req, $res) = @_; if ($self->err_info && $c->diecatch) { $res = HTTP::Engine::Response->new; $res->code(500); my $body = $self->err_info->as_html( powered_by => $self->powerd_by, ($self->renderer ? (renderer => $self->renderer) : ()) ); utf8::downgrade($body) if utf8::is_utf8($body); $res->body($body); } $res; }; sub detach { die bless [@_], 'CGI::ExceptionManager::Exception' } sub died { my($self, $msg) = @_; if (ref $msg eq 'CGI::ExceptionManager::Exception') { $self->response($msg->[0]); $self->err_info(undef); } else { unless ($self->stacktrace_required) { require CGI::ExceptionManager::StackTrace; $self->stacktrace_required(1); } $self->err_info( CGI::ExceptionManager::StackTrace->new($msg) ); } die $msg; } __MIDDLEWARE__ __END__