Perlにおける例外処理

2007-02-14 chikkun

例外処理とは
dieとcroak
エラー管理
- とりあえず簡単な例

例外処理とは

自分でも少し不安なところがあるので、もしかしたら嘘を書いてしまうかもしれませんがご勘弁下さい。

なんだか例外というと、まるで下のような割り算において0で割ったしまったような時に起こるもののように感じるかもしれません。

use strict;
use warnings;

print &div( 10, 5 );
print &div( 10, 0 );
print "終了!\n";

sub div {
    my $arg1   = shift;
    my $arg2   = shift;
    my $ans    = $arg1 / $arg2;
    my $string = "$arg1 / $arg2 = $ans\n";
    return $string;
}

を実行すれば、

Illegal division by zero at testException1.pl line 10.
10 / 5 = 2

のように途中で終わってしまい、エラメッセージが出力されます。

確かに、これも例外の1つかもしれません。しかし、別にこういう何らかの不正な操作で途中でPerlが終わってしまうものだけを例外というわけではありません。自分が作成しているコードやクラスなどで、あってはならないものを自分で例外とすることも可能です。例えば、上記のコードを自分で制御することも可能です(Perl任せじゃなく)。

この辺は、人によって意見が違うところでしょうが、例えば、Javaの場合例外管理は全てクラスで管理するわけですが、次のような分類をしています。

java.lang.Object
  |
  +--java.lang.Throwable
       |
       +--java.lang.Error                  <- 例外処理任意。エラー。
       |
       +--java.lang.Exception
            |
            +--java.lang.RuntimeException  <- 例外処理任意。実行時例外。
            |
            +--そのほか                    <- 例外処理必須。チェック例外（検査例外）。

上記のjava.lang.Errorは「アプリケーション側で処理できない JavaVM で検出されるようなエラーです。具体的には、メモリ不足、AWTエラー、スレッド・エラーなどに対応するクラスが派生しています。Java プログラムで例外処理しようにも、プログラムの実行の継続ができないので、例外処理は不可能です。」とあるように、もともとこれは管理のしようがありません。

java.lang.RuntimeExceptionは「RuntimeException を継承した、例外処理が必須でない例外を、非検査例外／非チェック例外 (unchecked exceptions classes) と呼びます」が、Javaでは「ゼロ除算などで発生する算術例外 ArithmeticException」などがこれにあたります。

しかし、これはしっかりプログラムすることによって、避けられるものですし、java.lang.Exceptionを継承した、クラス(検査例外／チェック例外)を使えば、Javaはtry/catchブロックを強制してくるので、それらで避けるという方法も考えられます。

つまり、Javaではこのように分類しているわけで、プログラム全般でエラーと例外を分ける汎用的な定義はないように思います。ここでは、エラーも例外も例外として扱います。

さて、具体的に見ていきましょう。

use strict;
use warnings;

print &div( 10, 5 );
print &div( 10, 0 );
print "終了!\n";

sub div {
    my $arg1 = shift;
    my $arg2 = shift;
    if ( !defined($arg2) || $arg2 == 0 ) {
        die "そりゃ、ないだろう。0じゃ割れません!!";
    }
    my $ans    = $arg1 / $arg2;
    my $string = "$arg1 / $arg2 = $ans\n";
    return $string;
}

の、

if ( !defined($arg2) || $arg2 == 0 ) {
    die "そりゃ、ないだろう。0じゃ割れません!!";
}

を実行すると、

そりゃ、ないだろう。0じゃ割れません!! at testException2.pl line 11.
10 / 5 = 2

が出力されます。

このように引数が渡されていないとか、0を渡された場合にdie "message"で、Perlのプログラムを終了させることが可能です。ただ、いずれにしろ、Perlはdieの場所で終了していますので、最後の「終了」は出力されません。

余談ですが、もしかしたら、お気づきかもしれません。1つめの

print &div( 10, 5 );

はエラーにならないはずなのに、何故か

print &div( 10, 0 );

で出力される、エラーメッセージ

die "そりゃ、ないだろう。0じゃ割れません!!";

が先に出力されています。これはPerlがバッファリングということをやっていて、ある程度出力する文字列をためて、ある程度ためたら出力するという方法をとるので、先にエラーメッセージが先に出力されているわけです。これを解除するには

use strict;
use warnings;

$| = 1;
print &div( 10, 5 );
print &div( 10, 0 );
print "終了!\n";

sub div {
    my $arg1 = shift;
    my $arg2 = shift;
    if ( !defined($arg2) || $arg2 == 0 ) {
        die "そりゃ、ないだろう。0じゃ割れません!!";
    }
    my $ans    = $arg1 / $arg2;
    my $string = "$arg1 / $arg2 = $ans\n";
    return $string;
}

の

$| = 1;

を入れておくと、

10 / 5 = 2
そりゃ、ないだろう。0じゃ割れません!! at testException2.pl line 11.

のように、順番通り出力されます。

さて、このdieを使った方法は、Perl任せのエラー表示ではなく、自分なりのメッセージを出力できましたが、これだけじゃあまり意味がありません。そこで、とにかくプログラムを途中で終わらせないで、最後まで実行させたい場合はどうすればよいでしょうか。

use strict;
use warnings;

$| = 1;
eval { print &div( 10, 5 ); };
print "第２引数が渡されていないか、０を渡しているようです\n" if $@;
eval { print &div( 10, 0 ); };
print "第２引数が渡されていないか、０を渡しているようです\n" if $@;

print "終了!\n";

sub div {
    my $arg1 = shift;
    my $arg2 = shift;
    if ( !defined($arg2) || $arg2 == 0 ) {
        die "そりゃ、ないだろう。0じゃ割れません!!";
    }
    my $ans    = $arg1 / $arg2;
    my $string = "$arg1 / $arg2 = $ans\n";
    return $string;
}

を実行すると、

10 / 5 = 2
第２引数が渡されていないか、０を渡しているようです
終了!

が出力されます。これで、エラーが起こっても、最後の「終了」という文字が出力されますし、その上、エラーが起こったかどうかもチェックしています。

このように、

エラーが起こるかもしれないので、 eval{}; で囲んで、実行(tryする)
エラーが起こったら、 $@ に die "message" のmessageが入っているので、これを使ってエラーを捕まえる(catchする)
エラーが起こったときには、 die などを使って、例外を送出する(throwする)

を組み合わせて、例外を処理する方法を今回もう少しつっこんで考えています。

dieとcroak

先ほどの

use strict;
use warnings;
$| = 1;
print &div( 10, 5 );
print &div( 10, 0 );

sub div {
    my $arg1 = shift;
    my $arg2 = shift;
    if ( !defined($arg2) || $arg2 == 0 ) {
        die "そりゃ、ないだろう。0じゃ割れません!!";
    }
    my $ans    = $arg1 / $arg2;
    my $string = "$arg1 / $arg2 = $ans\n";
    return $string;
}

を実行した場合の出力は

10 / 5 = 2
そりゃ、ないだろう。0じゃ割れません!! at testException2.pl line 11.

となっていました。この２行目の

at testException2.pl line 11.

は、実行しているプログラムファイル名と、そしてdieを実行した行番号が出力されています。

このdieという関数をCarpという標準モジュールにあるcroakというものに変えてみましょう。

use strict;
use warnings;
use Carp;
$| = 1;
print &div( 10, 5 );
print &div( 10, 0 );

sub div {
    my $arg1 = shift;
    my $arg2 = shift;
    if ( !defined($arg2) || $arg2 == 0 ) {
        croak "そりゃ、ないだろう。0じゃ割れません!!";
    }
    my $ans    = $arg1 / $arg2;
    my $string = "$arg1 / $arg2 = $ans\n";
    return $string;
}

のようにuse Carp;を加え、dieをcroakにすると、

10 / 5 = 2
そりゃ、ないだろう。0じゃ割れません!! at testException4.pl line 11
    main::div(10, 0) called at testException4.pl line 6

が出力されます。dieとの違いは、

main::div(10, 0) called at testException4.pl line 6

が多いことです。debugをするときなど、dieのように、dieを実行させた場所だけではなく、それを実行したプログラムファイル名やその行番号などの情報があった方が何が悪いかを追っていくことが楽になります。この例では、6行目でdieを実行する関数を呼んだのが６行目だと言うことになります。

こんなに短いプログラムでは、もちろん、ほとんど意味にがないように思えるかもしれませんが、あるクラスが別のクラスを使っていて、さらにその別のクラスが別のクラスを使っていて、最後のクラスでエラーが起こったような場合など、dieした箇所だけじゃなく、それを呼んだものを階層で表示されないと、どこが悪いのかを追うのは相当難しくなります。

このようにエラーが起こった場所をトレースしていって、それらを全部表示することをStack Traceなどと言います。次の例を見てみましょう。

use strict;
use warnings;
use Carp;
$| = 1;
eval { print &mkStr( 10, 5 ); };

print "エラー発生 $@" if $@;

eval { print &mkStr( 10, 0 ); };

print "エラー発生 $@" if $@;

sub div {
    my $arg1 = shift;
    my $arg2 = shift;
    if ( !defined($arg2) || $arg2 == 0 ) {
        croak "そりゃ、ないだろう。0じゃ割れません!!";
    }
    my $ans = $arg1 / $arg2;
    return $ans;
}

sub mkStr {
    my $arg1   = shift;
    my $arg2   = shift;
    my $string = "$arg1 / $arg2 = ";
    my $ans;
    eval { $ans = &div( $arg1, $arg2 ); };
    if ($@) {
        croak("第二２引数が０か、渡されいません");
    }
    $string .= "$ans\n";
    return $string;
}

を実行すると、mainパッケージ(プログラムを実行しているところ)で&mkStr( 10, 5 )が実行され、この関数の中でさらに&divが実行されています。そして、そこでエラーが起こり始め(つまりcroakが実行される。或いは例外をthrowする)、それをmkStrでtry & catchしてthrowし、さらにmainでもtry & catchしています。

10 / 5 = 2
エラー発生 第二２引数が０か、渡されいません at testException5.pl line 35
      main::mkStr(10, 0) called at testException5.pl line 12
      eval {...} called at testException5.pl line 11

今回は、上記が出力されます。

エラー管理

エラーの種類が多くなってくると、これらを管理する必要が出てきます。つまり、1つのクラスの中で、2つ以上の例外が発生する可能性があったり、或いは1つのクラスの中で、複数のクラスを利用し、その1つ1つで色々な例外が発生したりすると、その例外毎にどういう風に対応するかを決めなくてはなりません。

つまり、例外を区別する必要が出てきます。その1つの方法としては、return 3というように返値で判断するという方法もあります。ただこの方法だと、プログラムの可読性が悪くなります(制作者以外の人はその数字が何を意味しているのかをしっかり頭に入れているわけじゃないでしょうから)。

別の方法として、上記のcroakの引数の文字列などで判断するという方法もあるかもしれません。例えば、

if ($@) {
    if ($@ =~ /そりゃ、ないだろう。0じゃ割れません!!/){
       ......
    }
}

という感じです。

ただ、これも数が増えてくると煩雑になりそうです。そこで、例外クラスを使って(Javaのように)、smartにやる方法を考えてみましょう。

とりあえず簡単な例

CPANにはErrorというのとException::Classがあり、色々試したのですが、今ひとつピンと来ない。

他のページなどや本などを見ると、Errorはクロージャーなどでメモリーリークがあるだとか、Exception::Classの方が細かい設定できると言うことが書いてあったりするけれど、Errorで使える

try {
        do_some_stuff();
        die "error!" if $condition;
        throw Error::Simple "Oops!" if $other_condition;
    }
    catch Error::IO with {
        my $E = shift;
        print STDERR "File ", $E->{'-file'}, " had a problem\n";
    }

という、Javaと同じような書き方も捨てがたい。Exception::Classの最後には

push @Exception::Class::Base::ISA, 'Error'
      unless Exception::Class::Base->isa('Error');

とかすると、Exception::Classでも使えると書いてあるんですけど、うまく動いてくれない(誰か、教えて!)。

一応の妥協点として、Exception::ClassとException::Class::TryCatchを併用する方法を、今回は採用しました。

さて、あまり良い例じゃないかもしれませんが、次のようなことを実装してみましょう。

ファイルからCSVファイルを読み取る。
CSVには3列のデータがある。
1列目と3列目には数字が、2列目はそれら数字の演算子が入っている([\*\+\/\-\%]に限定)。
mainパッケージで、3で取得した数字と演算子で計算して、答を出す。
4で得た答と式と共に、標準出力する。
CSVファイル内におかしなデータがあったら、そこでそのファイルは処理しない。
6の場合、なにが変だったかSTDERRにそのスタックトレースを表示する。

ちょっぴり、オブジェクト指向でこれらを実装するのにどんなクラスが必要かを考えてみましょう。

基本的には、Perlの実行ファイルが次のような3つのクラスを使い、それぞれ次のような例外を吐く可能性を想定します。

Caluculatorクラス(計算するクラス)
1. DividedByZeroException(0で割った例外)
2. ArgException(引数がおかしい場合の例外)
DataGetクラス次のCSVParserでスローされる例外を、再送出する。ただ、ファイルを作るのが面倒そうだったので、Factoryパターンのような形を取り、実際のファイルを取り込む場合は、DataGetクラス、データだけを返す場合はDataGetMockクラスを使うようにした。
CSVPaserクラス(CSVファイルを読み取り、データとして分解するクラス)
1. IOException(ファイルがないなどの例外)
2. CSVMalFormatException(桁数が違ったり、あるべきところに文字がないなどの例外)
3. NotOperatorException(かけ算や割り算などのCSVの2かためのデータが演算子でないときの例外)
4. NotNumericException(1桁目と3桁目が数字じゃないときの例外)
5. ArgException(引数がおかしい場合の例外)
Calcuratorクラス(式から答を返すクラス)
1. ArgException(引数がおかしい場合の例外)
2. NotOperatorException2(かけ算や割り算などのCSVの2かためのデータが演算子でないときの例外)
3. NotNumericException2(1桁目と3桁目が数字じゃないときの例外)
4. DividedByZeroException(0で割ろうとした場合の例外)

さあ、これをもとにまずは作成していきましょう。しかも、テストファーストも実行してみましょう。まずはテストケースから。そういえば、Test::Unit::TestCaseはインストールしていなかったから、perl -MCPAN -e 'install Test::Unit::TestCase'でインストールしてから(なんだかwin32だと失敗するようなので、手動でインストールした)、まずは、テストを走らせるtestRunner.plを作成。

#!/usr/bin/perl -w

use strict;
use Test::Unit::TestSuite;
use Test::Unit::Debug qw(debug_pkgs);
use Test::Unit::TestRunner;

my $suite = Test::Unit::TestSuite->empty_new("A Test Suite");

foreach my $file (@ARGV) {
    my $package   = Test::Unit::Loader::compile($file);
    my $test_case = Test::Unit::Loader::load_test_case($package);
    $suite->add_test($test_case) if $test_case;
}
my $testrunner = Test::Unit::TestRunner->new();
$testrunner->do_run($suite);

次に、ほとんど素のCSVParserTest.pmを作成。

package CSVParserTest;
use base qw(Test::Unit::TestCase);

sub new {
    my $self = shift()->SUPER::new(@_);
    return $self;
}

sub set_up {
    my $self = shift;
}

sub test_new {
    my $self = shift;
    my $csv = CSVParser->new();
}

1;

そして、

./testRunner.pl CSVParserTest.pm

と走らせたら、

.E
Time:  0 wallclock secs ( 0.00 usr +  0.00 sys =  0.00 CPU)

!!!FAILURES!!!
Test Results:
Run: 1, Failures: 0, Errors: 1

There was 1 error:
1) CSVParserTest.pm:15 - test_new(CSVParserTest)
Can't locate object method "new" via package "CSVParser" (perhaps you \
    forgot to load "CSVParser"?)

Test was not successful.

全くその通りで、そのCSVParser自体存在しないし、useもしていないので、失敗している。そこで、

そこで、とりあえず、CSVParser.pmを作成し、その中に

package CSVParser;

1;

とだけ書き込んで、

package CSVParserTest;
use base qw(Test::Unit::TestCase);
use Test::More;

sub new {
    my $self = shift()->SUPER::new(@_);
    return $self;
}

sub set_up {
    my $self = shift;
    use CSVParser;

}

sub test_new {
    my $self = shift;
    my $csv = CSVParser->new();
}

1;

として、実行すると

.E
Time:  0 wallclock secs ( 0.00 usr +  0.00 sys =  0.00 CPU)

!!!FAILURES!!!
Test Results:
Run: 1, Failures: 0, Errors: 1

There was 1 error:
1) CSVParserTest.pm:17 - test_new(CSVParserTest)
Can't locate object method "new" via package "CSVParser"

Test was not successful.

となる。パッケージは作ったらから良いとして、まだnewメソッドは作っていない。なので、ちょっといじってCSVParser.pmをインサイトアウトとして定義。

package CSVParser;
use strict;
use warnings;
use Carp;
use Class::Std;
{
    my %file : ATTR( :get<file> :set<file>);

}

1;

それで、実行すると、

.
Time:  0 wallclock secs ( 0.00 usr +  0.00 sys =  0.00 CPU)

OK (1 tests)

ふう、ようやくCSVPaserクラスのひな形を作成できた。さて、まずはこのクラスはCSVファイルからデータを読み取るものなので、テストケースに

package CSVParserTest;
use base qw(Test::Unit::TestCase);
use Test::More;

sub new {
    my $self = shift()->SUPER::new(@_);
    return $self;
}

sub set_up {
    my $self = shift;
}

sub test_new {
    my $self = shift;
    use CSVParser;
    my $csv = CSVParser->new();
    ############################
    $csv->set_file("test1.csv");
    $self->assert_equals( $csv->get_file(), "test1.csv", "file?" );
    my $data = $csv->getData();
    $self->assert_not_null($data);
    ############################
}

1;

を書き込む。このうち、

$csv->set_file("test1.csv");
$self->assert_equals( $csv->get_file(), "test1.csv", "file?" );

はClass::Stdを使うことにより、すでに

my %file : ATTR( :get<file> :set<file>);

で、ファイル名のセッター・ゲッターは実装済みなので、最初のassert_equalsはうまく行く。しかし次のgetDataめそっどは実装していないので、もちろんダメ。なので、ちょっぴり、CSVParser.pmに付け加えて、

package CSVParser;
use strict;
use warnings;
use Carp;
use Class::Std;
{
    my %file : ATTR( :get<file> :set<file>);

}

sub getData {
    my $this = shift;
    return 1;
}

1;

と1を返すメソッドを実装すると、

.
Time:  0 wallclock secs ( 0.05 usr +  0.01 sys =  0.06 CPU)

OK (1 tests)

と成功する。さあ、そろそろもう少し仕様を考えなきゃ。まずはCSVのParserはCPANのText::CSV_XSを使うことにし、newでファイル名を指定し、そのファイルがなかったら、例外をおこすようにしよう。.....。

....これから十数時間が経つ

と、すったもんだ色々やって、やっとこさ例ができあがりました(だいぶいい加減なできですが)。

データ

まずは、データから

test1.csv(存在しない)
test2.csv(正しい)
```
10,*,3
1,+,2
```
test3.csv(CSV形式が不正)
```
"I said, "Hi!""",Yes,"",2.34,,"1.09"
```
test4.csv(数字であるべきがa)
```
a,*,3
```
test5.csv(数字であるべきがb)
```
1,+,b
```
test6.csv(演算子であるべきがo)
```
1,o,2
```
test7.csv(正しい中身)
```
3,*,4
5,/,2
6,%,4
10,-,2
11,+,5
```

実行プログラム

calculatorFromFile.pl

#!/usr/local/bin/perl
use strict;
use warnings;
use Carp;
use RuntimeException;
use Exception::Class::TryCatch;
use DataGet;
use Calculator;

$| = 1;
my $file = "test1.csv";
my $dg = DataGetFactory->new( "completion", { file => $file } );
my $data;
try eval { $data = $dg->getData(); };
if ( catch my $e ) {
    print "-------------$file\n";
    warn $e->full_message, "\n", $e->trace->as_string, "\n";
    print "-------------$file\n";
}
else {
    print "-------------$file\n";
    print &getAnswer($data);
    print "-------------$file\n";
}

$file = "test2.csv";
$dg = DataGetFactory->new( "completion", { file => $file } );
try eval { $data = $dg->getData(); };
if ( catch my $e ) {
    print "-------------$file\n";
    warn $e->full_message, "\n", $e->trace->as_string, "\n";
    print "-------------$file\n";
}
else {
    print "-------------$file\n";
    print &getAnswer($data);
    print "-------------$file\n";
}

$file = "test3.csv";
$dg = DataGetFactory->new( "completion", { file => $file } );
try eval { $data = $dg->getData(); };
if ( catch my $e ) {
    print "-------------$file\n";
    warn $e->full_message, "\n", $e->trace->as_string, "\n";
    print "-------------$file\n";
}
else {
    print "-------------$file\n";
    print &getAnswer($data);
    print "-------------$file\n";
}

$file = "test4.csv";
$dg = DataGetFactory->new( "completion", { file => $file } );
try eval { $data = $dg->getData(); };
if ( catch my $e ) {
    print "-------------$file\n";
    warn $e->full_message, "\n", $e->trace->as_string, "\n";
    print "-------------$file\n";
}
else {
    print &getAnswer($data);
}

$file = "test5.csv";
$dg = DataGetFactory->new( "completion", { file => $file } );
try eval { $data = $dg->getData(); };
if ( catch my $e ) {
    print "-------------$file\n";
    warn $e->full_message, "\n", $e->trace->as_string, "\n";
    print "-------------$file\n";
}
else {
    print "-------------$file\n";
    print &getAnswer($data);
    print "-------------$file\n";
}

$file = "test6.csv";
$dg = DataGetFactory->new( "completion", { file => $file } );
try eval { $data = $dg->getData(); };
if ( catch my $e ) {
    print "-------------$file\n";
    warn $e->full_message, "\n", $e->trace->as_string, "\n";
    print "-------------$file\n";
}
else {
    print "-------------$file\n";
    print &getAnswer($data);
    print "-------------$file\n";
}

$file = "test7.csv";
$dg = DataGetFactory->new( "completion", { file => $file } );
try eval { $data = $dg->getData(); };
if ( catch my $e ) {
    print "-------------$file\n";
    warn $e->full_message, "\n", $e->trace->as_string, "\n";
    print "-------------$file\n";
}
else {
    print "-------------$file\n";
    print &getAnswer($data);
    print "-------------$file\n";
}

sub getAnswer {
    my $d = shift;
    my $str;
    foreach my $n (@$data) {
        my $arg1 = $n->[0];
        my $arg2 = $n->[2];
        my $op   = $n->[1];
        my $hash = { data => { arg1 => $arg1, op => $op, arg2 => $arg2 } };
        my $cal  = Calculator->new($hash);
        my $ans;
        try eval { $ans = $cal->calculate; };
        if ( catch my $e ) {
            warn $e->trace->as_string, "\n";
        }
        else {
            $str .= "$arg1 $op $arg2 = $ans\n";
        }
    }
    return $str;
}

エラークラス(ExceptionBase.pm)

package ExceptionBase;
##桃尻
use Exception::Class (
    'ExceptionBase' =>
        { fields => ['arg'], description => 'Exception Occurs!', },
    'IOException' => {
        isa         => "ExceptionBase",
        fields      => ['file'],
        description => 'I cannot open $file',
    },
    'CSVMalFormatException' => {
        isa         => "ExceptionBase",
        fields      => [ 'line_num', 'reason' ],
        description => 'something wrong at line:$line_num',
    },
    'NotNumericException' => {
        isa         => "ExceptionBase",
        fields      => [ 'mes', 'value' ],
        description => 'value is not numeric $mes',
    },
    'NotOperatorException' => {
        isa         => "ExceptionBase",
        fields      => [ 'mes', 'value' ],
        description => 'value is not operator $mes',
    },
    'ArgException' => {
        isa         => "ExceptionBase",
        fields      => ['args'],
        description => 'args is something wrong @$args',
    },
    'DividedByZeroException' => {
        isa         => "ExceptionBase",
        fields      => ['arg2'],
        description => 'arg2 must not be zero or undef  $arg2',
    },
);

sub ExceptionBase::full_message {
    my ($self) = @_;
    return 'なんらかの例外が起こりました。' . $self->arg;
}

sub IOException::full_message {
    my ($self) = @_;
    return 'ファイルをオープンできません!:' . $self->file;
}

sub CSVMalFormatException::full_message {
    my ($self) = @_;
    my $r = $self->reason;
    $r =~ s/[\n\r]$//g;
    return 'なんだかCSVがおかしいようです(line:'
        . $self->line_num
        . "/reason:"
        . $r . ")";
}

sub NotNumericException::full_message {
    my ($self) = @_;
    my $v      = $self->value;
    my $mes    = $self->mes;
    if ( !defined($v) || $v eq '' ) {
        $v = 'undef';
    }
    return '値が数字ではありません(value:' . $v . "/message:" . $mes . ")";
}

sub NotOperatorException::full_message {
    my ($self) = @_;
    my $v      = $self->value;
    my $mes    = $self->mes;
    if ( !defined($v) || $v eq '' ) {
        $r = 'undef';
    }
    return '値が演算子ではありません(value:' . $v . "/message:" . $mes . ")";
}

sub ArgException::full_message {
    my ($self) = @_;
    my $args = $self->args;
    my $str;
    my $arg = 1;
    if ( defined( $args->[0] ) ) {
        foreach my $val (@$args) {
            if ( !defined($val) || $val eq '' ) {
                $val = 'undef';
            }
            $val = "undef";
            if ( $arg == 1 ) {
                $str = "arg$arg = $val";
            }
            else {
                $str = ", arg$arg = $val";
            }
            $arg++;
        }
    }
    else {
        $str = "arg1 = undef";
    }
    return $str;
}

sub DividedByZeroException::full_message {
    my ($self) = @_;
    my $arg2 = $self->arg2;
    if ( !defined($arg2) ) {
        $arg2 = 'undef';
    }
    return 'arg2が0もしくはundefです(arg2:' . $arg2 . ")。";
}

1;

DataGetFactory.pm, DataGet.pm, DataGetMock.pm

package DataGetFactory;
use lib qw(/cus/KML/lib);
use base qw( Class::Factory );
use Carp;
use CSVParser;
use Exception::Class::TryCatch;
use ExceptionBase;
use Exception::Class;

sub init {
    my ( $this, $params ) = @_;
    my $f = $params->{file} || "";
    $this->{file} = $f;
    return $this;
}

sub getData {
    my $this = shift;
    my $csv;
    try eval { $csv = CSVParser->new( { file => $this->{file} } ) };
    ##IOExceptionが起こる可能性
    if ( catch( my $e, ['IOException'] ) ) {
        $e->rethrow;
    }

#CSVMalFormatException,NotNumericException,NotOperatorException,ArgExceptionが起こる可能性
    my $data;
    try eval { $data = $csv->getData() };

    ##IOExceptionが起こる可能性
    if (catch(
            my $e,
            [   'CSVMalFormatException', 'NotNumericException',
                'NotOperatorException',  'ArgException'
            ]
        )
        )
    {
        $e->rethrow;
    }

    return $data;
}

__PACKAGE__->add_factory_type( mock       => 'DataGetMock' );
__PACKAGE__->add_factory_type( completion => 'DataGet' );

1;



package DataGet;
use base qw( DataGetFactory );
sub init {
    my ( $self, $params ) = @_;
    $self->SUPER::init( $params );
    return $self;
}

1;



package DataGetMock;
use Carp;
use base qw( DataGetFactory );

sub init {
    my ( $self, $params ) = @_;
    $self->SUPER::init($params);
    return $self;
}

sub getData {
    my $this = shift;
    my $data
        = [ [ 1, '+', 3 ], [ 5, '*', 3 ], [ 6, '/', 3 ], [ 7, '%', 3 ], ];
    return $data;
}

1;

CSVParser.pm

package CSVParser;
use strict;
use warnings;
use Carp;
use ExceptionBase;
use Text::CSV_XS;
use Class::Std;
{
    my %file : ATTR( :get<file> :set<file>);

    sub BUILD {
        my ( $self, $obj_ID, $arg_ref ) = @_;
        if (   !defined($arg_ref)
            || !defined( $arg_ref->{file} )
            || !$arg_ref->{file} )
        {
            ArgException->throw( args => [] );
        }
        unless ( -e $arg_ref->{file} ) {
            IOException->throw( file => $arg_ref->{file} );
        }
        $file{$obj_ID} = $arg_ref->{file};
    }

    sub getData {
        my $this  = shift;
        my $fname = $file{ ident $this};
        my $csv   = Text::CSV_XS->new( { binary => 1 } );
        open( CSV_IN, "<$fname" );
        my $i = 0;
        my @record;
        while ( my $line = <CSV_IN> ) {
            if ( $line =~ /^ *?\#+/ ) {
                next;
            }
            if ( $csv->parse($line) ) {
                my @field = $csv->fields();
                if ( @field != 3 ) {
                    my $e = CSVMalFormatException->throw(
                        line_num => ++$i,
                        reason   => "桁が3じゃありません!"
                    );
                }
                foreach my $n ( 0 .. 2 ) {
                    my $val = $field[$n];
                    if ( $n == 0 || $n == 2 ) {
                        if ( $val !~ /\d+/ ) {
                          $n++;
                            NotNumericException->throw(
                                mes   => ++$i . "行目、$n 桁目です",
                                value => $val
                            );
                        }
                    }
                    if ( $n == 1 ) {
                        if ( $val !~ /^[\*\+\/\-\%]$/ ) {
                          $n++;
                            NotOperatorException->throw(
                                mes   => ++$i . "行目、$n 桁目です",
                                value => $val
                            );
                        }
                    }

                }
                push( @record, [@field] );
            }
            else {
                my $err = $csv->error_input();

                #$err =~ s/\n//;
                CSVMalFormatException->throw(
                    line_num => ++$i,
                    reason   => $err
                );
            }
            ++$i;
        }
        close(CSV_IN);
        return \@record;
    }

}

1;

Calculator.pm

package Calculator;
use strict;
use warnings;
use Carp;
use ExceptionBase;
use Class::Std;
{
    my %data : ATTR( :get<data> :set<data>);

    sub BUILD {
        my ( $self, $obj_ID, $arg_ref ) = @_;
        if (   !defined($arg_ref)
            || !defined( $arg_ref->{data} )
            || !$arg_ref->{data}
            || ref( $arg_ref->{data} ) ne "HASH" )
        {
            ArgException->throw( args => [] );
        }
        $data{$obj_ID} = $arg_ref->{data};
    }

    sub calculate {
        my $this = shift;
        my $data = $data{ ident $this};
        my $arg1 = $data->{arg1};
        my $op   = $data->{op};
        my $arg2 = $data->{arg2};

        if ( !defined($arg1) || $arg1 !~ /\d+/ ) {
            NotNumericException->throw(
                mes   => "arg1がおかしいようです",
                value => $arg1
            );
        }
        if ( !defined($arg2) || $arg2 !~ /\d+/ ) {
            NotNumericException->throw(
                mes   => "arg2がおかしいようです",
                value => $arg2
            );
        }
        if ( !defined($op) || $op !~ /^[\*\/\-\+\%]$/ ) {
            NotOperatorException->throw(
                mes   => "opがおかしいようです",
                value => $op
            );
        }

        if ( $op eq '/' && $arg2 == 0 ) {
            DividedByZeroException->throw( arg2 => $arg2 );
        }
        my $str = "$arg1 $op $arg2";
        my $ans = eval($str);
        return $ans;
    }
}

1;

testクラス3つ

DataGetTest.pm

package DataGetTest;
use base qw(Test::Unit::TestCase);
use English qw(-no_match_vars);
use DataGetFactory;
use Data::Dumper;

sub new {
    my $self = shift()->SUPER::new(@_);
    return $self;
}

sub set_up {
    my $self = shift;
}

sub test_new_mock {
    my $self = shift;
    my $d    = DataGetFactory->new( "mock", { file => "test.csv" } );
    my $data = $d->getData();

    $self->assert_equals( "1", $data->[0]->[0], "1行目1桁目" );
    $self->assert_equals( "+", $data->[0]->[1], "1行目2桁目" );
    $self->assert_equals( "3", $data->[0]->[2], "1行目3桁目" );

    $self->assert_equals( "5", $data->[1]->[0], "2行目1桁目" );
    $self->assert_equals( "*", $data->[1]->[1], "2行目2桁目" );
    $self->assert_equals( "3", $data->[1]->[2], "2行目3桁目" );

    $self->assert_equals( "6", $data->[2]->[0], "3行目1桁目" );
    $self->assert_equals( "/", $data->[2]->[1], "3行目2桁目" );
    $self->assert_equals( "3", $data->[2]->[2], "3行目3桁目" );

    $self->assert_equals( "7", $data->[3]->[0], "4行目1桁目" );
    $self->assert_equals( "%", $data->[3]->[1], "4行目2桁目" );
    $self->assert_equals( "3", $data->[3]->[2], "4行目3桁目" );

}

sub test_new {
    my $self = shift;
    my $d;
    my $data;
    $d = DataGetFactory->new( "completion", { file => "test1.csv" } );
    eval { $data = $d->getData(); };
    my $e = $EVAL_ERROR;
    $self->assert( $e, 'エラーがしっかり起こるか?' );
    $self->assert( $e->isa('IOException'), 'IOException?' );

    $d = DataGetFactory->new( "completion", { file => "test3.csv" } );
    eval { $data = $d->getData(); };
    $e = $EVAL_ERROR;
    $self->assert_null($data);
    $self->assert( $e, 'エラーがしっかり起こるか?' );
    $self->assert( $e->isa('CSVMalFormatException'),
        'CSVMalFormatException?' );

    $d = DataGetFactory->new( "completion", { file => "test4.csv" } );
    eval { $data = $d->getData(); };
    $e = $EVAL_ERROR;
    $self->assert( $e, 'エラーがしっかり起こるか?' );
    $self->assert_null($data);
$self->assert( $e->isa('NotNumericException'), 'NotNumericException?' );

    $d = DataGetFactory->new( "completion", { file => "test5.csv" } );
    eval { $data = $d->getData(); };
    $e = $EVAL_ERROR;
    $self->assert( $e, 'エラーがしっかり起こるか?' );
    $self->assert_null($data);
$self->assert( $e->isa('NotNumericException'), 'NotNumericException?' );

    $d = DataGetFactory->new( "completion", { file => "test6.csv" } );
    eval { $data = $d->getData(); };
    $e = $EVAL_ERROR;
    $self->assert( $e, 'エラーがしっかり起こるか?' );
    $self->assert_null($data);
$self->assert( $e->isa('NotOperatorException'), 'NotOperatorException?' );

    $d = DataGetFactory->new( "completion", { file => "test7.csv" } );
    eval { $data = $d->getData(); };

    $e = $EVAL_ERROR;
    $self->assert( !$e, 'エラーがしっかり起こらないか?' );
    $self->assert( $data, "データが入っている?" );

    $self->assert_equals( "3", $data->[0]->[0], "1行目1桁目" );
    $self->assert_equals( "*", $data->[0]->[1], "1行目2桁目" );
    $self->assert_equals( "4", $data->[0]->[2], "1行目3桁目" );

    $self->assert_equals( "5", $data->[1]->[0], "2行目1桁目" );
    $self->assert_equals( "/", $data->[1]->[1], "2行目2桁目" );
    $self->assert_equals( "2", $data->[1]->[2], "2行目3桁目" );

    $self->assert_equals( "6", $data->[2]->[0], "3行目1桁目" );
    $self->assert_equals( "%", $data->[2]->[1], "3行目2桁目" );
    $self->assert_equals( "4", $data->[2]->[2], "3行目3桁目" );

    $self->assert_equals( "10", $data->[3]->[0], "4行目1桁目" );
    $self->assert_equals( "-",  $data->[3]->[1], "4行目2桁目" );
    $self->assert_equals( "2",  $data->[3]->[2], "4行目3桁目" );

    $self->assert_equals( "11", $data->[4]->[0], "5行目1桁目" );
    $self->assert_equals( "+",  $data->[4]->[1], "5行目2桁目" );
    $self->assert_equals( "5",  $data->[4]->[2], "5行目3桁目" );

}

1;

CSVParserTest.pm

package CSVParserTest;
use base qw(Test::Unit::TestCase);
use English qw(-no_match_vars);

sub new {
    my $self = shift()->SUPER::new(@_);
    return $self;
}

sub set_up {
    my $self = shift;
}

sub test_new {
    my $self = shift;
    use CSVParser;
    my $file = "test1.csv";    ##存在しない
    my $csv;
    ##例外が起こり、その例外クラスがIOExceptionかどうかテスト
    eval { $csv = CSVParser->new( { file => $file } ); };
    my $e = $@;
    $self->assert( $EVAL_ERROR, 'エラーがしっかり起こるか?' );
    $self->assert( $e->isa('IOException'), 'IOException?' );

    ##存在するファイルでnewし、しっかりファイル名を取得できるかどうか
    $file = "test2.csv";                          ##存在する
    $csv = CSVParser->new( { file => $file } );
    $self->assert_equals( $csv->get_file(), "test2.csv", "file?" );

    ##例外が起こり、その例外クラスがIOExceptionかどうかテスト
    eval { $csv = CSVParser->new(); };
    $e = $EVAL_ERROR;
    print $e->trace->as_string . "///////";
    $self->assert( $EVAL_ERROR, 'エラーがしっかり起こるか?' );
    $self->assert( $e->isa('ArgException'), 'ArgException?' );
}

##データの正常系
sub test_geData {
    my $self = shift;
    my $file = "test2.csv";
    my $csv  = CSVParser->new( { file => $file } );
    my $data = $csv->getData();
    $self->assert_not_null($data);
    $self->assert_equals( "10", $data->[0]->[0], "1行目1桁目" );
    $self->assert_equals( "*",  $data->[0]->[1], "1行目2桁目" );
    $self->assert_equals( "3",  $data->[0]->[2], "1行目3桁目" );
    $self->assert_equals( "1",  $data->[1]->[0], "2行目1桁目" );
    $self->assert_equals( "+",  $data->[1]->[1], "2行目2桁目" );
    $self->assert_equals( "2",  $data->[1]->[2], "2行目3桁目" );

}

#データの以上系(仕様として、ファイルに異常があるとそれ以上なにもしない)
sub test_getDataException {
    my $self = shift;
    my $file = "test3.csv";
    my $csv  = CSVParser->new( { file => $file } );
    my $data;
    eval { $data = $csv->getData(); };
    my $e = $@;
    $self->assert_null($data);
    $self->assert( $e->isa('CSVMalFormatException'),
        'CSVMalFormatException?' );

    $file = "test4.csv";
    $csv = CSVParser->new( { file => $file } );
    eval { $data = $csv->getData(); };
    $e = $@;
    $self->assert_null($data);
$self->assert( $e->isa('NotNumericException'), 'NotNumericException?' );

    $file = "test5.csv";
    $csv = CSVParser->new( { file => $file } );
    eval { $data = $csv->getData(); };
    $e = $@;
    $self->assert_null($data);
$self->assert( $e->isa('NotNumericException'), 'NotNumericException?' );

    $file = "test6.csv";
    $csv = CSVParser->new( { file => $file } );
    eval { $data = $csv->getData(); };
    $e = $@;
    $self->assert_null($data);
$self->assert( $e->isa('NotOperatorException'), 'NotOperatorException?' );

}
1;

CalculatorTest.pm

package CalculatorTest;
use base qw(Test::Unit::TestCase);
use English qw(-no_match_vars);
use Calculator;
use DataGetFactory;
use Switch;

sub new {
    my $self = shift()->SUPER::new(@_);
    return $self;
}

sub set_up {
    my $self = shift;
}

sub test_calcException {
    my $self = shift;
    my $hash = { data => { arg1 => undef, op => '*', arg2 => 23 } };
    my $cal  = Calculator->new($hash);
    my $ans;
    eval { $ans = $cal->calculate; };
    my $e = $EVAL_ERROR;
    $self->assert_null( $ans, '答は返ってこない?' );
    $self->assert( $e, 'エラーがしっかり起こるか?' );
$self->assert( $e->isa('NotNumericException'), 'NotNumericException?' );

    $hash = { data => { arg1 => 12, op => '*', arg2 => "a" } };
    $cal = Calculator->new($hash);
    eval { $ans = $cal->calculate; };
    $e = $EVAL_ERROR;
    $self->assert_null( $ans, '答は返ってこない?' );
    $self->assert( $e, 'エラーがしっかり起こるか?' );
$self->assert( $e->isa('NotNumericException'), 'NotNumericException?' );

    $hash = { data => { arg1 => 12, op => 'op', arg2 => 21 } };
    $cal = Calculator->new($hash);
    eval { $ans = $cal->calculate; };
    $e = $EVAL_ERROR;
    $self->assert_null( $ans, '答は返ってこない?' );
    $self->assert( $e, 'エラーがしっかり起こるか?' );
$self->assert( $e->isa('NotOperatorException'), 'NotOperatorException?' );

}

sub test_calc1 {
    my $self = shift;
    my $hash = { data => { arg1 => 3, op => '*', arg2 => 23 } };
    my $cal  = Calculator->new($hash);
    my $ans  = $cal->calculate;
    $self->assert_num_equals( 69, $ans, "正常系" );
}

sub test_calc_from_file {
    my $self = shift;
    my $d = DataGetFactory->new( "completion", { file => "test7.csv" } );
    my $data;
    eval { $data = $d->getData(); };
    my $num = 1;
    foreach my $n (@$data) {
        my $arg1 = $n->[0];
        my $arg2 = $n->[2];
        my $op   = $n->[1];
        my $hash = { data => { arg1 => $arg1, op => $op, arg2 => $arg2 } };
        my $cal  = Calculator->new($hash);
        my $ans  = $cal->calculate;
        switch ($num) {
            case 1 {
                $self->assert_num_equals( 12, $ans, "正常系$num from file" );
            }
            case 2 {
                $self->assert_num_equals( 2.5, $ans, "正常系$num from file" );
            }
            case 3 {
                $self->assert_num_equals( 2, $ans, "正常系$num from file" );
            }
            case 4 {
                $self->assert_num_equals( 8, $ans, "正常系$num from file" );
            }
            case 5 {
                $self->assert_num_equals( 16, $ans, "正常系$num from file" );
            }
        }
        $num++;
    }
}

1;

上記を実行すると(test1.csv〜test7.csvを実行しているだけ)、

ファイルをオープンできません!:test1.csv
Trace begun at CSVParser.pm line 19
CSVParser::BUILD('CSVParser=SCALAR(0x102666fc)', 270952188, \
    'HASH(0x102a80a8)') called at \
    /usr/local/lib/perl5/site_perl/5.8.8/Class/Std.pm line 438
Class::Std::new('CSVParser', 'HASH(0x10120e54)') called at \
    DataGetFactory.pm line 20
eval {...} at DataGetFactory.pm line 20
DataGetFactory::getData('DataGet=HASH(0x102a0540)') called at \
    calculatorFromFile.pl line 14
eval {...} at calculatorFromFile.pl line 14

-------------test1.csv
-------------test2.csv
10 * 3 = 30
1 + 2 = 3
-------------test2.csv
-------------test3.csv
なんだかCSVがおかしいようです(line:1/reason:"I said, "Hi!""",Yes,"",2.34,,"1.09")
Trace begun at CSVParser.pm line 72
CSVParser::getData('CSVParser=SCALAR(0x102b1120)') called at \
    DataGetFactory.pm line 28
eval {...} at DataGetFactory.pm line 28
DataGetFactory::getData('DataGet=HASH(0x102b0e20)') called at \
    calculatorFromFile.pl line 42
eval {...} at calculatorFromFile.pl line 42

-------------test3.csv
-------------test4.csv
値が数字ではありません(value:a/message:1行目、1 桁目です)
Trace begun at CSVParser.pm line 49
CSVParser::getData('CSVParser=SCALAR(0x102b10e4)') called at \
    DataGetFactory.pm line 28
eval {...} at DataGetFactory.pm line 28
DataGetFactory::getData('DataGet=HASH(0x102a8078)') called at \
    calculatorFromFile.pl line 56
eval {...} at calculatorFromFile.pl line 56

-------------test4.csv
-------------test5.csv
値が数字ではありません(value:b/message:1行目、3 桁目です)
Trace begun at CSVParser.pm line 49
CSVParser::getData('CSVParser=SCALAR(0x102b13c0)') called at \
    DataGetFactory.pm line 28
eval {...} at DataGetFactory.pm line 28
DataGetFactory::getData('DataGet=HASH(0x102b1390)') called at \
    calculatorFromFile.pl line 68
eval {...} at calculatorFromFile.pl line 68

-------------test5.csv
-------------test6.csv
値が演算子ではありません(value:o/message:1行目、2 桁目です)
Trace begun at CSVParser.pm line 58
CSVParser::getData('CSVParser=SCALAR(0x102b58e0)') called at \
    DataGetFactory.pm line 28
eval {...} at DataGetFactory.pm line 28
DataGetFactory::getData('DataGet=HASH(0x102b1474)') called at \
    calculatorFromFile.pl line 82
eval {...} at calculatorFromFile.pl line 82

-------------test6.csv
-------------test7.csv
3 * 4 = 12
5 / 2 = 2.5
6 % 4 = 2
10 - 2 = 8
11 + 5 = 16
-------------test7.csv

となりました。ふう。

[2007-02-14 14:30]

by chikkun