X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FAttribute.pm;h=d0cf23477fb3303c46e2485343b544e59b7d4c1b;hb=53362bcb1b32d87630190fbf50679dc37bb51adf;hp=8fe90b4a93f8ec1f31531527cab059928af78f13;hpb=53edec17bae8aa34a398b0bd50dcd7e78e03b733;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm index 8fe90b4..d0cf234 100644 --- a/lib/Class/MOP/Attribute.pm +++ b/lib/Class/MOP/Attribute.pm @@ -10,11 +10,11 @@ use Carp 'confess'; use Scalar::Util 'blessed', 'weaken'; use Try::Tiny; -our $VERSION = '0.95'; +our $VERSION = '1.11'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; -use base 'Class::MOP::Object'; +use base 'Class::MOP::Object', 'Class::MOP::Mixin::AttributeCore'; # NOTE: (meta-circularity) # This method will be replaced in the @@ -44,7 +44,7 @@ sub new { confess("Setting both default and builder is not allowed.") if exists $options{default}; } else { - (is_default_a_coderef(\%options)) + ($class->is_default_a_coderef(\%options)) || confess("References are not allowed as default values, you must ". "wrap the default of '$name' in a CODE reference (ex: sub { [] } and not [])") if exists $options{default} && ref $options{default}; @@ -73,7 +73,9 @@ sub _new { 'clearer' => $options->{clearer}, 'builder' => $options->{builder}, 'init_arg' => $options->{init_arg}, - 'default' => $options->{default}, + exists $options->{default} + ? ('default' => $options->{default}) + : (), 'initializer' => $options->{initializer}, 'definition_context' => $options->{definition_context}, # keep a weakened link to the @@ -117,7 +119,7 @@ sub initialize_instance_slot { $params->{$init_arg}, ); } - elsif (defined $self->{'default'}) { + elsif (exists $self->{'default'}) { $self->_set_initial_slot_value( $meta_instance, $instance, @@ -156,42 +158,6 @@ sub _set_initial_slot_value { $instance->$initializer($value, $callback, $self); } -# NOTE: -# the next bunch of methods will get bootstrapped -# away in the Class::MOP bootstrapping section - -sub associated_class { $_[0]->{'associated_class'} } -sub associated_methods { $_[0]->{'associated_methods'} } - -sub has_accessor { defined($_[0]->{'accessor'}) } -sub has_reader { defined($_[0]->{'reader'}) } -sub has_writer { defined($_[0]->{'writer'}) } -sub has_predicate { defined($_[0]->{'predicate'}) } -sub has_clearer { defined($_[0]->{'clearer'}) } -sub has_builder { defined($_[0]->{'builder'}) } -sub has_init_arg { defined($_[0]->{'init_arg'}) } -sub has_default { defined($_[0]->{'default'}) } -sub has_initializer { defined($_[0]->{'initializer'}) } -sub has_insertion_order { defined($_[0]->{'insertion_order'}) } - -sub accessor { $_[0]->{'accessor'} } -sub reader { $_[0]->{'reader'} } -sub writer { $_[0]->{'writer'} } -sub predicate { $_[0]->{'predicate'} } -sub clearer { $_[0]->{'clearer'} } -sub builder { $_[0]->{'builder'} } -sub init_arg { $_[0]->{'init_arg'} } -sub initializer { $_[0]->{'initializer'} } -sub definition_context { $_[0]->{'definition_context'} } -sub insertion_order { $_[0]->{'insertion_order'} } -sub _set_insertion_order { $_[0]->{'insertion_order'} = $_[1] } - -# end bootstrapped away method section. -# (all methods below here are kept intact) - -sub has_read_method { $_[0]->has_reader || $_[0]->has_accessor } -sub has_write_method { $_[0]->has_writer || $_[0]->has_accessor } - sub get_read_method { my $self = shift; my $reader = $self->reader || $self->accessor; @@ -252,24 +218,6 @@ sub get_write_method_ref { } } -sub is_default_a_coderef { - my ($value) = $_[0]->{'default'}; - return unless ref($value); - return ref($value) eq 'CODE' || (blessed($value) && $value->isa('Class::MOP::Method')); -} - -sub default { - my ($self, $instance) = @_; - if (defined $instance && $self->is_default_a_coderef) { - # if the default is a CODE ref, then - # we pass in the instance and default - # can return a value based on that - # instance. Somewhat crude, but works. - return $self->{'default'}->($instance); - } - $self->{'default'}; -} - # slots sub slots { (shift)->name } @@ -453,6 +401,40 @@ sub install_accessors { } +sub inline_get { + my $self = shift; + my ($instance) = @_; + + return $self->associated_class->get_meta_instance->inline_get_slot_value( + $instance, $self->name ); +} + +sub inline_set { + my $self = shift; + my ( $instance, $value ) = @_; + + return $self->associated_class->get_meta_instance->inline_set_slot_value( + $instance, $self->name, $value ); +} + +sub inline_has { + my $self = shift; + my ($instance) = @_; + + return + $self->associated_class->get_meta_instance + ->inline_is_slot_initialized( $instance, $self->name ); +} + +sub inline_clear { + my $self = shift; + my ($instance) = @_; + + return + $self->associated_class->get_meta_instance + ->inline_deinitialize_slot( $instance, $self->name ); +} + 1; __END__ @@ -849,7 +831,7 @@ called when the instance is first being initialized. Returns the value without going through the accessor. Note that this works even with write-only accessors. -=item B<< $sttr->get_raw_value($instance) >> +=item B<< $attr->get_raw_value($instance) >> Returns the value without any side effects such as lazy attributes. @@ -943,6 +925,18 @@ attribute. This does not currently remove methods from the list returned by C. +=item B<< $attr->inline_get >> + +=item B<< $attr->inline_set >> + +=item B<< $attr->inline_has >> + +=item B<< $attr->inline_clear >> + +These methods return a code snippet suitable for inlining the relevant +operation. They expect strings containing variable names to be used in the +inlining, like C<'$self'> or C<'$_[1]'>. + =back =head2 Introspection @@ -965,7 +959,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