基本 (コンストラクタ/継承/型)コンストラクタsub BUILD { my ($self, $args) = @_; } new()は使わない。 継承package Dog; use Moose; extends 'Animal'; typeによる型の作成package Obj; use Moose; use Moose::Util::TypeConstraints; use Time::Piece; type 'Obj::Time::Piece' => where { defined $_ ? $_->isa('Time::Piece') : 1 }; has tm => ( is => 'rw', isa => 'Obj::Time::Piece', ); package main; use Data::Dumper; use Time::Piece; use DateTime; my $tp = Time::Piece->new; my $dt = DateTime->now; my $t1 = Obj->new( tm => $tp ); # OK my $t2 = Obj->new( tm => undef ); # OK my $t3 = Obj->new( tm => $dt ); # Error!
subtypeによる型のカスタマイズ(親クラスの型の継承)package Obj; use Moose; use Moose::Util::TypeConstraints; subtype 'Obj::Int' => as 'Int' => where { $_ >= 10 } => message { "$_ is under 10" }; has n => ( is => 'rw', isa => 'Obj::Int', ); package main; my $o = Obj->new; $o->n(9);
coerceによる型の強制変換package Obj; use Mouse; use Mouse::Util::TypeConstraints; coerce 'Int' => from 'Str' => via { 1 } => from 'Undef' => via { 0 }; has n => ( is => 'rw', isa => 'Int', coerce => 1, ); package main; my $o = Obj->new; $o->n('abc'); print $o->n,"\n"; # 1 $o->n(undef); print $o->n,"\n"; # 0
参考
subypeとcoerceを使ってDateTimeアトリビュートを実装package Obj; use Mouse; use Mouse::Util::TypeConstraints; use DateTime::Format::Pg; subtype 'Obj::DateTime' => as 'DateTime'; coerce 'Obj::DateTime' => from 'Str' => via { DateTime::Format::Pg->parse_date($_) }; => from 'Undef' => via { DateTime->now }; has dt => ( is => 'rw', isa => 'Obj::DateTime', coerce => 1, ); package main; my $o = Obj->new; $o->dt('2009-02-03'); print $o->dt->ymd,"\n"; aroundによるゲッターの拡張package Obj; use Moose; has n => ( is => 'rw', isa => 'Int', ); around 'n' => sub { my $next = shift; my $self = shift; return $self->$next . '!' unless @_; my $arg = shift; return $self->$next($arg); }; package main; my $o = Obj->new; $o->n(10); print $o->n, "\n"; # 10!とビックリがつく http://search.cpan.org/perldoc?Moose::Manual::FAQ#How_can_I_inflate/deflate_values_in_accessors? メソッド・アトリビュート一覧を取得するpackage Obj; use Moose; has n => ( is => 'rw', ); package main; use Data::Dumper; my $o = Obj->new; print Dumper $o->get_attribute_list; print Dumper $o->get_method_list;
参考 |
|