X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FMethod%2FAccessor.pm;h=427d27b130c110df54a572ab57797634a50f7374;hb=c6e75cb33bd9fd33d777325cdc3de6d5de614263;hp=62eaab858cd0ccd28e9fdb444f41e2540b68c7a2;hpb=69e3ab0a5a391925610bbb917d81da8d53fd1b91;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Method/Accessor.pm b/lib/Class/MOP/Method/Accessor.pm index 62eaab8..427d27b 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.02'; +our $VERSION = '0.81'; +$VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; use base 'Class::MOP::Method::Generated'; @@ -25,49 +26,66 @@ sub new { (blessed($options{attribute}) && $options{attribute}->isa('Class::MOP::Attribute')) || confess "You must supply an attribute which is a 'Class::MOP::Attribute' instance"; - my $self = bless { - # from our superclass - '&!body' => undef, - # specific to this subclass - '$!attribute' => $options{attribute}, - '$!is_inline' => ($options{is_inline} || 0), - '$!accessor_type' => $options{accessor_type}, - } => $class; + ($options{package_name} && $options{name}) + || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT"; + + 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; + $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 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; my $method_name = join "_" => ( - 'generate', + '_generate', $self->accessor_type, 'method', ($self->is_inline ? 'inline' : ()) ); - eval { $self->{'&!body'} = $self->$method_name() }; + eval { $self->{'body'} = $self->$method_name() }; die $@ if $@; } ## 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; return sub { $attr->set_value($_[0], $_[1]) if scalar(@_) == 2; @@ -76,6 +94,12 @@ sub generate_accessor_method { } 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_reader_method { my $attr = (shift)->associated_attribute; return sub { confess "Cannot assign a value to a read-only accessor" if @_ > 1; @@ -84,6 +108,12 @@ sub generate_reader_method { } 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_writer_method { my $attr = (shift)->associated_attribute; return sub { $attr->set_value($_[0], $_[1]); @@ -91,6 +121,12 @@ sub generate_writer_method { } 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_predicate_method { my $attr = (shift)->associated_attribute; return sub { $attr->has_value($_[0]) @@ -98,6 +134,12 @@ sub generate_predicate_method { } 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_clearer_method { my $attr = (shift)->associated_attribute; return sub { $attr->clear_value($_[0]) @@ -106,70 +148,119 @@ sub generate_clearer_method { ## Inline methods - sub generate_accessor_method_inline { - my $attr = (shift)->associated_attribute; + 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 = eval 'sub {' - . $meta_instance->inline_set_slot_value('$_[0]', "'$attr_name'", '$_[1]') . ' if scalar(@_) == 2; ' - . $meta_instance->inline_get_slot_value('$_[0]', "'$attr_name'") - . '}'; + my $code = $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 : $@" if $@; return $code; } sub generate_reader_method_inline { - my $attr = (shift)->associated_attribute; + 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 = eval 'sub {' + my $code = $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 $@; + . $meta_instance->inline_get_slot_value('$_[0]', $attr_name) + . '}' + ); + confess "Could not generate inline reader because : $@" if $@; return $code; } sub generate_writer_method_inline { - my $attr = (shift)->associated_attribute; + 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 = eval 'sub {' - . $meta_instance->inline_set_slot_value('$_[0]', "'$attr_name'", '$_[1]') - . '}'; - confess "Could not generate inline accessor because : $@" if $@; + my $code = $self->_eval_closure( + {}, + 'sub {' + . $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]') + . '}' + ); + confess "Could not generate inline writer because : $@" if $@; return $code; } - sub generate_predicate_method_inline { - my $attr = (shift)->associated_attribute; + 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 = eval 'sub {' . - $meta_instance->inline_is_slot_initialized('$_[0]', "'$attr_name'") - . '}'; + my $code = $self->_eval_closure( + {}, + 'sub {' + . $meta_instance->inline_is_slot_initialized('$_[0]', $attr_name) + . '}' + ); confess "Could not generate inline predicate because : $@" if $@; return $code; } sub generate_clearer_method_inline { - my $attr = (shift)->associated_attribute; + 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 = eval 'sub {' - . $meta_instance->inline_deinitialize_slot('$_[0]', "'$attr_name'") - . '}'; + my $code = $self->_eval_closure( + {}, + 'sub {' + . $meta_instance->inline_deinitialize_slot('$_[0]', $attr_name) + . '}' + ); confess "Could not generate inline clearer because : $@" if $@; return $code; @@ -195,90 +286,70 @@ 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 -This is a C subclass which is used interally -by C to generate accessor code. It can -handle generation of readers, writers, predicate and clearer -methods, both as closures and as more optimized inline methods. +This is a subclass of 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 +inline code by generating a string and C'ing it. =head1 METHODS =over 4 -=item B +=item B<< Class::MOP::Method::Accessor->new(%options) >> -This creates the method based on the criteria in C<%options>, -these options are: +This returns a new C based on the +C<%options> provided. =over 4 -=item I +=item * attribute -This must be an instance of C which this -accessor is being generated for. This paramter is B. +This is the C for which accessors are being +generated. This option is required. -=item I +=item * accessor_type -This is a string from the following set; reader, writer, accessor, -predicate or clearer. This is used to determine which type of -method is to be generated. +This is a string which should be one of "reader", "writer", +"accessor", "predicate", or "clearer". This is the type of method +being generated. This option is required. -=item I +=item * is_inline -This is a boolean to indicate if the method should be generated -as a closure, or as a more optimized inline version. +This indicates whether or not the accessor should be inlined. This +defaults to false. -=back - -=item B - -This returns the accessor type which was passed into C. - -=item B - -This returns the boolean which was passed into C. - -=item B +=item * name -This returns the attribute instance which was passed into C. +The method name (without a package name). This is required. -=item B +=item * package_name -This will actually generate the method based on the specified -criteria passed to the constructor. +The package name for the method. This is required. =back -=head2 Method Generators - -These methods will generate appropriate code references for -the various types of accessors which are supported by -C. The names pretty much explain it all. - -=over 4 - -=item B - -=item B - -=item B +=item B<< $metamethod->accessor_type >> -=item B +Returns the accessor type which was passed to C. -=item B +=item B<< $metamethod->is_inline >> -=item B +Returns a boolean indicating whether or not the accessor is inlined. -=item B +=item B<< $metamethod->associated_attribute >> -=item B +This returns the L object which was passed to +C. -=item B +=item B<< $metamethod->body >> -=item B +The method itself is I when the accessor object is +constructed. =back @@ -288,7 +359,7 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006-2008 by Infinity Interactive, Inc. +Copyright 2006-2009 by Infinity Interactive, Inc. L