Practice of Programming

プログラム とか Linuxとかの話題

ダブルクリックで動かすPerl scriptのためのCarp

なんだそりゃって話ですが、例えば、Windowsで、perlプログラムを作って、ダブルクリックで実行すると。
die したときに、あっというまにプロンプトが消えちゃって、わけわかんねってなっちゃいますが。

(追記)charsbarさんによると、レジストリをいじることでWindowsでプロンプト開きっぱにもできるようです。副作用があるようですが。
http://d.hatena.ne.jp/charsbar/20090604/1244104249

そういうときは、例えば、このようにしていたわけです。

BEGIN {
   $SIG{__DIE__} = sub {
      print STDERR  @_;
      <>;
   }
}

毎回面倒くさいなぁ、と思い、こういうのはどうかなと。

package Script::Carp;

use Carp ();
use strict;
use warnings;

our $FLGS =
  {
   -file => sub {
     my ($args) = @_;
     my $file = shift @$args;
     Carp::croak("USAGE: use Script::Carp -file => 'file_name'") unless $file;
     return sub {
       my (@args) = @_;
       open my $out, ">", $file or die "cannot open file '$file'.";
       print $out @args;
       close $out;
     };
   },
   -stop => sub {
     return sub { print "Hit Enter to exit:"; <> };
   },
  };

sub import {
  my ($self, @opt) = @_;

  my @subs;
  while (@opt) {
    my $flg = shift @opt;
    if (my $gen = $FLGS->{$flg}) {
      push @subs, $gen->(\@opt);
    }
  }
  $SIG{__DIE__} = sub {
    my @args = @_;
    if (defined $^S and $^S == 1) {
      die @args;
    } else {
      print STDERR @args;
      $_->(@args) for @subs;
      exit 255;
    }
  };
}

*setup = \&import;

使い方は、

use Script::Carp -stop; # die 時にメッセージ出力して標準入力を待つ
use Script::Carp -file => 'error.txt'; # die 時にメッセージをファイルに書き出す
use Script::Carp -stop, -file => 'error.txt'; # 組み合わせてもいい

クラスメソッドsetupを使ってもOK。

Script::Carp->setup(-stop);
Script::Carp->setup(-file => 'error.txt');
Script::Carp->setup(-stop, -file => 'error.txt');

クラス変数$FLGSのキーをフラグに、値にcode ref を返す code ref を書いてやれば、なんぼでも増やせます。
前者のcode ref に渡ってくるのは、import/setupに渡されてくる、フラグ以外の残りの引数です。


codereposに置きました。
http://coderepos.org/share/browser/lang/perl/Script-Carp/trunk


特殊変数は、あんまり使わないのですが、今回は下記の2つを使いました。

$^X ... 実行しているperlの場所。これを使って外部のperl scriptを実行
$^S ... 1 の場合、eval で実行されている。eval の中では、Script::Carpの挙動を無視するのに使った