X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FAttribute.pm;h=8d3fe047654fb5a995aa1c11e4f5c4b81f7f683e;hb=b4009dc1e31303c02e243bdd40e221db77c2758c;hp=c3d760b6d7b86019b7bf238cb18614698ddb3748;hpb=9e517e010380b50d0cfec15cdc893536fb3c84d0;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm index c3d760b..8d3fe04 100644 --- a/lib/Class/MOP/Attribute.pm +++ b/lib/Class/MOP/Attribute.pm @@ -9,7 +9,7 @@ use Class::MOP::Method::Accessor; use Carp 'confess'; use Scalar::Util 'blessed', 'reftype', 'weaken'; -our $VERSION = '0.24'; +our $VERSION = '0.25'; our $AUTHORITY = 'cpan:STEVAN'; use base 'Class::MOP::Object'; @@ -41,7 +41,7 @@ sub new { } else { (is_default_a_coderef(\%options)) || confess("References are not allowed as default values, you must ". - "wrap then in a CODE reference (ex: sub { [] } and not [])") + "wrap the default of '$name' in a CODE reference (ex: sub { [] } and not [])") if exists $options{default} && ref $options{default}; } if( $options{required} and not( defined($options{builder}) || defined($options{init_arg}) || exists $options{default} ) ) { @@ -196,7 +196,17 @@ sub get_read_method_ref { return $self->associated_class->get_method($reader); } else { - return sub { $self->get_value(@_) }; + my $code = sub { $self->get_value(@_) }; + if (my $class = $self->associated_class) { + return $class->method_metaclass->wrap( + $code, + package_name => $class->name, + name => '__ANON__' + ); + } + else { + return $code; + } } } @@ -206,7 +216,17 @@ sub get_write_method_ref { return $self->associated_class->get_method($writer); } else { - return sub { $self->set_value(@_) }; + my $code = sub { $self->set_value(@_) }; + if (my $class = $self->associated_class) { + return $class->method_metaclass->wrap( + $code, + package_name => $class->name, + name => '__ANON__' + ); + } + else { + return $code; + } } } @@ -304,7 +324,11 @@ sub process_accessors { (reftype($accessor) eq 'HASH') || confess "bad accessor/reader/writer/predicate/clearer format, must be a HASH ref"; my ($name, $method) = %{$accessor}; - $method = $self->accessor_metaclass->wrap($method); + $method = $self->accessor_metaclass->wrap( + $method, + package_name => $self->associated_class->name, + name => $name, + ); $self->associate_method($method); return ($name, $method); } @@ -316,6 +340,8 @@ sub process_accessors { attribute => $self, is_inline => $inline_me, accessor_type => $type, + package_name => $self->associated_class->name, + name => $accessor, ); }; confess "Could not create the '$type' method for " . $self->name . " because : $@" if $@;