動的な継承クラス生成
ちょっと脳みそをPerlモードにして集中しなきゃならんので、ウォーミングアップなどを。
必要に応じてクラスを動的に生成できるかどうか、実施で試してみた。文字コードは全てutf8Nで。
Object.pm
package Object; use strict; use utf8; use HTML::Template; our $t = HTML::Template->new( filename=>'class.tmpl' ); use base qw ( Class::Accessor ); __PACKAGE__->mk_accessors(qw( dummy )); sub is { my $self = shift; return $_[0] eq __PACKAGE__ ? 1 : (); } our %class_list = (); sub make_child_class { # 子クラスを作る。作った子クラスの名前を返す。 # 引数には、子クラスの名前を入れる。 # 元になったクラスのクラス名+'::'.与えた子クラス名のクラスを作る。 my $self = shift; my $child_name = shift; $child_name eq '' and return (); # 子クラス名は必ず与えようね。 my $class = ref $self; $class ||= $self; my $child_class = $class.'::'.$child_name; unless ( $class_list{$child_class} ) { $t->param(class_name=>$child_class); $t->param(parent=>$class); $t->param(name=>$child_name); $class_list{$child_class} = $t->output; eval $class_list{$child_class}; } return $child_class; } 1;
class.tmpl
{ package <!--TMPL_VAR name="class_name"-->; use base qw ( <!--TMPL_VAR name="parent"--> ); sub is { my $self = shift; my $test = shift; $test ||= 'Object'; $test eq '<!--TMPL_VAR name="name"-->' and return 1; return $self->SUPER::is($test); } }
main.pl
use strict; use utf8; use Data::Dumper; use Object; my $ob1 = Object->new; my $child_class = Object->make_child_class('Item'); my $ob2 = $child_class->new; print Data::Dumper->new([$ob1, $ob2], [qw( ob1 ob2 )])->Dump(); print $ob2->is('Item');
結論
できるっぽい。
たとえば、
- Object
- Object::Item
- Object::Item::Equipment
- Object::Item::Equipment::Weapon
- Object::Item::Equipment::Weapon::Sword
- Object::Item::Equipment::Weapon::Sword::Broadsword
なんて継承関係のある親子クラスを、必要な時に必要なだけ作れると言うことだ。
まあ、そゆことだわな。