X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FInstance.pm;h=6e1b9a089ffbfe87af21349f59f60a7c66149040;hb=5d10c516c73e34da6e350bc567aaf8c272428c9b;hp=cccf41c0d18c7a8e6800fdcb986ded41341ee365;hpb=32bfc8109f26b0852d44bd36c08c305720bebaa1;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Instance.pm b/lib/Class/MOP/Instance.pm index cccf41c..6e1b9a0 100644 --- a/lib/Class/MOP/Instance.pm +++ b/lib/Class/MOP/Instance.pm @@ -6,7 +6,8 @@ use warnings; use Scalar::Util 'weaken', 'blessed'; -our $VERSION = '0.65'; +our $VERSION = '0.76'; +$VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; use base 'Class::MOP::Object'; @@ -35,7 +36,17 @@ sub new { my $options = $class->BUILDARGS(@_); # FIXME replace with a proper constructor - my $instance = bless { + my $instance = $class->_new(%$options); + + # FIXME weak_ref => 1, + weaken($instance->{'associated_metaclass'}); + + return $instance; +} + +sub _new { + my ( $class, %options ) = @_; + bless { # NOTE: # I am not sure that it makes # sense to pass in the meta @@ -46,33 +57,31 @@ sub new { # which is *probably* a safe # assumption,.. but you can # never tell <:) - 'associated_metaclass' => $options->{associated_metaclass}, - 'attributes' => $options->{attributes}, - 'slots' => $options->{slots}, - 'slot_hash' => $options->{slot_hash}, + 'associated_metaclass' => $options{associated_metaclass}, + 'attributes' => $options{attributes}, + 'slots' => $options{slots}, + 'slot_hash' => $options{slot_hash}, } => $class; - - # FIXME weak_ref => 1, - weaken($instance->{'associated_metaclass'}); - - return $instance; } -sub associated_metaclass { (shift)->{'associated_metaclass'} } +sub _class_name { $_[0]->{_class_name} ||= $_[0]->associated_metaclass->name } + +sub associated_metaclass { $_[0]{'associated_metaclass'} } sub create_instance { my $self = shift; - $self->bless_instance_structure({}); + bless {}, $self->_class_name; } +# for compatibility sub bless_instance_structure { my ($self, $instance_structure) = @_; - bless $instance_structure, $self->associated_metaclass->name; + bless $instance_structure, $self->_class_name; } sub clone_instance { my ($self, $instance) = @_; - $self->bless_instance_structure({ %$instance }); + bless { %$instance }, $self->_class_name; } # operations on meta instance @@ -82,6 +91,11 @@ sub get_all_slots { return @{$self->{'slots'}}; } +sub get_all_attributes { + my $self = shift; + return @{$self->{attributes}}; +} + sub is_valid_slot { my ($self, $slot_name) = @_; exists $self->{'slot_hash'}->{$slot_name}; @@ -143,6 +157,10 @@ sub rebless_instance_structure { bless $instance, $metaclass->name; } +sub is_dependent_on_superclasses { + return; # for meta instances that require updates on inherited slot changes +} + # inlinable operation snippets sub is_inlinable { 1 } @@ -244,16 +262,19 @@ Returns the metaclass of L. =item B -This creates the appropriate structure needed for the instance and -then calls C to bless it into the class. +This creates the appropriate structure needed for the instance and blesses it. =item B This does just exactly what it says it does. +This method has been deprecated but remains for compatibility reasons. None of +the subclasses of L ever bothered to actually make use of +it, so it was deemed unnecessary fluff. + =item B -This too does just exactly what it says it does. +Creates a shallow clone of $instance_structure. =back @@ -277,6 +298,19 @@ given to this object in C. This will return true if C<$slot_name> is a valid slot name. +=item B + +This method returns true when the meta instance must be recreated on any +superclass changes. + +Defaults to false. + +=item B + +This will return the current list of attributes (as +Class::MOP::Attribute objects) based on what was given to this object +in C. + =back =head2 Operations on Instance Structures