X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FAttribute.pm;h=26cd2fbfb67e5d346c06d8a1c0e73996ee76fac1;hb=a0c6ecac8cae9e5aca1dc729e14630b85d8bfd34;hp=3b947e47c12f556dbb9680ab5bd6e6d30c508993;hpb=4fbd4b9bca7c0d3fead3f42a49e3671a6e7fc54f;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm index 3b947e4..26cd2fb 100644 --- a/lib/Class/MOP/Attribute.pm +++ b/lib/Class/MOP/Attribute.pm @@ -10,7 +10,7 @@ use Carp 'confess'; use Scalar::Util 'blessed', 'weaken'; use Try::Tiny; -our $VERSION = '0.98'; +our $VERSION = '1.11'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -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, @@ -146,18 +148,24 @@ sub _set_initial_slot_value { return $meta_instance->set_slot_value($instance, $slot_name, $value) unless $self->has_initializer; - my $callback = sub { - $meta_instance->set_slot_value($instance, $slot_name, $_[0]); - }; - + my $callback = $self->_make_initializer_writer_callback( + $meta_instance, $instance, $slot_name + ); + my $initializer = $self->initializer; # most things will just want to set a value, so make it first arg $instance->$initializer($value, $callback, $self); } -sub associated_class { $_[0]->{'associated_class'} } -sub associated_methods { $_[0]->{'associated_methods'} } +sub _make_initializer_writer_callback { + my $self = shift; + my ($meta_instance, $instance, $slot_name) = @_; + + return sub { + $meta_instance->set_slot_value($instance, $slot_name, $_[0]); + }; +} sub get_read_method { my $self = shift; @@ -256,38 +264,91 @@ sub set_initial_value { } sub set_value { shift->set_raw_value(@_) } -sub get_value { shift->get_raw_value(@_) } sub set_raw_value { - my ($self, $instance, $value) = @_; + my $self = shift; + my ($instance, $value) = @_; - Class::MOP::Class->initialize(ref($instance)) - ->get_meta_instance - ->set_slot_value($instance, $self->name, $value); + my $mi = Class::MOP::Class->initialize(ref($instance))->get_meta_instance; + return $mi->set_slot_value($instance, $self->name, $value); } +sub _inline_set_value { + my $self = shift; + return $self->_inline_instance_set(@_) . ';'; +} + +sub _inline_instance_set { + my $self = shift; + my ($instance, $value) = @_; + + my $mi = $self->associated_class->get_meta_instance; + return $mi->inline_set_slot_value($instance, $self->name, $value); +} + +sub get_value { shift->get_raw_value(@_) } + sub get_raw_value { - my ($self, $instance) = @_; + my $self = shift; + my ($instance) = @_; + + my $mi = Class::MOP::Class->initialize(ref($instance))->get_meta_instance; + return $mi->get_slot_value($instance, $self->name); +} + +sub _inline_get_value { + my $self = shift; + return $self->_inline_instance_get(@_) . ';'; +} + +sub _inline_instance_get { + my $self = shift; + my ($instance) = @_; - Class::MOP::Class->initialize(ref($instance)) - ->get_meta_instance - ->get_slot_value($instance, $self->name); + my $mi = $self->associated_class->get_meta_instance; + return $mi->inline_get_slot_value($instance, $self->name); } sub has_value { - my ($self, $instance) = @_; + my $self = shift; + my ($instance) = @_; - Class::MOP::Class->initialize(ref($instance)) - ->get_meta_instance - ->is_slot_initialized($instance, $self->name); + my $mi = Class::MOP::Class->initialize(ref($instance))->get_meta_instance; + return $mi->is_slot_initialized($instance, $self->name); +} + +sub _inline_has_value { + my $self = shift; + return $self->_inline_instance_has(@_) . ';'; +} + +sub _inline_instance_has { + my $self = shift; + my ($instance) = @_; + + my $mi = $self->associated_class->get_meta_instance; + return $mi->inline_is_slot_initialized($instance, $self->name); } sub clear_value { - my ($self, $instance) = @_; + my $self = shift; + my ($instance) = @_; - Class::MOP::Class->initialize(ref($instance)) - ->get_meta_instance - ->deinitialize_slot($instance, $self->name); + my $mi = Class::MOP::Class->initialize(ref($instance))->get_meta_instance; + return $mi->deinitialize_slot($instance, $self->name); +} + +sub _inline_clear_value { + my $self = shift; + return $self->_inline_instance_clear(@_) . ';'; +} + +sub _inline_instance_clear { + my $self = shift; + my ($instance) = @_; + + my $mi = $self->associated_class->get_meta_instance; + return $mi->inline_deinitialize_slot($instance, $self->name); } ## load em up ... @@ -798,7 +859,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. @@ -892,6 +953,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