X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FMethod%2FAccessor.pm;h=c52a642419501cd5246c450ffe56448603f705ce;hb=753d754623cec6cb64d707fe5f993cef7d535788;hp=59eb20cee89815171ebd4863108e421a4a43a963;hpb=812d58f9517c19217fd09da63a6a87d80c202f11;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Method/Accessor.pm b/lib/Class/MOP/Method/Accessor.pm index 59eb20c..c52a642 100644 --- a/lib/Class/MOP/Method/Accessor.pm +++ b/lib/Class/MOP/Method/Accessor.pm @@ -6,8 +6,9 @@ use warnings; use Carp 'confess'; use Scalar::Util 'blessed', 'weaken'; +use Try::Tiny; -our $VERSION = '0.89'; +our $VERSION = '1.11'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -74,12 +75,6 @@ sub accessor_type { (shift)->{'accessor_type'} } ## factory -sub initialize_body { - Carp::cluck('The initialize_body method has been made private.' - . " The public version is deprecated and will be removed in a future release.\n"); - shift->_initialize_body; -} - sub _initialize_body { my $self = shift; @@ -95,191 +90,149 @@ sub _initialize_body { ## generators -sub generate_accessor_method { - Carp::cluck('The generate_accessor_method method has been made private.' - . " The public version is deprecated and will be removed in a future release.\n"); - shift->_generate_accessor_method; -} - sub _generate_accessor_method { - my $attr = (shift)->associated_attribute; + my $self = shift; + my $attr = $self->associated_attribute; + return sub { - $attr->set_value($_[0], $_[1]) if scalar(@_) == 2; + if (@_ >= 2) { + $attr->set_value($_[0], $_[1]); + } $attr->get_value($_[0]); }; } -sub generate_reader_method { - Carp::cluck('The generate_reader_method method has been made private.' - . " The public version is deprecated and will be removed in a future release.\n"); - shift->_generate_reader_method; +sub _generate_accessor_method_inline { + my $self = shift; + my $attr = $self->associated_attribute; + + return try { + $self->_compile_code([ + 'sub {', + 'if (@_ > 1) {', + $attr->_inline_set_value('$_[0]', '$_[1]'), + '}', + $attr->_inline_get_value('$_[0]'), + '}', + ]); + } + catch { + confess "Could not generate inline accessor because : $_"; + }; } sub _generate_reader_method { - my $attr = (shift)->associated_attribute; + my $self = shift; + my $attr = $self->associated_attribute; + return sub { - confess "Cannot assign a value to a read-only accessor" if @_ > 1; + confess "Cannot assign a value to a read-only accessor" + if @_ > 1; $attr->get_value($_[0]); }; } -sub generate_writer_method { - Carp::cluck('The generate_writer_method method has been made private.' - . " The public version is deprecated and will be removed in a future release.\n"); - shift->_generate_writer_method; +sub _generate_reader_method_inline { + my $self = shift; + my $attr = $self->associated_attribute; + + return try { + $self->_compile_code([ + 'sub {', + 'if (@_ > 1) {', + # XXX: this is a hack, but our error stuff is terrible + $self->_inline_throw_error( + '"Cannot assign a value to a read-only accessor"', + 'data => \@_' + ) . ';', + '}', + $attr->_inline_get_value('$_[0]'), + '}', + ]); + } + catch { + confess "Could not generate inline reader because : $_"; + }; +} + +sub _inline_throw_error { + my $self = shift; + return 'confess ' . $_[0]; } sub _generate_writer_method { - my $attr = (shift)->associated_attribute; + my $self = shift; + my $attr = $self->associated_attribute; + return sub { $attr->set_value($_[0], $_[1]); }; } -sub generate_predicate_method { - Carp::cluck('The generate_predicate_method method has been made private.' - . " The public version is deprecated and will be removed in a future release.\n"); - shift->_generate_predicate_method; +sub _generate_writer_method_inline { + my $self = shift; + my $attr = $self->associated_attribute; + + return try { + $self->_compile_code([ + 'sub {', + $attr->_inline_set_value('$_[0]', '$_[1]'), + '}', + ]); + } + catch { + confess "Could not generate inline writer because : $_"; + }; } sub _generate_predicate_method { - my $attr = (shift)->associated_attribute; + my $self = shift; + my $attr = $self->associated_attribute; + return sub { $attr->has_value($_[0]) }; } -sub generate_clearer_method { - Carp::cluck('The generate_clearer_method method has been made private.' - . " The public version is deprecated and will be removed in a future release.\n"); - shift->_generate_clearer_method; +sub _generate_predicate_method_inline { + my $self = shift; + my $attr = $self->associated_attribute; + + return try { + $self->_compile_code([ + 'sub {', + $attr->_inline_has_value('$_[0]'), + '}', + ]); + } + catch { + confess "Could not generate inline predicate because : $_"; + }; } sub _generate_clearer_method { - my $attr = (shift)->associated_attribute; + my $self = shift; + my $attr = $self->associated_attribute; + return sub { $attr->clear_value($_[0]) }; } -## Inline methods - -sub generate_accessor_method_inline { - Carp::cluck('The generate_accessor_method_inline method has been made private.' - . " The public version is deprecated and will be removed in a future release.\n"); - shift->_generate_accessor_method_inline; -} - -sub _generate_accessor_method_inline { - my $self = shift; - my $attr = $self->associated_attribute; - my $attr_name = $attr->name; - my $meta_instance = $attr->associated_class->instance_metaclass; - - my ( $code, $e ) = $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) - . '}' - ); - confess "Could not generate inline accessor because : $e" if $e; - - return $code; -} - -sub generate_reader_method_inline { - Carp::cluck('The generate_reader_method_inline method has been made private.' - . " The public version is deprecated and will be removed in a future release.\n"); - shift->_generate_reader_method_inline; -} - -sub _generate_reader_method_inline { - my $self = shift; - my $attr = $self->associated_attribute; - my $attr_name = $attr->name; - my $meta_instance = $attr->associated_class->instance_metaclass; - - 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 : $e" if $e; - - return $code; -} - -sub generate_writer_method_inline { - Carp::cluck('The generate_writer_method_inline method has been made private.' - . " The public version is deprecated and will be removed in a future release.\n"); - shift->_generate_writer_method_inline; -} - -sub _generate_writer_method_inline { - my $self = shift; - my $attr = $self->associated_attribute; - my $attr_name = $attr->name; - my $meta_instance = $attr->associated_class->instance_metaclass; - - my ( $code, $e ) = $self->_eval_closure( - {}, - 'sub {' - . $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]') - . '}' - ); - confess "Could not generate inline writer because : $e" if $e; - - return $code; -} - -sub generate_predicate_method_inline { - Carp::cluck('The generate_predicate_method_inline method has been made private.' - . " The public version is deprecated and will be removed in a future release.\n"); - shift->_generate_predicate_method_inline; -} - -sub _generate_predicate_method_inline { - my $self = shift; - my $attr = $self->associated_attribute; - my $attr_name = $attr->name; - my $meta_instance = $attr->associated_class->instance_metaclass; - - my ( $code, $e ) = $self->_eval_closure( - {}, - 'sub {' - . $meta_instance->inline_is_slot_initialized('$_[0]', $attr_name) - . '}' - ); - confess "Could not generate inline predicate because : $e" if $e; - - return $code; -} - -sub generate_clearer_method_inline { - Carp::cluck('The generate_clearer_method_inline method has been made private.' - . " The public version is deprecated and will be removed in a future release.\n"); - shift->_generate_clearer_method_inline; -} - sub _generate_clearer_method_inline { - my $self = shift; - my $attr = $self->associated_attribute; - my $attr_name = $attr->name; - my $meta_instance = $attr->associated_class->instance_metaclass; - - my ( $code, $e ) = $self->_eval_closure( - {}, - 'sub {' - . $meta_instance->inline_deinitialize_slot('$_[0]', $attr_name) - . '}' - ); - confess "Could not generate inline clearer because : $e" if $e; - - return $code; + my $self = shift; + my $attr = $self->associated_attribute; + + return try { + $self->_compile_code([ + 'sub {', + $attr->_inline_clear_value('$_[0]'), + '}', + ]); + } + catch { + confess "Could not generate inline clearer because : $_"; + }; } 1; @@ -306,7 +259,7 @@ Class::MOP::Method::Accessor - Method Meta Object for accessors =head1 DESCRIPTION -This is a subclass of which is used by +This is a subclass of C which is used by C to generate accessor code. It handles generation of readers, writers, predicates and clearers. For each type of method, it can either create a subroutine reference, or actually @@ -375,7 +328,7 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006-2009 by Infinity Interactive, Inc. +Copyright 2006-2010 by Infinity Interactive, Inc. L