X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FInstance.pm;h=36aa833064e9abc391593cadec3f32b61fecfcec;hb=28fa06b5d932b8a2f9bc1b6b394893c0d7c9efac;hp=8c0a73a3e7323838c7b7b2f348f9e19ff0254c19;hpb=c09219327ecf55f83be207b58a80967a1baa199b;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Instance.pm b/lib/Class/MOP/Instance.pm index 8c0a73a..36aa833 100644 --- a/lib/Class/MOP/Instance.pm +++ b/lib/Class/MOP/Instance.pm @@ -6,18 +6,47 @@ use warnings; use Scalar::Util 'weaken', 'blessed'; -our $VERSION = '0.04'; +our $VERSION = '0.78'; +$VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; -sub meta { - require Class::MOP::Class; - Class::MOP::Class->initialize(blessed($_[0]) || $_[0]); +use base 'Class::MOP::Object'; + +sub BUILDARGS { + my ($class, @args) = @_; + + if ( @args == 1 ) { + unshift @args, "associated_metaclass"; + } elsif ( @args >= 2 && blessed($args[0]) && $args[0]->isa("Class::MOP::Class") ) { + # compat mode + my ( $meta, @attrs ) = @args; + @args = ( associated_metaclass => $meta, attributes => \@attrs ); + } + + my %options = @args; + # FIXME lazy_build + $options{slots} ||= [ map { $_->slots } @{ $options{attributes} || [] } ]; + $options{slot_hash} = { map { $_ => undef } @{ $options{slots} } }; # FIXME lazy_build + + return \%options; } sub new { - my ($class, $meta, @attrs) = @_; - my @slots = map { $_->slots } @attrs; - my $instance = bless { + my $class = shift; + my $options = $class->BUILDARGS(@_); + + # FIXME replace with a proper constructor + 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 @@ -28,42 +57,48 @@ sub new { # which is *probably* a safe # assumption,.. but you can # never tell <:) - '$!meta' => $meta, - '@!slots' => { map { $_ => undef } @slots }, + 'associated_metaclass' => $options{associated_metaclass}, + 'attributes' => $options{attributes}, + 'slots' => $options{slots}, + 'slot_hash' => $options{slot_hash}, } => $class; - - weaken($instance->{'$!meta'}); - - return $instance; } -sub associated_metaclass { (shift)->{'$!meta'} } +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 sub get_all_slots { my $self = shift; - return keys %{$self->{'@!slots'}}; + return @{$self->{'slots'}}; +} + +sub get_all_attributes { + my $self = shift; + return @{$self->{attributes}}; } sub is_valid_slot { my ($self, $slot_name) = @_; - exists $self->{'@!slots'}->{$slot_name}; + exists $self->{'slot_hash'}->{$slot_name}; } # operations on created instances @@ -78,23 +113,9 @@ sub set_slot_value { $instance->{$slot_name} = $value; } -sub _set_initial_slot_value { - my ($self, $instance, $slot_name, $value, $initializer) = @_; - - return $self->set_slot_value($instance, $slot_name, $value) - unless $initializer; - - my $callback = sub { - $self->set_slot_value($instance, $slot_name, $_[0]); - }; - - # most things will just want to set a value, so make it first arg - $instance->$initializer($value, $callback, $self); -} - sub initialize_slot { my ($self, $instance, $slot_name) = @_; - #$self->set_slot_value($instance, $slot_name, undef); + return; } sub deinitialize_slot { @@ -136,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 } @@ -147,7 +172,7 @@ sub inline_create_instance { sub inline_slot_access { my ($self, $instance, $slot_name) = @_; - sprintf "%s->{%s}", $instance, $slot_name; + sprintf q[%s->{"%s"}], $instance, quotemeta($slot_name); } sub inline_get_slot_value { @@ -162,7 +187,7 @@ sub inline_set_slot_value { sub inline_initialize_slot { my ($self, $instance, $slot_name) = @_; - $self->inline_set_slot_value($instance, $slot_name, 'undef'), + return ''; } sub inline_deinitialize_slot { @@ -194,20 +219,14 @@ __END__ Class::MOP::Instance - Instance Meta Object -=head1 SYNOPSIS - - # This API is largely internal - # you shouldn't need it unless you are writing meta attributes or meta - # instances - =head1 DESCRIPTION The meta instance is used by attributes for low level storage. Using this API generally violates attribute encapsulation and is not -reccomended, instead look at L, -L for the reccomended way to fiddle with -attribute values in a generic way, independant of how/whether accessors have +recommended, instead look at L, +L for the recommended way to fiddle with +attribute values in a generic way, independent of how/whether accessors have been defined. Accessors can be found using L. This may seem like over-abstraction, but by abstracting @@ -222,15 +241,18 @@ F for details). =over 4 -=item B +=item B Creates a new instance meta-object and gathers all the slots from the list of C<@attrs> given. +=item B + +Processes arguments for compatibility. + =item B -This will return a B instance which is related -to this class. +Returns the metaclass of L. =back @@ -240,18 +262,23 @@ to this class. =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 +Creates a shallow clone of $instance_structure. + =back -=head2 Instrospection +=head2 Introspection NOTE: There might be more methods added to this part of the API, we will add then when we need them basically. @@ -260,6 +287,8 @@ we will add then when we need them basically. =item B +This returns the metaclass associated with this instance. + =item B This will return the current list of slots based on what was @@ -267,6 +296,21 @@ given to this object in C. =item B +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 @@ -276,6 +320,10 @@ instance meta-object is a different entity from the actual instance it creates. For this reason, any actions on slots require that the C<$instance_structure> is passed into them. +The names of these methods pretty much explain exactly +what they do, if that is not enough then I suggest reading +the source, it is very straightfoward. + =over 4 =item B @@ -302,19 +350,13 @@ require that the C<$instance_structure> is passed into them. =head2 Inlineable Instance Operations -This part of the API is currently un-used. It is there for use -in future experiments in class finailization mostly. Best to -ignore this for now. - =over 4 =item B Each meta-instance should override this method to tell Class::MOP if it's -possible to inline the slot access. - -This is currently only used by Class::MOP::Class::Immutable when performing -optimizations. +possible to inline the slot access. This is currently only used by +L when performing optimizations. =item B