package Sledge::Plugin::DebugScreen; use strict; use warnings; our $VERSION = '0.07'; use Template; use Devel::StackTrace; use IO::File; { package Sledge::Exception::StackTrace; sub print_context { my $self = shift; my($file, $linenum) = ($self->file, $self->line); my $code; if (-f $file) { my $start = $linenum - 3; my $end = $linenum + 3; $start = $start < 1 ? 1 : $start; if (my $fh = IO::File->new($file, 'r')) { my $cur_line = 0; while (my $line = <$fh>) { ++$cur_line; last if $cur_line > $end; next if $cur_line < $start; my @tag = $cur_line == $linenum ? qw( ) : ('', ''); $code .= sprintf( '%s%5d: %s%s', $tag[0], $cur_line, $self->_html_escape($line), $tag[1], ); } } } return $code; } sub _html_escape { my ($self, $str) = @_; $str =~ s/&/&/g; $str =~ s//>/g; $str =~ s/"/"/g; return $str; } } our $TEMPLATE = q{ Error in [% title | html %]

[% title | html %]

[% pages.current_url | html %]

[% desc | html %]

StackTrace

[% FOR s IN stacktrace -%] [%- END %]

Package	Line	File
[% s.pkg \| html %]	[% s.line \| html %]	[% s.file \| html %]
[% s.print_context %]

}; sub import { my $self = shift; my $pkg = caller; no strict 'refs'; { my $super = $pkg->can('dispatch'); *{"$pkg\::dispatch"} = sub { my $self = shift; local $SIG{__DIE__} = sub { $self->{__stacktrace} = [map {Sledge::Exception::StackTrace->new( file => $_->filename, line => $_->line, pkg => $_->package, )} Devel::StackTrace->new->frames ]; die @_; # rethrow }; $self->$super(@_); }; } *{"$pkg\::handle_exception"} = \&_handle_exception; } sub _handle_exception { my ($self, $E) = @_; return if $self->finished; if ($self->debug_level) { warn $E; my $vars = { title => ref $self || $self, desc => "$E", pages => $self, }; if (ref $E and $E->can('stacktrace')) { $vars->{stacktrace} = $E->stacktrace; } else { $vars->{stacktrace} = $self->{__stacktrace}; shift @{$vars->{stacktrace}}; } my $tmpl = Template->new; my $output; $tmpl->process(\$TEMPLATE, $vars, \$output); $self->r->content_type('text/html'); $self->set_content_length(length $output); $self->r->status($self->SERVER_ERROR); $self->send_http_header; $self->r->print($output); $self->finished(1); } else { die $E; } } 1; __END__ =head1 NAME Sledge::Plugin::DebugScreen - show the debug screen if crashed =head1 SYNOPSIS package Your::Pages; use Sledge::Plugin::DebugScreen; sub debug_level { return $ENV{'DEBUG_MODE'} ? 1 : 0; } =head1 DESCRIPTION This plugin shows the debug screen if crashed, like Catalyst. The debug screen is only showing debug mode. Screen image: L =head1 AUTHOR MATSUNO Tokuhiro Koichi Taniguchi This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 THANKS TO Jiro Nishiguchi. =head1 TODO more tests. =head1 DEPENDENCIES L