X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FAttribute.pm;h=0d7f8241eb4d47f44af5c4e08a079fa076ccc980;hb=d16fe7d79e7f254ed479b58681d716e78b3e8caf;hp=050ec49c2c2ece61e39e50b7ca0435972220e143;hpb=1bbaa8edd19af95a395eb59d34602c1b85def6d6;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm index 050ec49..0d7f824 100644 --- a/lib/Mouse/Meta/Attribute.pm +++ b/lib/Mouse/Meta/Attribute.pm @@ -20,22 +20,22 @@ sub new { bless \%args, $class; } -sub name { $_[0]->{name} } -sub class { $_[0]->{class} } -sub _is_metadata { $_[0]->{is} } -sub is_required { $_[0]->{required} } -sub default { $_[0]->{default} } -sub is_lazy { $_[0]->{lazy} } -sub is_lazy_build { $_[0]->{lazy_build} } -sub predicate { $_[0]->{predicate} } -sub clearer { $_[0]->{clearer} } -sub handles { $_[0]->{handles} } -sub is_weak_ref { $_[0]->{weak_ref} } -sub init_arg { $_[0]->{init_arg} } -sub type_constraint { $_[0]->{type_constraint} } -sub trigger { $_[0]->{trigger} } -sub builder { $_[0]->{builder} } -sub should_auto_deref { $_[0]->{auto_deref} } +sub name { $_[0]->{name} } +sub associated_class { $_[0]->{associated_class} } +sub _is_metadata { $_[0]->{is} } +sub is_required { $_[0]->{required} } +sub default { $_[0]->{default} } +sub is_lazy { $_[0]->{lazy} } +sub is_lazy_build { $_[0]->{lazy_build} } +sub predicate { $_[0]->{predicate} } +sub clearer { $_[0]->{clearer} } +sub handles { $_[0]->{handles} } +sub is_weak_ref { $_[0]->{weak_ref} } +sub init_arg { $_[0]->{init_arg} } +sub type_constraint { $_[0]->{type_constraint} } +sub trigger { $_[0]->{trigger} } +sub builder { $_[0]->{builder} } +sub should_auto_deref { $_[0]->{auto_deref} } sub has_default { exists $_[0]->{default} } sub has_predicate { exists $_[0]->{predicate} } @@ -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 .= '}'; @@ -165,7 +184,7 @@ sub create { my ($self, $class, $name, %args) = @_; $args{name} = $name; - $args{class} = $class; + $args{associated_class} = $class; %args = $self->canonicalize_args($name, %args); $self->validate_args($name, \%args); @@ -248,17 +267,24 @@ sub validate_args { if ref($args->{default}) && ref($args->{default}) ne 'CODE'; - confess "You cannot auto-dereference without specifying a type constraint on attribute $name" + confess "You cannot auto-dereference without specifying a type constraint on attribute ($name)" if $args->{auto_deref} && !exists($args->{isa}); - confess "You cannot auto-dereference anything other than a ArrayRef or HashRef on attribute $name" + 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'; - 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'; + 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 ref($args->{trigger}) ne 'HASH'; + } return 1; } @@ -349,7 +375,7 @@ installed. Some error checking is done. =head2 name -> AttributeName -=head2 class -> OwnerClass +=head2 associated_class -> OwnerClass =head2 is_required -> Bool