X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FInstance.pm;h=885e17f5ca516ae9380a6e87cf30cf437758b076;hb=f3ddcd1a0bcb963fc368a7f7fcbd1cf76c515ed0;hp=baac84b399a65b956e89cc9c9556b80ecb6e48dd;hpb=5fdf066d58008b9e3ceddf2f55001c6cf28d8791;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Instance.pm b/lib/Class/MOP/Instance.pm index baac84b..885e17f 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.03'; +our $VERSION = '0.80'; +$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,49 +57,55 @@ 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} ? 1 : 0; + exists $self->{'slot_hash'}->{$slot_name}; } # operations on created instances sub get_slot_value { my ($self, $instance, $slot_name) = @_; - $self->is_slot_initialized($instance, $slot_name) ? $instance->{$slot_name} : undef; + $instance->{$slot_name}; } sub set_slot_value { @@ -80,7 +115,7 @@ sub set_slot_value { sub initialize_slot { my ($self, $instance, $slot_name) = @_; - #$self->set_slot_value($instance, $slot_name, undef); + return; } sub deinitialize_slot { @@ -104,7 +139,7 @@ sub deinitialize_all_slots { sub is_slot_initialized { my ($self, $instance, $slot_name, $value) = @_; - exists $instance->{$slot_name} ? 1 : 0; + exists $instance->{$slot_name}; } sub weaken_slot_value { @@ -119,7 +154,13 @@ sub strengthen_slot_value { sub rebless_instance_structure { my ($self, $instance, $metaclass) = @_; - bless $instance, $metaclass->name; + + # we use $_[1] here because of t/306_rebless_overload.t regressions on 5.8.8 + bless $_[1], $metaclass->name; +} + +sub is_dependent_on_superclasses { + return; # for meta instances that require updates on inherited slot changes } # inlinable operation snippets @@ -133,13 +174,12 @@ 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 { my ($self, $instance, $slot_name) = @_; - 'exists ' . $self->inline_slot_access($instance, $slot_name) . - ' ? ' . $self->inline_slot_access($instance, $slot_name) . ' : undef' + $self->inline_slot_access($instance, $slot_name); } sub inline_set_slot_value { @@ -149,7 +189,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 { @@ -158,7 +198,7 @@ sub inline_deinitialize_slot { } sub inline_is_slot_initialized { my ($self, $instance, $slot_name) = @_; - "exists " . $self->inline_slot_access($instance, $slot_name) . " ? 1 : 0"; + "exists " . $self->inline_slot_access($instance, $slot_name); } sub inline_weaken_slot_value { @@ -181,150 +221,180 @@ __END__ Class::MOP::Instance - Instance Meta Object -=head1 SYNOPSIS +=head1 DESCRIPTION - # for the most part, this protocol is internal - # and not for public usage, but this how one - # might use it +The Instance Protocol controls the creation of object instances, and +the storage of attribute values in those instances. - package Foo; +Using this API directly in your own code violates encapsulation, and +we recommend that you use the appropriate APIs in L +and L instead. Those APIs in turn call the +methods in this class as appropriate. - use strict; - use warnings; - use metaclass ( - ':instance_metaclass' => 'ArrayBasedStorage::Instance', - ); +This class also participates in generating inlined code by providing +snippets of code to access an object instance. - # now Foo->new produces blessed ARRAY ref based objects +=head1 METHODS -=head1 DESCRIPTION +=head2 Object construction -This is a sub-protocol which governs instance creation -and access to the slots of the instance structure. +=over 4 -This may seem like over-abstraction, but by abstracting -this process into a sub-protocol we make it possible to -easily switch the details of how an object's instance is -stored with minimal impact. In most cases just subclassing -this class will be all you need to do (see the examples; -F and -F for details). +=item B<< Class::MOP::Instance->new(%options) >> -=head1 METHODS +This method creates a new meta-instance object. -=over 4 +It accepts the following keys in C<%options>: + +=over 8 -=item B +=item * associated_metaclass -Creates a new instance meta-object and gathers all the slots from -the list of C<@attrs> given. +The L object for which instances will be created. -=item B +=item * attributes -This will return a B instance which is related -to this class. +An array reference of L objects. These are the +attributes which can be stored in each instance. =back -=head2 Creation of Instances +=back + +=head2 Creating and altering instances =over 4 -=item B +=item B<< $metainstance->create_instance >> -This creates the appropriate structure needed for the instance and -then calls C to bless it into the class. +This method returns a reference blessed into the associated +metaclass's class. -=item B +The default is to use a hash reference. Subclasses can override this. -This does just exactly what it says it does. +=item B<< $metainstance->clone_instance($instance) >> -=item B +Given an instance, this method creates a new object by making +I clone of the original. =back -=head2 Instrospection - -NOTE: There might be more methods added to this part of the API, -we will add then when we need them basically. +=head2 Introspection =over 4 -=item B +=item B<< $metainstance->associated_metaclass >> -=item B +This returns the L object associated with the +meta-instance object. -This will return the current list of slots based on what was -given to this object in C. +=item B<< $metainstance->get_all_slots >> -=item B +This returns a list of slot names stored in object instances. In +almost all cases, slot names correspond directly attribute names. + +=item B<< $metainstance->is_valid_slot($slot_name) >> + +This will return true if C<$slot_name> is a valid slot name. + +=item B<< $metainstance->get_all_attributes >> + +This returns a list of attributes corresponding to the attributes +passed to the constructor. =back =head2 Operations on Instance Structures -An important distinction of this sub-protocol is that the -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. +It's important to understand that the meta-instance object is a +different entity from the actual instances it creates. For this +reason, any operations on the C<$instance_structure> always require +that the object instance be passed to the method. =over 4 -=item B +=item B<< $metainstance->get_slot_value($instance_structure, $slot_name) >> -=item B +=item B<< $metainstance->set_slot_value($instance_structure, $slot_name, $value) >> -=item B +=item B<< $metainstance->initialize_slot($instance_structure, $slot_name) >> -=item B +=item B<< $metainstance->deinitialize_slot($instance_structure, $slot_name) >> -=item B +=item B<< $metainstance->initialize_all_slots($instance_structure) >> -=item B +=item B<< $metainstance->deinitialize_all_slots($instance_structure) >> -=item B +=item B<< $metainstance->is_slot_initialized($instance_structure, $slot_name) >> -=item B +=item B<< $metainstance->weaken_slot_value($instance_structure, $slot_name) >> -=item B +=item B<< $metainstance->strengthen_slot_value($instance_structure, $slot_name) >> -=item B +=item B<< $metainstance->rebless_instance_structure($instance_structure, $new_metaclass) >> -=back +The exact details of what each method does should be fairly obvious +from the method name. -=head2 Inlineable Instance Operations +=back -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. +=head2 Inlinable Instance Operations =over 4 -=item B +=item B<< $metainstance->is_inlinable >> -Each meta-instance should override this method to tell Class::MOP if it's -possible to inline the slot access. +This is a boolean that indicates whether or not slot access operations +can be inlined. By default it is true, but subclasses can override +this. -This is currently only used by Class::MOP::Class::Immutable when performing -optimizations. +=item B<< $metainstance->inline_create_instance($class_variable) >> -=item B +This method expects a string that, I, will become a +class name. This would literally be something like C<'$class'>, not an +actual class name. -=item B +It returns a snippet of code that creates a new object for the +class. This is something like C< bless {}, $class_name >. -=item B +=item B<< $metainstance->inline_slot_access($instance_variable, $slot_name) >> -=item B +=item B<< $metainstance->inline_get_slot_value($instance_variable, $slot_name) >> -=item B +=item B<< $metainstance->inline_set_slot_value($instance_variable, $slot_name, $value) >> -=item B +=item B<< $metainstance->inline_initialize_slot($instance_variable, $slot_name) >> + +=item B<< $metainstance->inline_deinitialize_slot($instance_variable, $slot_name) >> + +=item B<< $metainstance->inline_is_slot_initialized($instance_variable, $slot_name) >> + +=item B<< $metainstance->inline_weaken_slot_value($instance_variable, $slot_name) >> + +=item B<< $metainstance->inline_strengthen_slot_value($instance_variable, $slot_name) >> + +These methods all expect two arguments. The first is the name of a +variable, than when inlined, will represent the object +instance. Typically this will be a literal string like C<'$_[0]'>. + +The second argument is a slot name. + +The method returns a snippet of code that, when inlined, performs some +operation on the instance. + +=back + +=head2 Introspection + +=over 4 -=item B +=item B<< Class::MOP::Instance->meta >> -=item B +This will return a L instance for this class. -=item B +It should also be noted that L will actually bootstrap +this module by installing a number of attribute meta-objects into its +metaclass. =back @@ -336,7 +406,7 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006-2008 by Infinity Interactive, Inc. +Copyright 2006-2009 by Infinity Interactive, Inc. L