【Perl】”サブクラスをインスタンス化するメソッド”を動的に追加する方法を考える(その2)
投稿日： / 更新日：
前回のコード例では、インスタンス化できるサブクラス名に制約がありました。今回は、その制約を受けずに済むよう、前回のコードを改造してみたいと思います。
改造後のメインクラスは以下のとおりです。なお、改造前のコードにあった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 |
●My/Class.pm package My::Class; use Modern::Perl; use UNIVERSAL::require; use Carp "croak"; BEGIN { use Module::Find; my $class = __PACKAGE__; for my $subclass (findallmod $class) { $subclass =~ s/${class}:://; my $method = join "_", map { lc } split "::", $subclass; no strict 'refs'; *{"${class}::${method}"} = sub { $class->instance($subclass) }; } } 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 $fqcn->new; } 1; __END__ |
改造前のコードにあったAUTOLOADサブルーチンは、不要なため削除しました。代わりにBEGINブロック内で、@INC内に存在する全てのサブクラスをModule::Findモジュールのfindallmod関数を使用して検索し、見つかったサブクラス名を加工してインスタンス化のためのメソッドを生成するとともに、前回同様クロージャを使用してパッケージのシンボルテーブルに登録しています。なお、今回はAUTOLOADを使用せず、メソッドは呼び出し時にシンボルテーブルに存在している必要があるため、BEGINブロック内でコンパイル時に実行するようにしています。ちなみにあまり知られていないことですが、Perlではプログラムの実行前に、ソースコードがメモリ上でバイトコードへコンパイルされます。そのコンパイルがあまりにも高速に実行されるため、「Perlではソースコードがそのまま逐次実行される」という誤解が一般に広まっているという悲しい事実があります。
メインクラスの改造後は、サブクラスとテストコードを実装します。今回は、前回使用したサブクラスに加えて、クラス名がパスカルケースになっていないサブクラスを一つ追加し、改造後のロジックに問題がないかどうかを確認します。
|
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 59 60 61 62 63 |
●My/Class/Sub/Class.pm package My::Class::Sub::Class; use Modern::Perl; use parent "My::Class"; 1; __END__ ●My/Class/Sub/KLASS.pm package My::Class::Sub::KLASS; 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)", ); isa_ok( My::Class->instance("Sub::KLASS"), "My::Class::Sub::KLASS", "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)", ); isa_ok( My::Class->sub_klass, "My::Class::Sub::KLASS", "My::Class->subclass_name (succeeded)", ); throws_ok { My::Class->sub_class_which_does_not_exist } qr/Can't locate object method/, "My::Class->subclass_name (failed as expected)"; done_testing; __END__ |
なお、テストコードのうち最後のテスト項目について、メインクラスがAUTOLOADを使用しなくなったことにより、例外として送出されるメッセージを「メソッドが見つからない」という内容に変更しています。
テストコードの実行結果は以下のとおりです。
|
1 2 3 4 5 6 7 8 9 |
●動作確認 $ perl test.pl ok 1 - My::Class->instance (succeeded) isa My::Class::Sub::Class ok 2 - My::Class->instance (succeeded) isa My::Class::Sub::KLASS ok 3 - My::Class->instance (failed as expected) ok 4 - My::Class->subclass_name (succeeded) isa My::Class::Sub::Class ok 5 - My::Class->subclass_name (succeeded) isa My::Class::Sub::KLASS ok 6 - My::Class->subclass_name (failed as expected) 1..6 |
全て、問題なく動作することが確認できました。これで、以後はサブクラスをいくらアドオンしてもメインクラスに手を加える必要はなく、モジュールのメンテナンスがラクになります。また、モジュールの使用者はメインクラスだけをuseすれば済むため、大量のuse文を書く必要から解放されます。
以上、Perlに関するトピックをご紹介しました。
