From: Jesse Luehrs Date: Sat, 16 Oct 2010 00:28:35 +0000 (-0500) Subject: move the __MOP__ stuff back into the instance metaclass X-Git-Tag: 1.10~2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=301d65f26c8dffbce037d89208788bf21c40a7b1;p=gitmo%2FClass-MOP.git move the __MOP__ stuff back into the instance metaclass --- diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index 8426d14..2f71fa1 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -602,17 +602,8 @@ sub _construct_instance { foreach my $attr ($class->get_all_attributes()) { $attr->initialize_instance_slot($meta_instance, $instance, $params); } - # NOTE: - # this will only work for a HASH instance type if (Class::MOP::metaclass_is_weak($class->name)) { - (reftype($instance) eq 'HASH') - || confess "Currently only HASH based instances are supported with instance of anon-classes"; - # NOTE: - # At some point we should make this official - # as a reserved slot name, but right now I am - # going to keep it here. - # my $RESERVED_MOP_SLOT = '__MOP__'; - $instance->{'__MOP__'} = $class; + $meta_instance->_set_mop_slot($instance, $class); } return $instance; } @@ -686,29 +677,20 @@ sub _force_rebless_instance { $old_metaclass->rebless_instance_away($instance, $self, %params) if $old_metaclass; + my $meta_instance = $self->get_meta_instance; + if (Class::MOP::metaclass_is_weak($old_metaclass->name)) { - delete $instance->{__MOP__}; + $meta_instance->_clear_mop_slot($instance); } - my $meta_instance = $self->get_meta_instance; - # rebless! # we use $_[1] here because of t/306_rebless_overload.t regressions on 5.8.8 $meta_instance->rebless_instance_structure($_[1], $self); $self->_fixup_attributes_after_rebless($instance, $old_metaclass, %params); - # NOTE: - # this will only work for a HASH instance type if (Class::MOP::metaclass_is_weak($self->name)) { - (reftype($instance) eq 'HASH') - || confess "Currently only HASH based instances are supported with instance of anon-classes"; - # NOTE: - # At some point we should make this official - # as a reserved slot name, but right now I am - # going to keep it here. - # my $RESERVED_MOP_SLOT = '__MOP__'; - $instance->{'__MOP__'} = $self; + $meta_instance->_set_mop_slot($instance, $self); } } diff --git a/lib/Class/MOP/Instance.pm b/lib/Class/MOP/Instance.pm index 5a4b377..b0d9c6a 100644 --- a/lib/Class/MOP/Instance.pm +++ b/lib/Class/MOP/Instance.pm @@ -12,6 +12,9 @@ our $AUTHORITY = 'cpan:STEVAN'; use base 'Class::MOP::Object'; +# make this not a valid method name, to avoid (most) attribute conflicts +my $RESERVED_MOP_SLOT = '<>'; + sub BUILDARGS { my ($class, @args) = @_; @@ -161,6 +164,21 @@ sub is_dependent_on_superclasses { return; # for meta instances that require updates on inherited slot changes } +sub _get_mop_slot { + my ($self, $instance) = @_; + $self->get_slot_value($instance, $RESERVED_MOP_SLOT); +} + +sub _set_mop_slot { + my ($self, $instance, $value) = @_; + $self->set_slot_value($instance, $RESERVED_MOP_SLOT, $value); +} + +sub _clear_mop_slot { + my ($self, $instance) = @_; + $self->deinitialize_slot($instance, $RESERVED_MOP_SLOT); +} + # inlinable operation snippets sub is_inlinable { 1 }