Charsbar::Note

2005/12/14

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 なんてメッセージも隠せます。

ド派手じゃないけど、こんなところでOK?

+{ } ネタでハマる

HTML::Templateのループに食わせるべく。

my $tmpl = HTML::Template->new(filename => 'hoge');

$tmpl->param(
  list => [
    map {
      my $id = $_;
      {
        id   => $id,
        title  => "title$id",
      };
    } (1..3)
  ]
);

なんてコードを書いたら、ローカルのActivePerl 5.8.6では期待した動作をするのに、検証用の環境に入っていたperl 5.8でエラーになって大ハマリ。さんざん関係ないところで悩んだ末に検証環境でparamの中身をDumperしたら

$VAR1 = 'list';
$VAR2 = [
          'id',
          1,
          'title',
          'title1',
          'id',
          2,
          'title',
          'title2',
          'id',
          3,
          'title',
          'title3',
        ];

のような出力が得られたのでようやく事態を認識して、

my @list;
foreach my $id (1..3) {
  push @list, {
    id    => $id,
    title => "title$id",
  };
]
$tmpl->param( list => \@list );

と書き換えてひとまずはお茶を濁したのですが、敗北感がぬぐえずさらに調べてみたところ、

$tmpl->param(
  list => [
    map {
      {
        id    => $_,
        title => "title$_",
      }
    } (1..3)
  ]
);

これなら5.005、5.6.1、5,8.6でそれぞれ問題なし。

$tmpl->param(
  list => [
    map {
      my $id = $_;
      {
        id    => $id,
        title => "title$id",
      }
    } (1..3)
  ]
);

もともとのこれは5.005、5.6.1でハマリ。5.8でもNG。そこから5.8.6に至るどこかでOKになった模様。

$tmpl->param(
  list => [
    map {
      my $id = $_;
      my $href = {
        id    => $id,
        title => "title$id",
      }
    } (1..3)
  ]
);

これは5.005以降でOK。

で、ここまで書いて、はたと気がついた。

$tmpl->param(
  list => [
    map {
      my $id = $_;
      +{
        id    => $id,
        title => "title$id",
      }
    } (1..3)
  ]
);

もちろん5.005以降でOK。

いつぞやのLLDNで大笑いしたアレ、こんなところで使うものだったのですね!(違

SubversionとFTP

CVSにかわるバージョン管理システムとして人気のSubverion。うちでもTortoiseSVNともどもあちらこちらにリポジトリを作って活用しているのですが、こやつはチェックアウト先のディレクトリに(デフォルトでは).svnというディレクトリを掘りまくってくれるので、FTPでテスト用の鯖に丸ごとアップロードしようとしたときに――というか、一度アップロードしたものを消そうとしたときに――はまることがあるのが泣きどころ。もちろんふつうのFTPソフトで消せなくなっても、たとえば

#!/usr/bin/perl
use strict;

system('rm -rf hoge');

print "Content-type:text/html\n\n<html><body>OK</body></html>";

のようなCGIを書いてブラウザから叩けばたいていはなんとかなったりするわけですが、さすがに毎回そんなことをするのはつらい。

なんぞいいFTPソフトがないかなあとつねづね探しているのですが、だいたい拡張子の面倒までしか見てくれないんですよね。

自分で使うだけならNet::FTPあたりを使ってほげほげっと書いてしまえばすむ話ですが、それでは、たとえばデザさんたちには使ってもらえない。

何か妙案ないものでしょうか。もちろんsvnserveなりApache2+WebDAVなりを走らせられるような鯖を使えないというのが大前提で(汗