CGI::Carpでド派手なデバグスクリーンを表示させる

あちらこちらで大人気のド派手なデバグスクリーン。もしかしたらもう誰かがやってるかもと思いつつ、遅ればせながら

CGI::Carp 使えば同じこと出来るんじゃね？と思う方もいるでしょうが、いかんせん CGI::Carp は出力される HTML がダサいです ;-)

にちょっと反応してみる。
たとえば起動スクリプトにこんなコードを書いておいて、

use strict;
use warnings;
use CGI::Carp qw/fatalsToBrowser/;

BEGIN {
  use CGI::Carp::DebugScreen;
  CGI::Carp::set_message(
    sub { CGI::Carp::DebugScreen->show(@_) }
  );
}

CGI::Carp::DebugScreen->debug(0);
CGI::Carp::DebugScreen->force_confess(0);
CGI::Carp::DebugScreen->set_template(<<'EOT');
<!-- 本番ではこんなダサイ画面にしちゃいけません ;p -->
<html> 
<body>
<TMPL_IF NAME="debug">
<p>ERROR</p>
<ul>
<TMPL_VAR NAME="errstr">
</ul>
<TMPL_ELSE>
<p>ごめんなさい。バグっちゃいました。てへ。</p>
</TMPL_IF>
</body>
</html>
EOT

CGI::Carp::DebugScreen.pm （名前適当）とかいうモジュールに

package CGI::Carp::DebugScreen;
{
  use strict;
  use warnings;
  use HTML::Template;

  our $VERSION = '0.01';

  our $Debug;
  our $Context;
  our $Template;

  sub debug         { shift; $Debug = shift; }
  sub set_context   { shift; $Context = shift; }
  sub set_template  { shift; $Template = shift; }
  sub force_confess { shift; $Carp::Verbose = shift; }

  sub show {
    my ($pkg, $errstr) = @_;

    $errstr =~ s|(?: called)? at \S+ line \d+$||gm unless $Debug;

    if ($Context) {
      my $tmpl = HTML::Template->new(
        scalarref => \$Template,
        associate => $Context,
        die_on_bad_params => 0,
      );

      $errstr =~ s|^|<li>|gm;
      $errstr =~ s|$|</li>|gm;

      $tmpl->param(debug  => $Debug);
      $tmpl->param(errstr => $errstr);

      print $tmpl->output;
    }
    else {
      print "<html><body><pre>$errstr</pre></body></html>";
    }
  }
}
1;

とでも書いておけば、あとはいつものように use CGI::Carp して or croak 'hogehoge' するだけでそれなりにデザインされたデバッグ画面を表示できます。もちろん適当なタイミングで CGI::Carp::DebugScreen->set_context($c) とかすればコンテキストを表示させることもできますし、CGI::Carp::DebugScreen->debug(0) しておけば一般客には見せたくない at module line \d なんてメッセージも隠せます。

ド派手じゃないけど、こんなところでＯＫ？