X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FMethod%2FAccessor.pm;h=ea63b75789591fc34925371129c53bf3f25b5a1d;hb=e9a19694e92766a8d4de61fe2a576929748424c1;hp=dfef5f7f45488f9c807c59dbde33b639c95bc706;hpb=6e1c8b63d87c6e1d8e84e15cc2c1f5336780515b;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Method/Accessor.pm b/lib/Class/MOP/Method/Accessor.pm index dfef5f7..ea63b75 100644 --- a/lib/Class/MOP/Method/Accessor.pm +++ b/lib/Class/MOP/Method/Accessor.pm @@ -7,7 +7,8 @@ use warnings; use Carp 'confess'; use Scalar::Util 'blessed', 'weaken'; -our $VERSION = '0.63'; +our $VERSION = '0.77'; +$VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; use base 'Class::MOP::Method::Generated'; @@ -28,31 +29,31 @@ sub new { ($options{package_name} && $options{name}) || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT"; - my $self = bless { - # from our superclass - '&!body' => undef, - '$!package_name' => $options{package_name}, - '$!name' => $options{name}, - # specific to this subclass - '$!attribute' => $options{attribute}, - '$!is_inline' => ($options{is_inline} || 0), - '$!accessor_type' => $options{accessor_type}, - } => $class; + my $self = $class->_new(\%options); # we don't want this creating # a cycle in the code, if not # needed - weaken($self->{'$!attribute'}); + weaken($self->{'attribute'}); $self->initialize_body; return $self; } +sub _new { + my $class = shift; + my $options = @_ == 1 ? $_[0] : {@_}; + + $options->{is_inline} ||= 0; + + return bless $options, $class; +} + ## accessors -sub associated_attribute { (shift)->{'$!attribute'} } -sub accessor_type { (shift)->{'$!accessor_type'} } +sub associated_attribute { (shift)->{'attribute'} } +sub accessor_type { (shift)->{'accessor_type'} } ## factory @@ -66,8 +67,7 @@ sub initialize_body { ($self->is_inline ? 'inline' : ()) ); - eval { $self->{'&!body'} = $self->$method_name() }; - die $@ if $@; + $self->{'body'} = $self->$method_name(); } ## generators @@ -113,71 +113,77 @@ sub generate_clearer_method { sub generate_accessor_method_inline { - my $attr = (shift)->associated_attribute; + my $self = shift; + my $attr = $self->associated_attribute; my $attr_name = $attr->name; my $meta_instance = $attr->associated_class->instance_metaclass; - my $code = eval 'sub {' - . $meta_instance->inline_set_slot_value('$_[0]', "'$attr_name'", '$_[1]') . ' if scalar(@_) == 2; ' - . $meta_instance->inline_get_slot_value('$_[0]', "'$attr_name'") - . '}'; - confess "Could not generate inline accessor because : $@" if $@; - - return $code; + return $self->_eval_closure( + {}, + 'sub {' + . $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]') + . ' if scalar(@_) == 2; ' + . $meta_instance->inline_get_slot_value('$_[0]', $attr_name) + . '}' + ); } sub generate_reader_method_inline { - my $attr = (shift)->associated_attribute; + my $self = shift; + my $attr = $self->associated_attribute; my $attr_name = $attr->name; my $meta_instance = $attr->associated_class->instance_metaclass; - my $code = eval 'sub {' + return $self->_eval_closure( + {}, + 'sub {' . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;' - . $meta_instance->inline_get_slot_value('$_[0]', "'$attr_name'") - . '}'; - confess "Could not generate inline accessor because : $@" if $@; - - return $code; + . $meta_instance->inline_get_slot_value('$_[0]', $attr_name) + . '}' + ); } sub generate_writer_method_inline { - my $attr = (shift)->associated_attribute; + my $self = shift; + my $attr = $self->associated_attribute; my $attr_name = $attr->name; my $meta_instance = $attr->associated_class->instance_metaclass; - my $code = eval 'sub {' - . $meta_instance->inline_set_slot_value('$_[0]', "'$attr_name'", '$_[1]') - . '}'; - confess "Could not generate inline accessor because : $@" if $@; - - return $code; + return $self->_eval_closure( + {}, + 'sub {' + . $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]') + . '}' + ); } sub generate_predicate_method_inline { - my $attr = (shift)->associated_attribute; + my $self = shift; + my $attr = $self->associated_attribute; my $attr_name = $attr->name; my $meta_instance = $attr->associated_class->instance_metaclass; - my $code = eval 'sub {' . - $meta_instance->inline_is_slot_initialized('$_[0]', "'$attr_name'") - . '}'; - confess "Could not generate inline predicate because : $@" if $@; - - return $code; + return $self->_eval_closure( + {}, + 'sub {' + . $meta_instance->inline_is_slot_initialized('$_[0]', $attr_name) + . '}' + ); } sub generate_clearer_method_inline { - my $attr = (shift)->associated_attribute; + my $self = shift; + my $attr = $self->associated_attribute; my $attr_name = $attr->name; my $meta_instance = $attr->associated_class->instance_metaclass; - my $code = eval 'sub {' - . $meta_instance->inline_deinitialize_slot('$_[0]', "'$attr_name'") - . '}'; - confess "Could not generate inline clearer because : $@" if $@; - - return $code; + return $self->_eval_closure( + {}, + 'sub {' + . $meta_instance->inline_deinitialize_slot('$_[0]', $attr_name) + . '}' + ); } 1; @@ -200,7 +206,7 @@ Class::MOP::Method::Accessor - Method Meta Object for accessors accessor_type => 'reader', ); - $reader->body->($instance); # call the reader method + $reader->body->execute($instance); # call the reader method =head1 DESCRIPTION