CGI::Carpでド派手なデバッグスクリーンを表示させる（２）
前回のはいささか手抜きが過ぎたので、nekokakさんのCGI::Application::Plugin::DebugScreenを参考にちょろっとブラッシュアップ。いくらなんでもここや本家のような緑系で画面つくるのはエラー画面っぽくないよなあということでCSSはほとんどnekokakさんの(ひいてはid:nipotanさんやid:tokuhiromさんの、ですね。失礼しました)パクリですが、地味なところでoverflow（これはKickstart my heartを見ていいなあと思ったもの）とか入れてあります。あとはデバッグモードかどうかで吐き出すエラー画面が異なるのが特徴といえば特徴。フラグひとつ変えればそのままプロダクション環境に移行……しちゃ本当はまずいんですが、まあ、そういうこともできるようにということで。
今度は use CGI::Carp qw/fatalsToBroswer/ のかわりに use CGI::Carp::DebugScreen するだけでそれなりの画面が出るはず。設定は
use CGI::Carp::DebugScreen ( debug => 1, engine => 'HTML::Template', lines => 5, modules => 1, environment => 1, raw_error => 1, );
のような格好で。
- CGI::Carp::DebugScreen
package CGI::Carp::DebugScreen;
{
use strict;
use warnings;
use Exporter;
use CGI::Carp qw/fatalsToBrowser/;
our $VERSION = '0.01';
BEGIN {
my $MyDebug = 0;
CGI::Carp::set_message(
sub { __PACKAGE__->show(@_) }
) unless $MyDebug;
}
$Carp::Verbose = 1; # for stack traces
my $Debug = 1;
my $Engine = 'HTML::Template';
my $ShowLines = 3;
my $ShowMod;
my $ShowEnv;
my $ShowRawError;
my $Template;
my $ErrorTemplate;
sub import {
my $pkg = shift;
my %options = @_;
while(my ($key, $value) = each %options) {
next unless defined $value;
$key = lc $key;
$Debug = $value if $key =~ /^d(?:ebug)?$/;
$Engine = $value if $key =~ /^e(?:ngine)?$/;
$ShowLines = $value if $key =~ /^l(?:ines)?$/;
$ShowMod = $value if $key =~ /^m(?:od(?:ules)?)?$/;
$ShowEnv = $value if $key =~ /^env(?:ironment)?$/;
$ShowRawError = $value if $key =~ /^raw(?:_error)?$/;
$ErrorTemplate = $value if $key =~ /^e(?:rror_)?t(?:emplate)?$/;
}
}
sub show_modules { shift; $ShowMod = shift; }
sub show_environment { shift; $ShowEnv = shift; }
sub show_raw_error { shift; $ShowRawError = shift; }
sub debug { shift; $Debug = shift; }
sub set_engine { shift; $Engine = shift; }
sub set_template { shift; $Template = shift; }
sub set_error_template { shift; $ErrorTemplate = shift; }
sub get_contents {
my ($file, $line_no) = @_;
my @contents;
if (open my $fh, '<'.$file) {
my $ct = 0;
while(my $line = <$fh>) {
$ct++;
next if $ct < $line_no - $ShowLines;
last if $ct > $line_no + $ShowLines;
push @contents, {
no => $ct,
line => $line,
hit => ($ct == $line_no),
};
}
}
\@contents;
}
sub show {
my ($pkg, $errstr) = @_;
my $first_message = '';
my @traces = grep {
my $caller = $_->{package};
(
$caller eq $INC{'Carp.pm'} or # ignore Carp;
$caller eq $INC{'CGI/Carp.pm'} # ignore CGI::Carp;
) ? 0 : 1;
}
map {
my $line = $_;
my ($message, $caller, $line_no) =
$line =~ /^(?:\s*)(.*?)(?: called)? at (\S+) line (\d+)\.?$/;
$first_message = $message unless $first_message && defined $message;
my $file = $INC{$caller} || $caller;
my $contents = get_contents($file,$line_no);
+{
message => $message,
package => $caller,
file => $caller ne $file ? $file : '',
contents => $contents,
line => $line_no,
}
} split(/\n/,$errstr);
my $error_at = $traces[$#traces]->{package};
my @modules = ();
@modules = map {
my $key = $_;
(my $package = $key) =~ s|/|::|g;
+{
package => $package,
file => $INC{$key},
}
} sort {$a cmp $b} keys %INC if $ShowMod;
my @environment = ();
@environment = map {
+{
key => $_,
value => $ENV{$_},
}
} sort {$a cmp $b} keys %ENV if $ShowEnv;
my $viewer = __PACKAGE__.'::'.$Engine;
eval "require $viewer";
if ($@) {
print "<html><body><pre>Error: $errstr</pre></body></html>"; exit;
}
$viewer->show(
show_raw_error => $ShowRawError,
raw_error => $errstr,
error_at => $error_at,
error_message => $first_message.' at '.$traces[0]->{package}.' line '.$traces[0]->{line},
traces => \@traces,
modules => \@modules,
environment => \@environment,
debug => $Debug,
tmplref => \$Template,
error_tmpl => $ErrorTemplate,
);
}
}
1;
- CGI::Carp::DebugScreen::HTML::Template
package CGI::Carp::DebugScreen::HTML::Template;
{
use strict;
use warnings;
use HTML::Template;
our $VERSION = '0.01';
my $Template =<<'EOT';
<TMPL_IF NAME="debug">
<html>
<head>
<title>Debug Screen</title>
<style type="text/css">
<!--
body {
font-family: "Bitstream Vera Sans", "Trebuchet MS", Verdana,
Tahoma, Arial, helvetica, sans-serif;
color: #000;
background-color: #f90;
margin: 0px;
padding: 0px;
}
:link, :link:hover, :visited, :visited:hover {
color: #333;
}
div#page {
position: relative;
background-color: #fff;
border: 1px solid #aaa;
padding: 4px;
margin: 10px;
-moz-border-radius: 10px;
}
div.navi {
color: #333;
padding: 0 4px;
}
div.box {
background-color: #fff;
border: 3px solid #fc9;
padding: 8px;
margin: 4px;
margin-bottom: 10px;
-moz-border-radius: 10px;
}
h1 {
margin: 0;
color: #666;
}
h2 {
margin-top: 0;
margin-bottom: 10px;
font-size: medium;
font-weight: bold;
text-decoration: underline;
}
table.code {
font-size: .8em;
line-height: 120%;
font-family: 'Courier New', Courier, monospace;
background-color: #fc9;
color: #333;
border: 1px dotted #000;
margin: 8px;
width: 90%;
border-collapse: collapse;
}
table.code tr.hit {
font-weight: bold;
color: #000;
background-color: #E68200;
}
table.code td {
padding-left: 1em;
line-height: 130%;
}
table.code td.num {
width: 4em;
text-align:right
}
div.scrollable {
font-size: .8em;
overflow: auto;
}
pre.raw_error {
background-color: #fff;
border: 3px solid #fc9;
padding: 8px;
margin: 4px;
margin-bottom: 10px;
-moz-border-radius: 10px;
font-size: .8em;
line-height: 120%;
font-family: 'Courier New', Courier, monospace;
overflow: auto;
}
ul#traces, ul#modules {
margin: 1em 1em;
padding: 0 1em;
}
table#environment {
margin: 0 1em;
}
-->
</style>
</head>
<body>
<a name="top"></a>
<div id="page">
<h1><TMPL_VAR NAME="error_at" ESCAPE=HTML></h1>
<TMPL_IF NAME="show_raw_error">
<pre class="raw_error"><TMPL_VAR NAME="raw_error"></pre>
<TMPL_ELSE>
<div class="box">
<TMPL_VAR NAME="error_message">
</div>
</TMPL_IF>
<div class="navi">
[<a href="#top">top</a>]
[<a href="#traces">traces</a>]
<TMPL_IF NAME="modules">[<a href="#modules">modules</a>]</TMPL_IF>
<TMPL_IF NAME="environment">[<a href="#environment">environment</a>]</TMPL_IF>
</div>
<div class="box">
<h2><a name="traces">Stack Traces</a></h2>
<ul id="traces">
<TMPL_LOOP NAME="traces">
<li>
<TMPL_VAR NAME="package" ESCAPE=HTML>
<TMPL_IF NAME="file"> (<TMPL_VAR NAME="file" ESCAPE=HTML>)</TMPL_IF>
LINE : <TMPL_VAR NAME="line" ESCAPE=HTML>
</li>
<table class="code">
<TMPL_LOOP NAME="contents">
<TMPL_IF NAME="hit"><tr class="hit"><TMPL_ELSE><tr></TMPL_IF>
<td class="num"><TMPL_VAR NAME="no" ESCAPE=HTML>:</td>
<td><TMPL_VAR NAME="line" ESCAPE=HTML></td>
</tr>
</TMPL_LOOP>
</table>
</TMPL_LOOP>
</ul>
</div>
<TMPL_IF NAME="modules">
<div class="navi">
[<a href="#top">top</a>]
[<a href="#traces">traces</a>]
<TMPL_IF NAME="modules">[<a href="#modules">modules</a>]</TMPL_IF>
<TMPL_IF NAME="environment">[<a href="#environment">environment</a>]</TMPL_IF>
</div>
<div class="box">
<h2><a name="modules">Included Modules</a></h2>
<ul id="modules">
<TMPL_LOOP NAME="modules">
<li><TMPL_VAR NAME="package" ESCAPE=HTML> (<TMPL_VAR NAME="file" ESCAPE=HTML>)</li>
</TMPL_LOOP>
</ul>
</div>
</TMPL_IF>
<TMPL_IF NAME="environment">
<div class="navi">
[<a href="#top">top</a>]
[<a href="#traces">traces</a>]
<TMPL_IF NAME="modules">[<a href="#modules">modules</a>]</TMPL_IF>
<TMPL_IF NAME="environment">[<a href="#environment">environment</a>]</TMPL_IF>
</div>
<div class="box">
<h2><a name="environment">Environmental Variables</a></h2>
<table id="environment">
<TMPL_LOOP NAME="environment">
<tr>
<td><TMPL_VAR NAME="key" ESCAPE=HTML></td>
<td><div class="scrollable"><TMPL_VAR NAME="value" ESCAPE=HTML></div><//td>
</tr>
</TMPL_LOOP>
</table>
</div>
</TMPL_IF>
</div>
</body>
</html>
<TMPL_ELSE>
<TMPL_IF NAME="error_tmpl">
<TMPL_VAR NAME="error_tmpl">
<TMPL_ELSE>
<html>
<head>
<title>An unexpected error has been detected</title>
<style type="text/css">
<!--
body {
font-family: "Bitstream Vera Sans", "Trebuchet MS", Verdana,
Tahoma, Arial, helvetica, sans-serif;
color: #000;
background-color: #F90;
margin: 0px;
padding: 0px;
}
div#page {
position: relative;
background-color: #fff;
border: 1px solid #aaa;
padding: 4px;
margin: 10px;
-moz-border-radius: 10px;
}
div.box {
background-color: #fff;
border: 3px solid #FFCC99;
padding: 8px;
margin: 4px;
margin-bottom: 10px;
-moz-border-radius: 10px;
}
h1 {
margin: 0;
color: #666;
}
p {
margin: 1em;
}
-->
</style>
</head>
<body>
<div id="page">
<h1>An unexpected error has been detected</h1>
<p>Sorry for inconvenience.</p>
</div>
</body>
</html>
</TMPL_IF>
</TMPL_IF>
EOT
sub show {
my ($pkg, %options) = @_;
my $tref = ${$options{tmplref}} ? $options{tmplref} : \$Template;
my $tmpl = HTML::Template->new(
scalarref => $tref,
die_on_bad_params => 0,
);
delete $options{tmplref};
$tmpl->param(%options);
print $tmpl->output;
}
}
1;もうちょい整理してPOD書いたらアップするつもりです。
