[Perl]例外をオブジェクトとして扱う

例外をオブジェクトとして扱うと以下のような利点があります。

1. エラーの種類を正規表現ではなくオブジェクトの型で分けられる
2. オブジェクトに複雑な情報を付加できる

例外オブジェクトを扱うモジュールとしてErrorモジュールやException::Classが有りますが、そういったモジュールを使わなくてもPerl5.005以降ではdieにblessされたリファレンスが渡せるため、普通に例外オブジェクトが使えます。

たとえばこんな感じでエラークラスを定義しておくと

use strict;
package MyException;
use base 'Class::Accessor';
use overload qw{""} => \&as_string;
use Carp;
__PACKAGE__->mk_accessors(qw(description stacktrace associated));
sub new {
my $class = shift;
my $desc  = shift;
my @args  = @_;
unless ($desc =~ /\n\z/) {
        my $line = (caller($Carp::CarpLevel))[2];
        $desc .= " at line $line.";
}
my $self = $class->SUPER::new({ description => $desc, @args });

$self->stacktrace("$class".  Carp::longmess() );
return $self;
}
sub throw {
my $proto = shift;
my $desc  = shift;
die $proto if ref $proto;
local $Carp::CarpLevel = $Carp::CarpLevel + 1;

my $self = $proto->new($desc, @_);
die $self;
}

sub as_string {
my $self = shift;
return
qq{$self->{description}
------------------- stacktrace ---------------------
$self->{stacktrace}
};
}

package HogeException;
our @ISA = qw(MyException);

package SystemException;
our @ISA = qw(MyException);

以下のようにisaで判断して関連するオブジェクトを取り出したりできます。

#!/usr/local/bin/perl
use strict;
package App;
use MyException;
use Data::Dumper;

sub hoge_func {
 my $obj = { hoge => "@_" };
 HogeException->throw('normal throw', associated => $obj);
}

sub run {
 my $class = shift;
 eval {
         $class->hoge_func('hoge_func', @_);
 };
 if (my $err = $@) {
     print "#####\n$err#####\n"; # MyException->as_stringが呼ばれる
     if (UNIVERSAL::isa($err,'HogeException')) {
     # オブジェクトの型で処理を分岐。関連付けられている情報を取り出す
     print Dumper($err->associated);
   } else {
     die $err;
   }
 }
};

package main;
App->run('hoge');

実行結果

#####
normal throw at line 9.
------------------- stacktrace ---------------------
HogeException at die2.pl line 9
 App::hoge_func('App', 'hoge_func', 'hoge') called at die2.pl line 15
 eval {...} called at die2.pl line 14
 App::run('App', 'hoge') called at die2.pl line 29

#####
$VAR1 = {
   'hoge' => 'App hoge_func hoge'
 };

ただこのままだとモジュール内で普通にdieされているものはスタックトレースがでなかったりと不便なので、シグナルハンドラを使ってもうひと頑張りしてみます

local $SIG{__DIE__} = sub {
 if (ref $_[0] && $_[0]->isa('MyException') ) {
     $_[0]->throw;
 }
 else {
     # スタックトレースにここの呼び出しを含めないようにする
     local $Carp::CarpLevel = $Carp::CarpLevel + 1;
     SystemException->throw( join " ", @_ )
 };
};

これを設定しておくと普通にdieが使われている場所でも例外オブジェクトに変換されてスタックトレースが取れるようになります。
スタックトレースだけを考えたら

local $SIG{__DIE__} = \&Carp::confess

で充分だと思います。

[Perl]YAMLでblessさせる

YAMLファイル内に!perl/packageというタグを記述することでファイルロード時に値をblessさせることができます。
例えばこんなかんじで

#!/usr/local/bin/perl
use strict;

package Model::Book;
use base 'Class::Accessor';

my @accessors = qw(author title publisher);
__PACKAGE__->mk_accessors(@accessors);

sub as_string {
 my $self = shift;
 return join "\n", map {"$_: " . $self->$_()} @accessors;
}

package main;
use YAML::Syck;
use Data::Dumper;

my $data = do { local $/; <DATA>};
my $yml = YAML::Syck::Load($data);

print Dumper($yml);
for my $model (@{$yml->{models}}) {
       print "############\n";
       print $model->as_string . "\n";
}

__END__
models:
  - !perl/Model::Book
      author: Damian Conway
      title: Perl Best Practice
      publisher: O'REILLY
  - !perl/Model::Book
      author: Larry Wall
      title: Programming Perl
      publisher: O'REILLY

としておくと

$VAR1 = {
         'models' => [
                       bless( {
                                'publisher' => 'O\'REILLY',
                                'title' => 'Perl Best Practice',
                                'author' => 'Damian Conway'
                              }, 'Model::Book' ),
                       bless( {
                                'publisher' => 'O\'REILLY',
                                'title' => 'Programming Perl',
                                'author' => 'Larry Wall'
                              }, 'Model::Book' )
                     ]
       };
############
author: Damian Conway
title: Perl Best Practice
publisher: O'REILLY
############
author: Larry Wall
title: Programming Perl
publisher: O'REILLY

のような結果になります。

これを使えば引数にオブジェクトをとるプラグインなんかも容易にYAMLでDIできるなぁと思ったのですが、以下のような問題が発覚しました。

1. newなどの初期化メソッドを一切呼んでくれない
2. 単にblessするだけでuseすらしてくれない

これらのことから結局はなんらかのフレームワークに頼らないと上手く実現できなさそう。。。Rubyの場合はYAML for Rubyにもあるようにいろいろできるみたいですが、PerlのYAMLサポートはいまいち充分ではないようです。なんかやり方あるのかなぁ。。。

[Perl]Time::Piece::localime + ONE_YEARで小ハマリ

http://d.hatena.ne.jp/usuihiro1978/20061117
から移動。

Time::PieceとTime::Secondsを使って日付の比較を行うときに以下のようなコードを書いていて小ハマリしました。

use Time::Piece;
use Time::Seconds;

if ($t1 >localtime + ONE_YEAR) {
   # コード
} else {
   # コード
}

上記コードでの

localtime + ONE_YEAR

は

localtime( + ONE_YEAR)

となってしまいます。
よって

localtime() + ONE_YEAR

と書かないとだめ。

localtimeがプロトタイプ宣言で

sub localtime ()

となっていれば()つけなくても大丈夫なわけですが、引数を渡せる為そうはなっていません。
こういう関数に引数を渡さないときは明示的に()をつけておいたほうがよさそうですね。

[Perl]無限ループを書く最も簡単な方法？

普通無限ループといったら

while(1){
   # なんらかの処理
}

といった形で書くと思います。
しかしPerlプログラマは怠惰です。一文字でも多くタイプするのを好まないでしょう。1をタイプするのが面倒なので次のように書きましょう。

while(){
   # なんらかの処理
}

これで見事に無限ループしてくれます。

尚、当然ですが以下のように明らかに偽と評価されるものだとループに入りません。

while(undef){
   # なんらかの処理
}

while(''){
   # なんらかの処理
}

while(()){
   # なんらかの処理
}

while(0){
   # なんらかの処理
}

残念なのは後置にすると無限ループしないところです。これができれば更にタイプ量が減ってうれしいのですが。

print "hello." while();

きっと役に立たない知識ですね。。。（というより紛らわしいので迷惑です）
Perlがどう解釈しているのかさっぱりわからない。。。

[Perl]myと後置ifでstatic変数が作れる？

myと後置ifでstatic変数のような動きになるけどこれは仕様上想定内の動きなのだろうか？

use strict;
sub counter {
  my $cnt if (0);
  ++$cnt;
}

print (counter() . "\n") for (1..3);

実行結果

1
2
3