X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FAttribute.pm;h=051ebe3130cded641f88319f102907f28f53dc4d;hb=7f7406a5026ff1f517e7753e12068a69620dace6;hp=225ea59fe0a0f4690c587874a2818abe714abe30;hpb=97661b774fd00a06d0eecdc17af4c6ca9ff0bee1;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm index 225ea59..051ebe3 100644 --- a/lib/Mouse/Meta/Attribute.pm +++ b/lib/Mouse/Meta/Attribute.pm @@ -4,7 +4,7 @@ use strict; use warnings; use Carp 'confess'; -use Scalar::Util 'blessed'; +use Mouse::Util qw/blessed weaken/; sub new { my $class = shift; @@ -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} } @@ -50,6 +50,13 @@ sub _create_args { $_[0]->{_create_args} } +sub inlined_name { + my $self = shift; + my $name = $self->name; + my $key = "'" . $name . "'"; + return $key; +} + sub generate_accessor { my $attribute = shift; @@ -59,49 +66,31 @@ sub generate_accessor { 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 $trigger = $attribute->trigger; my $accessor = 'sub { my $self = shift;'; if ($attribute->_is_metadata eq 'rw') { $accessor .= 'if (@_) { - local $_ = $_[0];'; - - if ($before) { - $accessor .= '$before->($self, $_, $attribute);'; + '; + + if ($constraint) { + $accessor .= 'local $_ = $_[0]; + 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"); + }' } - if ($around) { - $accessor .= '$around->(sub { - my $self = shift; - $_ = $_[0]; - '; - } - - 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} = $_;'; + $accessor .= '$self->{$key} = $_[0];'; - if ($attribute->is_weak_ref) { - $accessor .= 'Scalar::Util::weaken($self->{$key}) if ref($self->{$key});'; - } - - if ($around) { - $accessor .= '}, $self, $_, $attribute);'; + if ($attribute->is_weak_ref) { + $accessor .= 'weaken($self->{$key}) if ref($self->{$key});'; } - if ($after) { - $accessor .= '$after->($self, $_, $attribute);'; + if ($trigger) { + $accessor .= '$trigger->($self, $_[0], $attribute);'; } $accessor .= '}'; @@ -138,7 +127,9 @@ sub generate_accessor { $accessor .= 'return $self->{$key}; }'; - return eval $accessor; + my $sub = eval $accessor; + confess $@ if $@; + return $sub; } sub generate_predicate { @@ -147,16 +138,20 @@ sub generate_predicate { my $predicate = 'sub { exists($_[0]->{$key}) }'; - return eval $predicate; + my $sub = eval $predicate; + confess $@ if $@; + return $sub; } sub generate_clearer { my $attribute = shift; my $key = $attribute->name; - my $predicate = 'sub { delete($_[0]->{$key}) }'; + my $clearer = 'sub { delete($_[0]->{$key}) }'; - return eval $predicate; + my $sub = eval $clearer; + confess $@ if $@; + return $sub; } sub generate_handles { @@ -175,6 +170,7 @@ sub generate_handles { }'; $method_map{$local_method} = eval $method; + confess $@ if $@; } return \%method_map; @@ -184,7 +180,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); @@ -193,17 +189,15 @@ sub create { if exists $args{isa}; my $attribute = $self->new(%args); - $attribute->_create_args(\%args); - my $meta = $class->meta; + $attribute->_create_args(\%args); - $meta->add_attribute($attribute); + $class->add_attribute($attribute); # install an accessor if ($attribute->_is_metadata eq 'rw' || $attribute->_is_metadata eq 'ro') { my $accessor = $attribute->generate_accessor; - no strict 'refs'; - *{ $class . '::' . $name } = $accessor; + $class->add_method($name => $accessor); } for my $method (qw/predicate clearer/) { @@ -211,16 +205,14 @@ sub create { if ($attribute->$predicate) { my $generator = "generate_$method"; my $coderef = $attribute->$generator; - no strict 'refs'; - *{ $class . '::' . $attribute->$method } = $coderef; + $class->add_method($attribute->$method => $coderef); } } if ($attribute->has_handles) { my $method_map = $attribute->generate_handles; for my $method_name (keys %$method_map) { - no strict 'refs'; - *{ $class . '::' . $method_name } = $method_map->{$method_name}; + $class->add_method($method_name => $method_map->{$method_name}); } } @@ -276,14 +268,12 @@ sub validate_args { && $args->{isa} ne 'HashRef'; if ($args->{trigger}) { - if (ref($args->{trigger}) eq 'CODE') { - $args->{trigger} = { - after => $args->{trigger}, - }; + if (ref($args->{trigger}) eq 'HASH') { + Carp::carp "HASH-based form of trigger has been removed. Only the coderef form of triggers are now supported."; } - confess "Trigger must be a CODE or HASH ref on attribute ($name)" - if ref($args->{trigger}) ne 'HASH'; + confess "Trigger must be a CODE ref on attribute ($name)" + if ref($args->{trigger}) ne 'CODE'; } return 1; @@ -345,7 +335,7 @@ sub get_parent_args { my $class = shift; my $name = shift; - for my $super ($class->meta->linearized_isa) { + for my $super ($class->linearized_isa) { my $super_attr = $super->can("meta") && $super->meta->get_attribute($name) or next; return %{ $super_attr->_create_args }; @@ -375,7 +365,7 @@ installed. Some error checking is done. =head2 name -> AttributeName -=head2 class -> OwnerClass +=head2 associated_class -> OwnerClass =head2 is_required -> Bool