検索

• [ Prev ]
• [ Next ]
• [ Perl ]

• subroutineへの参照を保持する変数と、無名関数の生成を利用し、関数への参照を引数で受け取り、呼び出す関数というトリック例
• <= Perl 5.8

• funcref1.pl

#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;

# Normal Subroutine.
sub func1 {
	print "In func1\n";
}

# Reference to Anonymous subroutine.
my $func2 = sub {
	print "In func2\n";
};

sub func3 {
	print "In func3\n";
}

# Function using Prototype.
sub func_all($$;$) {
	my($f1, $f2, $f3) = @_;
	$f1->(); # how to call subroutine by reference.
	$f2->();
	$f3->() if defined($f3);
}

&func_all(\&func1, $func2);
#         ^^ how to access refernce of subroutine body.

my $hoge_f = \&func3; # get reference.
&func_all(\&func1, $func2, $hoge_f);

• 出力

C:\in_vitro\perl\lang>perl ./funcref1.pl
In func1
In func2 <------ ここまでが一回目のfunc_all.
In func1
In func2
In func3 <------ 2回目のfunc_allでは、func3も呼んでいる。

無名関数と、関数へのリファレンスを保持できるというのは、Perl-OOPやPerl-COP(Context Oriented Programming)、そしてPerlの美しさで非常に重要な役割を果たしている、に違いない。

• [ Prev ]
• [ Next ]
• [ Perl ]

• [ Prev ]
• [ Next ]
• [ Perl ]

• 頻繁に見かけるが、今ひとつ何をするものか分からない"qw()"表現。
• とりあえず、リストを作るものであることは分かったので、試すだけ試してみる。

• コードピース

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

my @ary1 = qw(abc def 123);
my %h1 = qw( foo 123 bar 456 buz 789 );

print join " ", @ary1;
print "\n----------\n";

while(my ($key, $val) = each(%h1)) {
	print "$key => $val\n";
}
print "\n----------\n";

my $val1 = 0.123;
my $val2 = 4.56;
my $val3 = 78.9;

my @ary2 = qw ( $val1 $val2 $val3 val4 );
print join " ", @ary2;

• 出力

abc def 123
----------
bar => 456
buz => 789
foo => 123

----------
$val1 $val2 $val3 val4

例えば"use XXXX"の後ろに、"()"でパラメータを渡すように書いてあるのと、"qw( ... )"で渡すように書いてあるものが有ったりする。qw()の方だと、"$val"としても変数展開されないので、そう言った需要があるときにqw()を使用するようである。

今ひとつ納得しきれないので、また後でリベンジを仕掛けるときもあるかもしれない。

• [ Prev ]
• [ Next ]
• [ Perl ]

• [ Prev ]
• [ Next ]
• [ Perl ]

• Perl/codepiece/pseudo_blockでは、ブロックに渡す引数をブロックの後ろに持って行く手法を示した。
• その後、頭が Cool Down した後、何とか引数をブロックの前の第一引数に指定できないかと思案した結果、多少不格好にはなるがとりあえずできた。
• <= Perl 5.8

• pseudo_block2.pl

#!/usr/bin/perl
use strict;
use warnings;
use IO::File;

sub pseudo_block($&) {
	my ($fname, $block) = @_;
	my $fh = new IO::File;
	if ($fh->open("<$fname")) {
		$block->($fh);
		$fh->close;
	} else {
		warn "$fname open failed.\n";
	}
}

pseudo_block "test.dat", sub {
	my ($fh) = @_;
	print <$fh>;
};

• 出力はpseudo_blockと同じ。

見かけ上どう感じるかは個人の主観による。但し、このように引数を前に持ってきてしまうと、 リストを渡せない ことになる。以下のようにしてしまうと、最初の括弧対が、サブルーチンの引数を囲む括弧対として認識されてしまい、エラーになってしまう。

pseudo_block (1, 2, 3), sub {
	my ($x, $y, $z) = @_;
	...        
};

どうしてもリストを渡したい場合は、配列へのリファレンスを渡す。→試しにやってみたらエラーにならず、上手く動いた。

sub hogeblock($&) {
	my ($args, $block) = @_;
	$block->($args);
}
hogeblock [ 1, 2, 3, 4 ], sub {
	my ($args) = @_;
	print @$args;
}

• [ Prev ]
• [ Next ]
• [ Perl ]

• [ Prev ]
• [ Next ]
• [ Perl ]

• "{", "}"は、パッケージ・ブロック・ハッシュコンストラクタの三つの顔を持ち、それぞれは使用されている箇所でのコンテキストにより切り替わる。
• ここでは、無名関数として使用されるシーンを活用し、ユーザー定義の疑似ブロックのサンプルを掲示する。
• <= Perl 5.8

• pseudo_block1.pl

#!/usr/bin/perl
use strict;
use warnings;
use IO::File;

sub pseudo_block(&$) {
	my ($block, $fname) = @_;
	my $fh = new IO::File;
	if ($fh->open("<$fname")) {
		$block->($fh);
		$fh->close;
	} else {
		die "$fname open failed.\n";
	}
}

pseudo_block {
	my ($fh) = @_;
	print <$fh>;
} "test.dat";

• test.dat : 適当なテキストファイル

ab
cd
efg

• 出力：ファイルがあるとき

>perl pseudo_block1.pl
ab
cd
efg

• 出力：ファイルが無いとき

>perl pseudo_block1.pl
test.dat open failed.

美しさから言えば、"test.dat"にあたるプロトタイプの順番を逆にして以下のようにしたいところだが、"{" "}"がハッシュコンストラクタとして解釈されてしまうらしく、syntax errorになってしまう。

sub pseudo_block($&) {
my ($fname, $block) = @_;
...
}

pseudo_block "test.dat", {
        my ($fh) = @_;
        ...
} 

このように、トランザクション的な処理をカプセル化したい場合、強力なツールとして使用できる。誰でも簡単に思いつくのは、以下のような例ではないだろうか。

sub transact(&$) {
    my ($block, $dbh) = @_;
    try {
        $block->($dbh);
        $dbh->commit;
    } catch {
        $dbh->rollback;
    }
}

transact {
    my ($dbh) = @_;
    $dbh->do("(some sql)");
} $dbh;

• [ Prev ]
• [ Next ]
• [ Perl ]

• [ Prev ]
• [ Next ]
• [ Perl ]

今回のコードピースは簡単すぎる。実際はより複雑な場合や、スタックトレースを活用したい場合もあり得ると思われる。そういったシーンのコードピースはまた、時間をおいてリベンジをかけたい。

多段呼び出し時のcatch動作を確認

• コードピース

#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
use Error qw(:try);
# 関数の中でthrowしてみる
sub t01 {
    try {
        throw Error(-text => "through test!!");
    } catch Error with {
        my $e = shift;
        print "======= in t01\n";
        $e->throw();
    };
}
try { &t01(); } catch Error with {
    my $e = shift;
    print "----- in main\n";
    print Dumper($e), "\n";
};
# 一段関数呼び出しを増やしてみる
sub t02 { &t01(); }
try { &t02(); } catch Error with {
    my $e = shift;
    print "----- in main\n";
    print Dumper($e), "\n";
};

• 出力

======= in t01
----- in main
$VAR1 = bless( {
     '-file' => './try06.pl',
     '-text' => 'through test!!',
     '-line' => 12,
     '-package' => 'main'
   }, 'Error' );

======= in t01
----- in main
$VAR1 = bless( {
     '-file' => './try06.pl',
     '-text' => 'through test!!',
     '-line' => 12,
     '-package' => 'main'
   }, 'Error' );

基本的に、多段で組んだ場合も問題なくcatchできているようである。

もともとError.pmにおいてcatchは%SIG{__DIE__}機構を用いて実現している。多段で組んでも特に問題無いと言える。

• [ Prev ]
• [ Next ]
• [ Perl ]

• [ Prev ]
• [ Next ]
• [ Perl ]

Perl/codepiece/try-catch-exception01で、基本的なエラーの捕捉方法を確認した。

ここでは、より実際のシーンを意識し、以下のシチュエーションでエラーを捕捉できるか確認する。

• require時に該当パッケージが存在しない時
• 呼ぼうとしたパッケージ関数が定義されていない時

いずれも perldiag(http://perldoc.perl.org/perldiag.html) では(F)(trappable fatal error)に分類されている。

未存在パッケージrequire・未定義関数呼び出し時のtry-catchエラー捕捉の確認

ディレクトリ構成：

./try05/
./try05/try05.pl : main
./try05/Hoge/
./try05/Hoge/Bohe.pm : empty package module

• try05/try05.pl :

#!/usr/bin/perl
use strict;
use warnings;
use File::Basename;
use Data::Dumper;
use Error qw(:try);
sub BEGIN {
    my (undef, $__base_dir, undef) = fileparse($0);
    push(@INC, $__base_dir);
}
# 存在しないパッケージをrequireしてみる。
try {
    my $pkg_name = "Hoge::Hoge";
    eval("require $pkg_name;");
    if ($@) {
        throw Error(-text => $@);
    }
} catch Error with {
    my $e = shift;
    print Dumper($e), "\n";
};
# 存在しないパッケージ関数を呼んでみる。
try {
    my $pkg_name = "Hoge::Bohe";
    eval("require $pkg_name;");
    my $obj = $pkg_name->new();
} catch Error with {
    my $e = shift;
    print Dumper($e), "\n";
};

• try05/Hoge/Bohe.pm (空のパッケージモジュール) :

package Hoge::Bohe;
use strict;
use warnings; 
1;

• 出力

$ ./try05/try05.pl
$VAR1 = bless( {
     '-file' => 'try05/try05.pl',
     '-text' => 'Can\'t locate Hoge/Hoge.pm in @INC (@INC contains: ... try05/) at (eval 3) line 1.
',
     '-line' => 17,
     '-package' => 'main'
   }, 'Error' );

$VAR1 = bless( {
     '-file' => 'try05/try05.pl',
     '-text' => 'Can\'t locate object method "new" via package "Hoge::Bohe"',
     '-line' => '27',
     '-package' => 'Error'
   }, 'Error::Simple' );

まず、エラー捕捉の仕方が異なる点に注目する。

• 存在しないパッケージをロード： $@を手動チェックしている。
• 存在しない関数を呼び出し：try-catchに任せている。

最初、前者の方でもtry-catchに任せてみたが、 catchに捕捉されない 現象が発生した。試しに手動で$@チェックを入れてみたところ上手く行った。(evalの特性と関係するのかも知れない。)

逆に、後者の方で$@の手動チェックを入れても、そこは通らない。未定義関数の呼び出しの方では、即座にcatchへ入る(=dieがブロック中で発生している？)ようである。

いずれにせよ、パッケージモジュールロード時の eval("require $pkg_name") のエラーハンドリングは$@の手動チェックが欠かせないことを確認した。

• [ Prev ]
• [ Next ]
• [ Perl ]

• [ Prev ]
• [ Next ]
• [ Perl ]

Perl(正確にはPerl5.X系列まで)にはtry-catch構文は存在しない。しかし、evalやcoderefを引数にとることができるなどの特徴を用い、幾つかの疑似try-catch的テクニックは存在する。Error.pmとうモジュールも公開されており、こちらを活用するとOOP的なtry-catchを実現できる。

参考ページ：

• Error.pm
  • http://search.cpan.org/~shlomif/Error-0.17008/lib/Error.pm
  • http://www.perl.com/pub/a/2002/11/14/exception.html
  • http://www.perl.com/pub/a/2002/11/14/exception.html?page=2
• 日本語のError.pm紹介ブログentry
  • http://qootas.org/blog/archives/2006/08/perltry_catch.html

eval{}中のdieを$@で判別する基本形

eval{}コードブロック中でのdieは、コードを抜けた後、 $@ 変数で参照できる。これを利用して、以下のような疑似try-catch機能を利用できる。

eval {
    # do-something
    if ( exception-condition ) {
        die "exception message";
    }
};
if ($@) {
    &someErrorHandler($@);
}

これが、perl.comにも載っているし、自分自身、恐らくどこかしかで目にしたのだろう、いつの間にかおぼえていた疑似コードである。(ひょっとしたらperl.comで目にした記憶が時間軸を前後したのかも知れない。)

これについてはわざわざコードピースを示すまでもない。

Error.pmの使用例

perl.comでも掲載されている、Perlでtry-catch, そしてOOPな例外処理機構を使用するのにお奨めのモジュール、それがError.pmらしい。perl.comに掲載されている記事やCPANのPODを元に、簡単なコードピースで実験をしてみる。

• コードピース：スクリプトの引数に応じて発生させるErrorオブジェクトを変化させ、独自Errorや基本的なErrorを発生させてみる。

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;
use Error qw(:try);
use Switch;

my $d = shift || 0;
my $a = -1;

try {
	switch($d) {
		case -2 {
			# Error::Simpleをそのままthrowしてみる。
			throw Error::Simple("d = -2");
		}
		case -1 {
			# 元になるErrorオブジェクトを直にthrowしてみる。
			throw Error(-text => "d = -1");
		}
		case 0 {
			# Error::Simpleをシンプルに継承したものをthrowしてみる。
			throw Error::TestException("d = 0");
		}
		# 以下はErrorを元にした独自Error
		case 1 {
			throw Test1HogeException("d = 1");
			}
		case 2 {
			throw Test2HogeException("d = 2");
			}
		else {
			throw HogeException("d = else");
		}
	}
	$a = $d;
} catch HogeException with {
	my $e = shift;
	print "======== Hoge Exception ========\n";
	print Dumper($e), "\n";
} catch Error with {
	my $e = shift;
	print "e = $e\n";
	print Dumper($e), "\n";
	print "========warn======\n";
	warn $e->text;
} finally {
	print "\n======= last a = [$a]\n";
};

package BoheException;
use base qw(Error);

package HogeException;
use base qw(Error);
use overload ('""' => 'stringify');

sub new {
	my $self = shift;
	my $text = "".shift;
	my @args = ();
	local $Error::Depth = $Error::Depth + 1;
	local $Error::Debug = 1;
	$self->SUPER::new(-text => $text, @args);
}

package Test1HogeException;
use base qw(HogeException);

package Test2HogeException;
use base qw(HogeException);

package Error::TestException;
use base qw(Error::Simple);

引数に応じて何パターンか試してみる。

• 引数 = -2

e = d = -2 at ./try03.pl line 15.

$VAR1 = bless( {
                 '-file' => './try03.pl',
                 '-text' => 'd = -2',
                 '-line' => 15,
                 '-package' => 'main'
               }, 'Error::Simple' );

========warn======
d = -2 at ./try03.pl line 43.

======= last a = [-1]

• 引数 = -1

e = d = -1
$VAR1 = bless( {
                 '-file' => './try03.pl',
                 '-text' => 'd = -1',
                 '-line' => 18,
                 '-package' => 'main'
               }, 'Error' );

========warn======
d = -1 at ./try03.pl line 43.

======= last a = [-1]

• 引数 = 0

e = d = 0 at ./try03.pl line 21.

$VAR1 = bless( {
                 '-file' => './try03.pl',
                 '-text' => 'd = 0',
                 '-line' => 21,
                 '-package' => 'main'
               }, 'Error::TestException' );

========warn======
d = 0 at ./try03.pl line 43.

======= last a = [-1]

• 引数 = 1

======== Hoge Exception ========
$VAR1 = bless( {
                 '-stacktrace' => 'd = 1 at ./try03.pl line 24
',
                 '-file' => './try03.pl',
                 '-text' => 'd = 1',
                 '-line' => 24,
                 '-package' => 'main'
               }, 'Test1HogeException' );


======= last a = [-1]

• 引数 = 2

======== Hoge Exception ========
$VAR1 = bless( {
                 '-stacktrace' => 'd = 2 at ./try03.pl line 27
',
                 '-file' => './try03.pl',
                 '-text' => 'd = 2',
                 '-line' => 27,
                 '-package' => 'main'
               }, 'Test2HogeException' );


======= last a = [-1]

• 引数 = 3

======== Hoge Exception ========
$VAR1 = bless( {
                 '-stacktrace' => 'd = else at ./try03.pl line 30
',
                 '-file' => './try03.pl',
                 '-text' => 'd = else',
                 '-line' => 30,
                 '-package' => 'main'
               }, 'HogeException' );


======= last a = [-1]

細かい解説は見れば自明なので省略するが、とりあえず独自のErrorクラスを構築し、Javaなどと同じ使い心地で使用できるのを確認できた。

try{}中で直接 warn, die を使ってみる。

上記例はあくまでも教科書通りに、Errorオブジェクトをthrowしている。では実際に、try {} 中で die や warn が発生するとどうなるかを確認しておく。

• コードピース

#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
use Error qw(:try);

try {
    warn "warning!!";
    die "die!!";
} catch Error with {
    my $e = shift;
    print "e = $e\n";
    print Dumper($e), "\n";
    print "========warn======\n";
    warn $e->text;
} finally {
    print "\n======= last \n";
};

• 出力

warning!! at ./try04.pl line 9.
e = die!! at ./try04.pl line 10.

$VAR1 = bless( {
                 '-file' => './try04.pl',
                 '-text' => 'die!!',
                 '-line' => '10',
                 '-package' => 'Error'
               }, 'Error::Simple' );

========warn======
die!! at ./try04.pl line 16.

======= last

die の場合、Error::Simpleにラッピングされてthrowされていることを確認できた。

try{}中で直接 carp, croak を使ってみる。

warn, die と同じ効果になると思われる。

• コードピース

#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
use Carp;
use Error qw(:try);

try {
    carp "carp!!";
    croak "croak!!";
} catch Error with {
    my $e = shift;
    print "e = $e\n";
    print Dumper($e), "\n";
    print "========warn======\n";
    warn $e->text;
} finally {
    print "\n======= last \n";
};

• 出力

carp!! at /usr/lib/perl5/site_perl/5.8.5/Error.pm line 428
e = croak!! at /usr/lib/perl5/site_perl/5.8.5/Error.pm line 428.

$VAR1 = bless( {
                 '-file' => '/usr/lib/perl5/site_perl/5.8.5/Error.pm',
                 '-text' => 'croak!!',
                 '-line' => '428',
                 '-package' => 'Error'
               }, 'Error::Simple' );

========warn======
croak!! at ./try04.pl line 19.

======= last

ほぼ予想通りである。Perl/codepiece/carp01では、(carp,croak)と(cluck,confess)系で違いが見られなかった、とあるが、ここでようやく明らかな出力の差異が認められた。上記コードピースのcarp, croakをそれぞれcluck, confessで置き換えた結果を下に示す。

cluck!! at ./try04.pl line 12
        main::__ANON__() called at /usr/lib/perl5/site_perl/5.8.5/Error.pm line 428
        eval {...} called at /usr/lib/perl5/site_perl/5.8.5/Error.pm line 420
        Error::subs::try('CODE(0x816446c)', 'HASH(0x8164448)') called at ./try04.pl line 24
e = confess!! at ./try04.pl line 15
        main::__ANON__() called at /usr/lib/perl5/site_perl/5.8.5/Error.pm line 428
        eval {...} called at /usr/lib/perl5/site_perl/5.8.5/Error.pm line 420
        Error::subs::try('CODE(0x816446c)', 'HASH(0x8164448)') called at ./try04.pl line 24.

$VAR1 = bless( {
                 '-file' => './try04.pl',
                 '-text' => 'confess!! at ./try04.pl line 15
        main::__ANON__() called at /usr/lib/perl5/site_perl/5.8.5/Error.pm line 428
        eval {...} called at /usr/lib/perl5/site_perl/5.8.5/Error.pm line 420
        Error::subs::try(\'CODE(0x816446c)\', \'HASH(0x8164448)\') called',
                 '-line' => '24',
                 '-package' => 'Error'
               }, 'Error::Simple' );

========warn======
confess!! at ./try04.pl line 15
        main::__ANON__() called at /usr/lib/perl5/site_perl/5.8.5/Error.pm line 428
        eval {...} called at /usr/lib/perl5/site_perl/5.8.5/Error.pm line 420
        Error::subs::try('CODE(0x816446c)', 'HASH(0x8164448)') called at ./try04.pl line 21.

======= last

このように、cluck, confessを使用すると、細かいスタックトレースが出力できることが分かった。

結論として Error.pm と Carp 系は共存可能 であることを確認できた。

• [ Prev ]
• [ Next ]
• [ Perl ]

• [ Prev ]
• [ Next ]
• [ Perl ]

エラーメッセージを表示させるのに一番よく見かけるのが "warn" と "die" である。
それに追随して、PerlのCoreModule(*1)の Carp もよく使われているようである。

このモジュールは、簡潔にまとめると、「よりユーザー・開発者に分かりやすいエラーメッセージを提供する」ためのものである。サブルーチンの呼び出し履歴（バックスタックトレース）を付けてくれる、などである。

• perldoc : http://perldoc.perl.org/Carp.html
• perldoc(ja) : http://perldoc.jp/docs/perl/5.8.0/Carp.pod

(carp, croak) と (cluck, confess) の違い

今回示すような簡単なコードピースでは違いは表面化しないのかも知れない。実際、carp(or croak)も、cluck(or confess)も、全く同じ結果になってしまった。厳密には、上記perldocで記述されているが以下のような違いがあるらしい。

• cluck(warn相当), confess(die相当) : コールスタック内の全ての呼び出しに関する要約がついてくる。
• carp(warn相当), croak(die相当) : より短いメッセージを出力する。（モジュールが呼び出された位置からエラーをリポートすることが可能？）

・・・よく分からないので、将来のリベンジとして残しておく。

4つの意味の違い

正直なところ、英辞郎などを引いてみても、細かいニュアンスの差になってしまい区別が付かなかった・・・。

• carp : 難癖をつける、あら探しをする？
• croak : 蛙がゲコゲコなく、ブツブツ不平をこぼす？
• cluck : めんどりが鳴く、舌打ちをして不平を言う？
• confess : 間違い・罪を認める、白状する？

コードピースと出力($SIG{__WARN__}, $SIG{__DIE__})

• コードピース : carp01.pl (carp, croakの実験)

#!/usr/bin/perl
use strict;
use warnings;
use Carp;

# "warn"発生時のシグナルハンドラ
sub w01 {
	print "======= WARN SIGNAL HANDLER\n";
	my ($msg) = @_;
	print $msg, "\n";
}
$SIG{__WARN__} = \&w01;

# "die"発生時のシグナルハンドラ
sub d01 {
	print "======= DIE SIGNAL HANDLER\n";
	my ($msg) = @_;
	print $msg, "\n";
}
$SIG{__DIE__} = \&d01;

sub f01 { &f02(); }
sub f02 { &f03(); }
sub f03 {
	carp("OOPS!!");
	#croak("OOPS!!");
};
eval { &f01(); };
if ($@) {
	print '------- $@ is caught', "\n";
	warn $@;
}

• 出力1 : warn相当の"carp"時

$ ./carp01.pl
======= WARN SIGNAL HANDLER
OOPS!! at ./carp01.pl line 32
        main::f03() called at ./carp01.pl line 28
        main::f02() called at ./carp01.pl line 24
        main::f01() called at ./carp01.pl line 37
        eval {...} called at ./carp01.pl line 36

• 出力2 : die相当の"croak"時

$ ./carp01.pl
======= DIE SIGNAL HANDLER
OOPS!! at ./carp01.pl line 33
        main::f03() called at ./carp01.pl line 28
        main::f02() called at ./carp01.pl line 24
        main::f01() called at ./carp01.pl line 37
        eval {...} called at ./carp01.pl line 36

------- $@ is caught
======= WARN SIGNAL HANDLER
OOPS!! at ./carp01.pl line 33
        main::f03() called at ./carp01.pl line 28
        main::f02() called at ./carp01.pl line 24
        main::f01() called at ./carp01.pl line 37
        eval {...} called at ./carp01.pl line 36

warnとdieを処理する、特別なシグナル処理、 $SIG{__WARN__}, $SIG{__DIE__} を使用し、本当にdie相当/warn相当が処理されているのかを確認してみる。その結果 carp を用いると、確かにwarn用のシグナルハンドラが走っていることがわかる。また、croakの場合、一度die用のシグナルハンドラが走ってから(これ自体はdie相当ということで問題ない)、 $@がセットされる ため、下のwarn処理に走り、それにより今度はwarn用のシグナルハンドラが走っている。

続いて carp, croak を cluck, confessに変えてみる。コードピースは省略する。

• 出力1 : warn相当の"cluck"時

$ ./carp01.pl
======= WARN SIGNAL HANDLER
OOPS!! at ./carp02.pl line 32
        main::f03() called at ./carp02.pl line 28
        main::f02() called at ./carp02.pl line 24
        main::f01() called at ./carp02.pl line 37
        eval {...} called at ./carp02.pl line 36

• 出力2 : die相当の"confess"時

$ ./carp01.pl
======= DIE SIGNAL HANDLER
OOPS!! at ./carp02.pl line 33
        main::f03() called at ./carp02.pl line 28
        main::f02() called at ./carp02.pl line 24
        main::f01() called at ./carp02.pl line 37
        eval {...} called at ./carp02.pl line 36

------- $@ is caught
======= WARN SIGNAL HANDLER
OOPS!! at ./carp02.pl line 33
        main::f03() called at ./carp02.pl line 28
        main::f02() called at ./carp02.pl line 24
        main::f01() called at ./carp02.pl line 37
        eval {...} called at ./carp02.pl line 36

このように、carp/croakと出力に差異は見られなかった。 恐らく簡単なコードピースではこの差異は表に出てこないと思われる。
とはいえ、cluck/confessでも、warn相当/die相当でシグナルハンドラが処理されていることを確認できた。

• [ Prev ]
• [ Next ]
• [ Perl ]

• [ Prev ]
• [ Next ]
• [ Perl ]

• 地味に有用である、File::BasenameとCwdパッケージの使用例
• <= Perl 5.8

• ./core_modules/basename0.pl

#!/usr/bin/perl

use strict;
use warnings;
use File::Basename;
use Cwd 'realpath', 'cwd';

my($filename, $path, undef) = fileparse($0);
print "fileparse(): filename = [$filename]\n";
print "fileparse(): path = [$path]\n";

print "basename = [" . basename($0) . "]\n";
print "dirname = [" . dirname($0) . "]\n";
print "cwd() = [" . cwd() . "]\n";

• 出力

C:\in_vitro\perl>perl ./core_modules/basename0.pl
fileparse(): filename = [basename0.pl]
fileparse(): path = [./core_modules/]
basename = [basename0.pl]
dirname = [./core_modules]
cwd() = [C:/in_vitro/perl]

• fileparseの返す3番目の値は拡張子(suffix)であり、それを取得するバージョン：

my($filename, $path, undef) = fileparse($0);
→
my($filename, $path, $suffix) = fileparse($0, qr/\.[^.]*/);
...
print "fileparse(): suffix = [$suffix]\n";

• 出力

C:\in_vitro\perl>perl ./core_modules/basename0.pl
fileparse(): filename = [basename0]
fileparse(): path = [./core_modules/]
fileparse(): suffix = [.pl]
basename = [basename0.pl]
dirname = [./core_modules]
cwd() = [C:/in_vitro/perl]

• [ Prev ]
• [ Next ]
• [ Perl ]

• [ Prev ]
• [ Next ]
• [ Perl ]

他のPerlコード、特にパッケージ(.pm)をロードするには "use" 或いは "require" が使用される。
一般に"use"はコンパイル時に評価され、"require"は実行時に評価されると言われている。

ここでは、BEGIN/CHECK/INIT/END ブロックでprintさせることで、実際にどちらがどの段階でどう処理されるのかを浅いレベルで確認する。

• 参考perldoc
  • perlmod : http://perldoc.perl.org/perlmod.html
  • use : http://perldoc.perl.org/functions/use.html
  • require : http://perldoc.perl.org/functions/require.html
  • do : http://perldoc.perl.org/functions/do.html
  • perldiag : http://perldoc.perl.org/perldiag.html
  • %INC : http://perldoc.perl.org/perlvar.html#%25INC
• 他
  • 「Perl の use と require の違い」
  • http://iandeth.dyndns.org/mt/ian/archives/000592.html

use 使用時のBEGIN/CHECK/INIT/END ブロック

まず、普通にuseを使用したときのBEGIN/CHECK/INIT/ENDブロックの呼ばれる順序を確認する。前掲のperlmodによれば、各ブロックが複数回定義されている場合以下の順序で呼ばれるはずである。

• BEGIN : コンパイル時に、出現するたびに即座に呼ばれる。
• CHECK : コンパイル終了後、実行が始まる前に、LIFO(Last In, Fast Out)で呼ばれる。
• INIT : 実行が始まる前に、FIFO(Fast In, Fast Out)で呼ばれる。
• END : 実行が終了し、Perlインタプリタが終了するタイミングで、LIFOで呼ばれる。

また、useする方でも複数箇所にBEGIN - ENDを仕掛け、useする/される側でどういった順序でBEGN - ENDブロックがコールされていくのかも確認してみる。

• コードピース
  • test01.pl

#!/usr/bin/perl
use strict;
use warnings;
use File::Basename;

# @INCの調整
BEGIN {
	my (undef, $__base_dir, undef) = fileparse($0);
	push(@INC, $__base_dir);
	print __PACKAGE__, " BEGIN (1)\n";
}
CHECK { print __PACKAGE__, " CHECK (1)\n"; }
INIT  { print __PACKAGE__, " INIT  (1)\n"; }
END   { print __PACKAGE__, " END   (1)\n"; }

use Hoge::Bohe;

BEGIN { print __PACKAGE__, " BEGIN (2)\n" }
CHECK { print __PACKAGE__, " CHECK (2)\n" }
INIT  { print __PACKAGE__, " INIT  (2)\n" }
END   { print __PACKAGE__, " END   (2)\n" }

BEGIN { print __PACKAGE__, " BEGIN (3)\n" }
CHECK { print __PACKAGE__, " CHECK (3)\n" }
INIT  { print __PACKAGE__, " INIT  (3)\n" }
END   { print __PACKAGE__, " END   (3)\n" }

&Hoge::Bohe::bohe();
print "end.\n";

• • Hoge/Bohe.pm

package Hoge::Bohe;
use strict;
use warnings;

BEGIN { print __PACKAGE__, " BEGIN (1)\n" }
INIT  { print __PACKAGE__, " INIT  (1)\n" }
CHECK { print __PACKAGE__, " CHECK (1)\n" }
END   { print __PACKAGE__, " END   (1)\n" }

sub bohe {
	print "Here in Hoge::Bohe::bohe();\n";
}

BEGIN { print __PACKAGE__, " BEGIN (2)\n" }
INIT  { print __PACKAGE__, " INIT  (2)\n" }
CHECK { print __PACKAGE__, " CHECK (2)\n" }
END   { print __PACKAGE__, " END   (2)\n" }

BEGIN { print __PACKAGE__, " BEGIN (3)\n" }
INIT  { print __PACKAGE__, " INIT  (3)\n" }
CHECK { print __PACKAGE__, " CHECK (3)\n" }
END   { print __PACKAGE__, " END   (3)\n" }

1;
__END__

• 出力：ここでは特に、コンパイルのみのときと実行まで含めたとき、二つの出力結果を示す。
• コンパイルのみ

$ perl -c test01.pl
main BEGIN (1)        # BEGINが出現した順番に呼ばれている。
Hoge::Bohe BEGIN (1)  # test01.plから見て、途中でuseが入っていても、
Hoge::Bohe BEGIN (2)  # 純粋にBEGINの出現順に呼ばれている。
Hoge::Bohe BEGIN (3)
main BEGIN (2)
main BEGIN (3)
main CHECK (3)        # CHECKがLIFOで呼ばれている。
main CHECK (2)        # -> このネストも純粋に"出現した順のLIFO"で
Hoge::Bohe CHECK (3)  #    呼ばれている。
Hoge::Bohe CHECK (2)
Hoge::Bohe CHECK (1)
main CHECK (1)
test01.pl syntax OK

• 実行まで含める

$ ./test01.pl
main BEGIN (1)
Hoge::Bohe BEGIN (1)
Hoge::Bohe BEGIN (2)
Hoge::Bohe BEGIN (3)
main BEGIN (2)
main BEGIN (3)
main CHECK (3)
main CHECK (2)
Hoge::Bohe CHECK (3)
Hoge::Bohe CHECK (2)
Hoge::Bohe CHECK (1)
main CHECK (1)
main INIT  (1)          # INITがFIFOで呼ばれている。
Hoge::Bohe INIT  (1)    # これも純粋に"出現順のFIFO"のようである。
Hoge::Bohe INIT  (2)    # useされる/する側のネスト構造とは無関係に、
Hoge::Bohe INIT  (3)    # それこそlexicalにFIFOで呼ばれている。
main INIT  (2)
main INIT  (3)
Here in Hoge::Bohe::bohe();
end.
main END   (3)          # ENDもINIT同様に、こちらはLIFOで呼ばれている。
main END   (2)
Hoge::Bohe END   (3)
Hoge::Bohe END   (2)
Hoge::Bohe END   (1)
main END   (1)

以上より、BEGIN, CHECKはperldocの通りコンパイル時に処理され、INIT, ENDは実行時に処理されること。およびその順序がperldocの通りであることを確認できた。

useではなくrequireを使いたいとき

実際にrequireの実験に入る前、なぜuseではなくrequireを使うのか、使う時について簡単にメモしておく。

結論から言うと、パッケージ名を設定ファイルなどで外部化したい時、useのパッケージ名は変数を受け付けないからである。

例えば以下のコードはコンパイルエラーとなる。

my $pkg_name = "Hoge::Bohe";
use $pkg_name;

→

syntax error at ****.pl line XX, near "use $pkg_name"
****.pl had compilation errors.

しかしrequireであれば、パッケージ名に変数を使用できる。結局、Factoryを介してロードするモジュールを切り替えたい時は、useではなくrequireしか利用できない。こういった局面ではrequireの方が効果的である。

require 使用時のBEGIN/CHECK/INIT/END ブロック

Hoge::Bohe.pmの方は変更せず、test01.pl の use を require にして確認してみる。

• コードピース (test01.pl)

use Hoge::Bohe;
→
require Hoge::Bohe;   # 注意!! require "Hoge::Bohe"ではない。"bare-word"であること。

• 出力
• コンパイル時

$ perl -c test01.pl
main BEGIN (1)  # Hoge::BoheのBEGIN, CHECKが呼び出されていない
main BEGIN (2)  #  = コンパイルされていない。
main BEGIN (3)
main CHECK (3)
main CHECK (2)
main CHECK (1)
test02.pl syntax OK

• 実行時

$ ./test02.pl
main BEGIN (1)
main BEGIN (2)
main BEGIN (3)
main CHECK (3)
main CHECK (2)
main CHECK (1)
main INIT  (1)
main INIT  (2)
main INIT  (3)
Hoge::Bohe BEGIN (1)
Too late to run INIT block at Hoge/Bohe.pm line 6.
Too late to run CHECK block at Hoge/Bohe.pm line 7.
Hoge::Bohe BEGIN (2)
Too late to run INIT block at Hoge/Bohe.pm line 15.
Too late to run CHECK block at Hoge/Bohe.pm line 16.
Hoge::Bohe BEGIN (3)
Too late to run INIT block at Hoge/Bohe.pm line 20.
Too late to run CHECK block at Hoge/Bohe.pm line 21.
Here in Hoge::Bohe::bohe();
end.
Hoge::Bohe END   (3)
Hoge::Bohe END   (2)
Hoge::Bohe END   (1)
main END   (3)
main END   (2)
main END   (1)

Hoge::BoheのINIT, CHECKが実行されていない。 代わりにWarningが出力されている。perldiag(http://perldoc.perl.org/perldiag.html)参照。
ちなみにHoge::BoheからINIT, CHECKを除去すればwarningは出力されなくなる。

また require の引数に "bare-word" を使用している点に注目する。ここを下記の用にquoted-stringにすると、エラーとなる。

require "Hoge::Bohe";

→

...
main INIT  (3)
Can't locate Hoge::Bohe in @INC (@INC contains: ... ) at test02.pl line 18.
main END   (3)
...

perldiagには(F)、すなわちトラップ可能なFatal Errorとして扱われている。とにもかくにも、エラーでPerlインタプリタ自体は終了し、ENDブロックの実行に進んでいる。

実は、これは本当にrequireを使いたい "パッケージ名の外部化" も同様のwarningがでてしまうことを意味する。

my $pkg_name = "Hoge::Bohe";
require $pkg_name;

これは上記と同じ結果になる。

というのも、bare-wordの場合、Perl側で "::" をディレクトリセパレータにし、拡張子に勝手に.pmを付けてくれる。すなわち、

require Hoge::Bohe;
イコール
require "Hoge/Bohe.pm";

が成立する。というわけで、quoted stringでパッケージ名を指定してしまうと、本当に"Hoge::Bohe"というファイル名を見に行ってしまう。

もちろん、これを回避する方法はしっかりとperldocに記載されている。 requireのperldoc(http://perldoc.perl.org/functions/require.html)を見ると、以下のような回避策が有効とされている。

eval "require $pkg_name";

実際、これで test02.pl も問題なく Hoge/Bohe.pm をロードできた。(ただし、もちろんCHECK, INITのwarning付き)

• [ Prev ]
• [ Next ]
• [ Perl ]