[Perl] Class::Accessor::Children::Fast複数クラスのアクセサ生成
<<
作成日時 ： 2007/08/15 02:37
>>
トラックバック 0 / コメント 1
Class::Accessor でアクセサメソッドを生成するのは便利だけど、
多数のクラスのアクセサメソッドを一度に定義したいときは、
なんだかソースが冗長になってしまう気がする。
package MyClass::Foo;
use base qw( Class:Accessor::Fast );
__PACKAGE__->mk_ro_accessors(qw( jacob michael joshua ethan ));
package MyClass::Bar;
use base qw( Class:Accessor::Fast );
__PACKAGE__->mk_ro_accessors(qw( emily emma madison isabella ));
package MyClass::Baz;
use base qw( Class:Accessor::Fast );
__PACKAGE__->mk_ro_accessors(qw( haruka haruto miyu yuto ));
各子クラスで一度にアクセサを定義してくれるメソッドってないのかな？
package MyClass;
use base qw( Class::Accessor::Children::Fast );
__PACKAGE__->mk_child_ro_accessors(
Foo => [qw( jacob michael joshua ethan )],
Bar => [qw( emily emma madison isabella )],
Baz => [qw( haruka haruto miyu yuto )],
);
みたいな感じで、ハッシュのキーで子クラス名を指定して、
ハッシュの値（配列ref）でアクセサ名を指定する仕組み。
__PACKAGE__ が親クラス（子クラス名のprefix）になる。
やろうと思えば、YAML でクラス定義を書いたものを読み込んで
そこから mk_child_ro_accessors 一発で生成処理も可能になりそう。
というわけで、作ってみた。
package Class::Accessor::Children::Fast;
use base qw( Class::Accessor::Fast );
use Carp;
sub mk_child_accessors {
_mk_child_classes( mk_accessors => @_ );
}
sub mk_child_ro_accessors {
_mk_child_classes( mk_ro_accessors => @_ );
}
sub mk_child_wo_accessors {
_mk_child_classes( mk_wo_accessors => @_ );
}
sub _mk_child_classes {
my $method = shift;
my $base = shift;
while ( scalar @_ ) {
my $name = shift;
Carp::croak "Invalid child class name: $name" if ref $name;
Carp::croak "Odd arguments" unless scalar @_;
my $list = shift;
Carp::croak "Invalid accessors name: $list" unless ref $list;
my $child = $base.'::'.$name;
my $isa = $child.'::ISA';
{
no strict 'refs';
my $check = scalar grep { $_ eq __PACKAGE__ } @$isa;
push( @$isa, __PACKAGE__ ) unless $check;
$child->$method( @$list );
}
}
}
ちらりと Class::* なモジュールを見た限りでは、同種のものは見当たりませんでした。
念のため、テストなども書いて見たら、CPANうpしてみようかなと。
|
