X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FAttribute.pm;h=ef50e056de9731c75d0244d249731fd4a68ae16e;hb=80be11ca5100a1084bad811b722c6d55ccb99424;hp=011ff4e7dc910b126698dfcbc89946a72fc3230d;hpb=ca7941e5f5a56ef4e0c61835538c505645152085;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm index 011ff4e..ef50e05 100644 --- a/lib/Mouse/Meta/Attribute.pm +++ b/lib/Mouse/Meta/Attribute.pm @@ -56,11 +56,15 @@ sub generate_accessor { my $name = $attribute->name; my $key = $name; my $default = $attribute->default; - my $trigger = $attribute->trigger; my $type = $attribute->type_constraint; my $constraint = $attribute->find_type_constraint; my $builder = $attribute->builder; + my $trigger = $attribute->trigger; + my $before = $trigger->{before}; + my $after = $trigger->{after}; + my $around = $trigger->{around}; + my $accessor = 'sub { my $self = shift;'; @@ -68,21 +72,36 @@ sub generate_accessor { $accessor .= 'if (@_) { local $_ = $_[0];'; - if ($constraint) { - $accessor .= 'do { - my $display = defined($_) ? overload::StrVal($_) : "undef"; - Carp::confess("Attribute ($name) does not pass the type constraint because: Validation failed for \'$type\' failed with value $display") unless $constraint->(); - };' + if ($before) { + $accessor .= '$before->($self, $_, $attribute);'; + } + + if ($around) { + $accessor .= '$around->(sub { + my $self = shift; + $_ = $_[0]; + '; } - $accessor .= '$self->{$key} = $_;'; + if ($constraint) { + $accessor .= 'unless ($constraint->()) { + my $display = defined($_) ? overload::StrVal($_) : "undef"; + Carp::confess("Attribute ($name) does not pass the type constraint because: Validation failed for \'$type\' failed with value $display"); + }' + } + + $accessor .= '$self->{$key} = $_;'; - if ($attribute->is_weak_ref) { - $accessor .= 'Scalar::Util::weaken($self->{$key}) if ref($self->{$key});'; + if ($attribute->is_weak_ref) { + $accessor .= 'Scalar::Util::weaken($self->{$key}) if ref($self->{$key});'; + } + + if ($around) { + $accessor .= '}, $self, $_, $attribute);'; } - if ($trigger) { - $accessor .= '$trigger->($self, $_, $attribute);'; + if ($after) { + $accessor .= '$after->($self, $_, $attribute);'; } $accessor .= '}'; @@ -168,7 +187,7 @@ sub create { $args{class} = $class; %args = $self->canonicalize_args($name, %args); - $self->validate_args($name, %args); + $self->validate_args($name, \%args); $args{type_constraint} = delete $args{isa} if exists $args{isa}; @@ -234,29 +253,39 @@ sub canonicalize_args { sub validate_args { my $self = shift; my $name = shift; - my %args = @_; + my $args = shift; confess "You can not use lazy_build and default for the same attribute ($name)" - if $args{lazy_build} && exists $args{default}; + if $args->{lazy_build} && exists $args->{default}; confess "You cannot have lazy attribute ($name) without specifying a default value for it" - if $args{lazy} && !exists($args{default}) && !exists($args{builder}); + if $args->{lazy} + && !exists($args->{default}) + && !exists($args->{builder}); confess "References are not allowed as default values, you must wrap the default of '$name' in a CODE reference (ex: sub { [] } and not [])" - if ref($args{default}) - && ref($args{default}) ne 'CODE'; + if ref($args->{default}) + && ref($args->{default}) ne 'CODE'; confess "You cannot auto-dereference without specifying a type constraint on attribute $name" - if $args{auto_deref} && !exists($args{isa}); + if $args->{auto_deref} && !exists($args->{isa}); confess "You cannot auto-dereference anything other than a ArrayRef or HashRef on attribute $name" - if $args{auto_deref} - && $args{isa} ne 'ArrayRef' - && $args{isa} ne 'HashRef'; + if $args->{auto_deref} + && $args->{isa} ne 'ArrayRef' + && $args->{isa} ne 'HashRef'; + + if ($args->{trigger}) { + if (ref($args->{trigger}) eq 'CODE') { + $args->{trigger} = { + after => $args->{trigger}, + }; + } - confess "Trigger must be a CODE or HASH ref on attribute ($name)" - if $args{trigger} - && ref($args{trigger}) ne 'CODE' && ref($args{trigger}) ne 'HASH'; + confess "Trigger must be a CODE or HASH ref on attribute ($name)" + if $args->{trigger} + && ref($args->{trigger}) ne 'HASH'; + } return 1; } @@ -422,7 +451,7 @@ on success, otherwise Ces. Canonicalizes some arguments to create. In particular, C is canonicalized into C, C, etc. -=head2 validate_args Name, %args -> 1 | ERROR +=head2 validate_args Name, \%args -> 1 | ERROR Checks that the arguments to create the attribute (ie those specified by C) are valid.