ANONクラスの生成
ANONクラスを作りまくりたくなったのですが
Class::MOPを使ってもいいし
Moose::Meta::Class->create_anon_classとMooseつかってもいいんですけど、
ちょっと適当に作ってみた。
package Class::Anon; use strict; use warnings; sub create_anon_class_by_eval { my ($class, $pkg, $base) = @_; eval qq| package $pkg; use strict; use warnings; use base '$base'; 1; |; die "can't create row_class : $pkg $@" if $@; return $pkg; } sub create_anon_class_by_isa { my ($class, $pkg, $base) = @_; { no strict 'refs'; @{"$pkg\::ISA"} = $base; } return $pkg; } 'no Moooooooose';
evalしてやってもいいしISAをふがふがしてもつくれる。
test code:
use strict; use warnings; use Class::Anon; use Test::Declare; plan tests => blocks; describe 'Class::Anon test' => run { test 'create_anon_class_by_eval' => run { my $anon_class = Class::Anon->create_anon_class_by_eval('Japan::Kyoto','Japan'); is $anon_class, 'Japan::Kyoto'; is $anon_class->me, 'japan'; my $obj = $anon_class->new; isa_ok $obj, 'Japan'; }; test 'create_anon_class_by_isa' => run { my $anon_class = Class::Anon->create_anon_class_by_isa('Japan::Kanagawa','Japan'); is $anon_class, 'Japan::Kanagawa'; is $anon_class->me, 'japan'; my $obj = $anon_class->new; isa_ok $obj, 'Japan'; }; }; package Japan; sub new { bless {}, shift } sub me { 'japan' }
use strict; use warnings; use Benchmark; use Class::Anon; timethese(10000, { create_anon_class_by_eval => sub {Class::Anon->create_anon_class_by_eval('Japan::Kyoto','Japan')}, create_anon_class_by_isa => sub {Class::Anon->create_anon_class_by_isa('Japan::Kanagawa','Japan')}, }); package Japan; __END__ Benchmark: timing 10000 iterations of create_anon_class_by_eval, create_anon_class_by_isa... create_anon_class_by_eval: 3 wallclock secs ( 0.74 usr + 0.01 sys = 0.75 CPU) @ 13333.33/s (n=10000) create_anon_class_by_isa: 0 wallclock secs ( 0.02 usr + 0.00 sys = 0.02 CPU) @ 500000.00/s (n=10000) (warning: too few iterations for a reliable count)
まあ当然evalした方が遅いですが。
no Moooseなこんなモジュールないのかしらね。
データをイテレーションしながらオブジェクト化
したくなったのでMooseでもよかったのですが
これまたでっちあげてみた。
package Data::Object; use strict; use warnings; our $VERSION = '0.01'; use Data::Object::Iterator; sub new { my ($class, $args) = @_; my $itr = Data::Object::Iterator->new($args); return $itr; } 1; package Data::Object::Class; use strict; use warnings; use Sub::Install qw/install_sub/; sub new { my ($class, $data) = @_; my $self = bless $data, $class; $self->init; return $self; } sub init { my $self = shift; for my $field (keys %{$self->{data}} ) { next if $self->can($field); install_sub({ as => $field, code => $self->_razy_inflate_data($field), }); } } sub _razy_inflate_data { my ($self, $field) = @_; return sub { my $self = shift; if ( $self->{hooks}->{$field} ) { $self->{hooks}->{$field}->($self->{data}->{$field}); } else { $self->{data}->{$field}; } }; } 1; package Data::Object::Iterator; use strict; use warnings; use Digest::SHA1 qw/sha1_hex/; sub new { my ($class, $args) = @_; my $klass = 'Data::Object::Class::A' . sha1_hex $$ . $args; eval qq| package $klass; use strict; use warnings; use base 'Data::Object::Class'; 1; |; die "can't create klass : $klass $@" if $@; $args->{klass} = $klass; my $self = bless $args, $class; $self->reset; return $self; } sub iterator { my $self = shift; my $data = $self->{data}->[$self->{_position}++]; return unless $data; my $obj = $self->{klass}->new( +{ hooks => $self->{add_hooks}, data => $data, }, ); return $obj; } sub reset { my $self = shift; $self->{_position} = 0; return; } sub next { my $self = shift; $self->iterator; } 1;
test code:
use strict; use warnings; use Data::Object; use URI; use Test::Declare; plan tests => blocks * 3; my @data = ( +{ name => 'nekokak', url => 'http://d.hatena.ne.jp/nekokak/', }, +{ name => 'example', url => 'http://example.com/', }, ); describe 'test Date::Object' => run { test 'do test' => run { my $obj = Data::Object->new( { add_hooks => +{ url => sub { my $val = shift; return URI->new($val); }, }, data => \@data, } ); for my $data (@data) { my $row = $obj->next; is $row->name, $data->{name}; is $row->url, $data->{url}; isa_ok $row->url, 'URI::http'; } }; };
ここではANONクラス作るときにClass::Anonをつかわずに自前でevalしてます。
これもネタなので適当です。