【Perl】”サブクラスをインスタンス化するメソッド”を動的に追加する方法を考える
投稿日： / 更新日：
この記事は2年以上前に書かれたものです。情報が古い可能性があります。
CatalystやDBIx::Classなどのように、
|
1 2 3 |
use My::Class; # no need to use "My::Class::Sub::Class" my $instance = My::Class->get_instance('Sub::Class'); |
こんな感じで、あらかじめサブクラスをuseしなくとも、必要になった時に動的にサブクラスをuseして欲しい場合があります。
2012/11/26 12:55追記：そもそも、このような事をしたい背景として、サブクラスを後で追加した場合に大元のクラスに変更を加えたくない、ということが挙げられます。
お手軽に実現しようと思った場合、UNIVERSAL::requireを使用する方法があります。サンプルコード等は以下のとおりです(ついでに、クラスのインスタンス取得にsingletonパターンを使用しています)。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 |
●My/Class.pm package My::Class; use Modern::Perl; use UNIVERSAL::require; use Carp "croak"; our $INSTANCE; sub new { bless {}, shift } sub instance { my ($self, $subclass) = @_; croak "subclass name not supplied\n" unless $subclass; my $fqcn = __PACKAGE__ . "::$subclass"; $fqcn->use or croak "can't load $fqcn: $@\n"; return $INSTANCE ||= $fqcn->new; } 1; __END__ ●My/Class/Sub/Class.pm package My::Class::Sub::Class; use Modern::Perl; use parent "My::Class"; 1; __END__ ●test.pl use Modern::Perl; use Test::More; use Test::Exception; use My::Class; isa_ok( My::Class->instance("Sub::Class"), "My::Class::Sub::Class", "My::Class->instance (succeeded)", ); throws_ok { My::Class->instance("Sub::Class::Which::Does::Not::Exist") } qr/can't load/, "My::Class->instance (failed as expected)"; done_testing; __END__ ●動作確認 $ perl test.pl ok 1 - My::Class->instance (succeeded) isa My::Class::Sub::Class ok 2 - My::Class->instance (failed as expected) 1..2 |
実行例のとおり、存在するサブクラスについてはインスタンスが取得でき、存在しないサブクラスについては例外が投げられました。これは期待どおりの動作です。
では、上記より一歩進めて、サブクラスをインスタンス化するメソッドの名前を”サブクラス名(をアンダースコア記法に直したもの)”にしたい場合、どのようにすれば良いでしょうか。実行したいイメージは以下のとおりです。
|
1 2 3 4 |
use My::Class; # no need to use "My::Class::Sub::Class" # no need to predefine "My::Class::sub_class()" my $instance = My::Class->sub_class; |
存在するサブクラスのモジュールファイルを全てリストアップして、それぞれのクラスをインスタンス化するためのメソッドを動的に作成する、という方法も考えられますが、もう少し手っ取り早く実現しようとした場合、AUTOLOADを使う方法が考えられます。早速、My::Class.pmを改造してみます。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 |
●My/Class.pm package My::Class; use Modern::Perl; use UNIVERSAL::require; use Carp "croak"; our $INSTANCE; our $AUTOLOAD; sub new { bless {}, shift } sub instance { my ($self, $subclass) = @_; croak "subclass name not supplied\n" unless $subclass; my $fqcn = __PACKAGE__ . "::$subclass"; $fqcn->use or croak "can't load $fqcn: $@\n"; return $INSTANCE ||= $fqcn->new; } sub AUTOLOAD { my ($method_name) = $AUTOLOAD =~ /.*::(.+)/; return if $method_name eq "DESTROY"; no strict 'refs'; *{$AUTOLOAD} = sub { my $subclass = join "::", (map { ucfirst } split "_", $method_name); __PACKAGE__->instance($subclass); }; goto &$AUTOLOAD; } 1; __END__ |
ここで特筆すべきは、(該当するサブルーチンがないために)AUTOLOADが呼び出された後、それ以後同じサブルーチンについて再度AUTOLOADが呼び出されないで済むよう、サブルーチン名をパッケージのシンボルテーブルに登録している点です。ここでは、クロージャをグロブに割り当てることで、それを実現しています。また、サブルーチン名をシンボルテーブルに登録した後は、そのサブルーチンを&付きのgoto文で呼び出します。これによりサブルーチン呼び出しのカレントスタックフレームが取り除かれ、呼び出し元は直接その(新しく登録された)サブルーチンを呼び出したのと同じことになります。なお、この辺りのテクニックは、「実用Perlプログラミング」(O’Reilly)に詳しく説明されています。
それでは、テストスクリプトにテスト項目を追加して、再度動作確認してみます。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 |
●test.pl use Modern::Perl; use Test::More; use Test::Exception; use My::Class; isa_ok( My::Class->instance("Sub::Class"), "My::Class::Sub::Class", "My::Class->instance (succeeded)", ); throws_ok { My::Class->instance("Sub::Class::Which::Does::Not::Exist") } qr/can't load/, "My::Class->instance (failed as expected)"; isa_ok( My::Class->sub_class, "My::Class::Sub::Class", "My::Class->subclass_name (succeeded)", ); throws_ok { My::Class->sub_class_which_does_not_exist } qr/can't load/, "My::Class->subclass_name (failed as expected)"; done_testing; __END__ ●動作確認 $ perl test.pl ok 1 - My::Class->instance (succeeded) isa My::Class::Sub::Class ok 2 - My::Class->instance (failed as expected) ok 3 - My::Class->subclass_name (succeeded) isa My::Class::Sub::Class ok 4 - My::Class->subclass_name (failed as expected) 1..4 |
期待どおり動作することが確認できました。
なお、上記のAUTOLOADを使用した方法のcaveatとして、サブクラス名(のそれぞれの単語)は先頭が大文字で、2文字目以降は全て小文字である必要があります(サブルーチン名からサブクラス名への変換ロジックを見れば一目瞭然ではありますが…)。これにうまく対処したバージョンの作成は、次回の課題にしたいと思います。
以上、Perlに関するトピックをご紹介しました。
