X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FMethod%2FAccessor.pm;h=dab394211b4bd55ac6f45db17531db16e5d2c5d7;hb=41ffa8a4aa857c1af10e51521b1b37c7d33826c8;hp=f51b271cfb13fd99ec871efba2f6eb60dbe585dc;hpb=403cfbeccca4e7750da88c52ad7fd81f35a7e9a7;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Method/Accessor.pm b/lib/Class/MOP/Method/Accessor.pm index f51b271..dab3942 100644 --- a/lib/Class/MOP/Method/Accessor.pm +++ b/lib/Class/MOP/Method/Accessor.pm @@ -7,7 +7,7 @@ use warnings; use Carp 'confess'; use Scalar::Util 'blessed', 'weaken'; -our $VERSION = '0.82'; +our $VERSION = '0.90'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -43,11 +43,28 @@ sub new { sub _new { my $class = shift; - my $options = @_ == 1 ? $_[0] : {@_}; - $options->{is_inline} ||= 0; + return Class::MOP::Class->initialize($class)->new_object(@_) + if $class ne __PACKAGE__; - return bless $options, $class; + my $params = @_ == 1 ? $_[0] : {@_}; + + return bless { + # inherited from Class::MOP::Method + body => $params->{body}, + associated_metaclass => $params->{associated_metaclass}, + package_name => $params->{package_name}, + name => $params->{name}, + original_method => $params->{original_method}, + + # inherit from Class::MOP::Generated + is_inline => $params->{is_inline} || 0, + definition_context => $params->{definition_context}, + + # defined in this class + attribute => $params->{attribute}, + accessor_type => $params->{accessor_type}, + } => $class; } ## accessors @@ -73,8 +90,7 @@ sub _initialize_body { ($self->is_inline ? 'inline' : ()) ); - eval { $self->{'body'} = $self->$method_name() }; - die $@ if $@; + $self->{'body'} = $self->$method_name(); } ## generators @@ -160,7 +176,7 @@ sub _generate_accessor_method_inline { my $attr_name = $attr->name; my $meta_instance = $attr->associated_class->instance_metaclass; - my $code = $self->_eval_closure( + my ( $code, $e ) = $self->_eval_closure( {}, 'sub {' . $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]') @@ -168,7 +184,7 @@ sub _generate_accessor_method_inline { . $meta_instance->inline_get_slot_value('$_[0]', $attr_name) . '}' ); - confess "Could not generate inline accessor because : $@" if $@; + confess "Could not generate inline accessor because : $e" if $e; return $code; } @@ -185,14 +201,14 @@ sub _generate_reader_method_inline { my $attr_name = $attr->name; my $meta_instance = $attr->associated_class->instance_metaclass; - my $code = $self->_eval_closure( + my ( $code, $e ) = $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 reader because : $@" if $@; + confess "Could not generate inline reader because : $e" if $e; return $code; } @@ -209,13 +225,13 @@ sub _generate_writer_method_inline { my $attr_name = $attr->name; my $meta_instance = $attr->associated_class->instance_metaclass; - my $code = $self->_eval_closure( + my ( $code, $e ) = $self->_eval_closure( {}, 'sub {' . $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]') . '}' ); - confess "Could not generate inline writer because : $@" if $@; + confess "Could not generate inline writer because : $e" if $e; return $code; } @@ -232,13 +248,13 @@ sub _generate_predicate_method_inline { my $attr_name = $attr->name; my $meta_instance = $attr->associated_class->instance_metaclass; - my $code = $self->_eval_closure( + my ( $code, $e ) = $self->_eval_closure( {}, 'sub {' . $meta_instance->inline_is_slot_initialized('$_[0]', $attr_name) . '}' ); - confess "Could not generate inline predicate because : $@" if $@; + confess "Could not generate inline predicate because : $e" if $e; return $code; } @@ -255,13 +271,13 @@ sub _generate_clearer_method_inline { my $attr_name = $attr->name; my $meta_instance = $attr->associated_class->instance_metaclass; - my $code = $self->_eval_closure( + my ( $code, $e ) = $self->_eval_closure( {}, 'sub {' . $meta_instance->inline_deinitialize_slot('$_[0]', $attr_name) . '}' ); - confess "Could not generate inline clearer because : $@" if $@; + confess "Could not generate inline clearer because : $e" if $e; return $code; }