X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FInstance.pm;h=87d201f80ba618294179c82a690be5818a3507df;hb=d004c8d565f9b314da7652e9368aeb4587ffaa3d;hp=9806228b0fc956b18be117edbd2a9decc7d65aa3;hpb=b4bd10ecd2eabe1a2c1bc3addad22b207f6592ee;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Instance.pm b/lib/Class/MOP/Instance.pm index 9806228..87d201f 100644 --- a/lib/Class/MOP/Instance.pm +++ b/lib/Class/MOP/Instance.pm @@ -6,12 +6,15 @@ use warnings; use Scalar::Util 'weaken', 'blessed'; -our $VERSION = '0.77'; +our $VERSION = '1.12'; $VERSION = eval $VERSION; 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) = @_; @@ -45,8 +48,12 @@ sub new { } sub _new { - my ( $class, %options ) = @_; - bless { + my $class = shift; + return Class::MOP::Class->initialize($class)->new_object(@_) + if $class ne __PACKAGE__; + + my $params = @_ == 1 ? $_[0] : {@_}; + return bless { # NOTE: # I am not sure that it makes # sense to pass in the meta @@ -57,28 +64,20 @@ 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' => $params->{associated_metaclass}, + 'attributes' => $params->{attributes}, + 'slots' => $params->{slots}, + 'slot_hash' => $params->{slot_hash}, } => $class; } sub _class_name { $_[0]->{_class_name} ||= $_[0]->associated_metaclass->name } -sub associated_metaclass { $_[0]{'associated_metaclass'} } - sub create_instance { my $self = shift; bless {}, $self->_class_name; } -# for compatibility -sub bless_instance_structure { - my ($self, $instance_structure) = @_; - bless $instance_structure, $self->_class_name; -} - sub clone_instance { my ($self, $instance) = @_; bless { %$instance }, $self->_class_name; @@ -154,13 +153,30 @@ 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 } +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 } @@ -172,9 +188,11 @@ 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_is_lvalue { 1 } + sub inline_get_slot_value { my ($self, $instance, $slot_name) = @_; $self->inline_slot_access($instance, $slot_name); @@ -209,6 +227,26 @@ sub inline_strengthen_slot_value { $self->inline_set_slot_value($instance, $slot_name, $self->inline_slot_access($instance, $slot_name)); } +sub inline_rebless_instance_structure { + my ($self, $instance, $class_variable) = @_; + "bless $instance => $class_variable"; +} + +sub _inline_get_mop_slot { + my ($self, $instance) = @_; + $self->inline_get_slot_value($instance, $RESERVED_MOP_SLOT); +} + +sub _inline_set_mop_slot { + my ($self, $instance, $value) = @_; + $self->inline_set_slot_value($instance, $RESERVED_MOP_SLOT, $value); +} + +sub _inline_clear_mop_slot { + my ($self, $instance) = @_; + $self->inline_deinitialize_slot($instance, $RESERVED_MOP_SLOT); +} + 1; __END__ @@ -221,160 +259,189 @@ Class::MOP::Instance - Instance Meta Object =head1 DESCRIPTION -The meta instance is used by attributes for low level storage. +The Instance Protocol controls the creation of object instances, and +the storage of attribute values in those instances. -Using this API generally violates attribute encapsulation and is not -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. +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. -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). +This class also participates in generating inlined code by providing +snippets of code to access an object instance. =head1 METHODS +=head2 Object construction + =over 4 -=item B +=item B<< Class::MOP::Instance->new(%options) >> + +This method creates a new meta-instance object. -Creates a new instance meta-object and gathers all the slots from -the list of C<@attrs> given. +It accepts the following keys in C<%options>: -=item B +=over 8 -Processes arguments for compatibility. +=item * associated_metaclass -=item B +The L object for which instances will be created. -Returns the metaclass of L. +=item * attributes + +An array reference of L objects. These are the +attributes which can be stored in each instance. + +=back =back -=head2 Creation of Instances +=head2 Creating and altering instances =over 4 -=item B +=item B<< $metainstance->create_instance >> + +This method returns a reference blessed into the associated +metaclass's class. + +The default is to use a hash reference. Subclasses can override this. + +=item B<< $metainstance->clone_instance($instance) >> + +Given an instance, this method creates a new object by making +I clone of the original. -This creates the appropriate structure needed for the instance and blesses it. +=back + +=head2 Introspection -=item B +=over 4 -This does just exactly what it says it does. +=item B<< $metainstance->associated_metaclass >> -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. +This returns the L object associated with the +meta-instance object. -=item B +=item B<< $metainstance->get_all_slots >> -Creates a shallow clone of $instance_structure. +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 Introspection +=head2 Operations on Instance Structures -NOTE: There might be more methods added to this part of the API, -we will add then when we need them basically. +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) >> -This returns the metaclass associated with this instance. +=item B<< $metainstance->set_slot_value($instance_structure, $slot_name, $value) >> -=item B +=item B<< $metainstance->initialize_slot($instance_structure, $slot_name) >> -This will return the current list of slots based on what was -given to this object in C. +=item B<< $metainstance->deinitialize_slot($instance_structure, $slot_name) >> -=item B +=item B<< $metainstance->initialize_all_slots($instance_structure) >> -This will return true if C<$slot_name> is a valid slot name. +=item B<< $metainstance->deinitialize_all_slots($instance_structure) >> -=item B +=item B<< $metainstance->is_slot_initialized($instance_structure, $slot_name) >> -This method returns true when the meta instance must be recreated on any -superclass changes. +=item B<< $metainstance->weaken_slot_value($instance_structure, $slot_name) >> -Defaults to false. +=item B<< $metainstance->strengthen_slot_value($instance_structure, $slot_name) >> -=item B +=item B<< $metainstance->rebless_instance_structure($instance_structure, $new_metaclass) >> -This will return the current list of attributes (as -Class::MOP::Attribute objects) based on what was given to this object -in C. +The exact details of what each method does should be fairly obvious +from the method name. =back -=head2 Operations on Instance Structures +=head2 Inlinable Instance Operations -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. +=over 4 -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. +=item B<< $metainstance->is_inlinable >> -=over 4 +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. -=item B +=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_get_is_lvalue >> -=item B +Returns whether or not C is a valid lvalue. This can be +used to do extra optimizations when generating inlined methods. -=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 +=item B<< $metainstance->inline_deinitialize_slot($instance_variable, $slot_name) >> -=back +=item B<< $metainstance->inline_is_slot_initialized($instance_variable, $slot_name) >> -=head2 Inlineable Instance Operations +=item B<< $metainstance->inline_weaken_slot_value($instance_variable, $slot_name) >> -=over 4 +=item B<< $metainstance->inline_strengthen_slot_value($instance_variable, $slot_name) >> -=item B +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]'>. -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 -L when performing optimizations. +The second argument is a slot name. -=item B +The method returns a snippet of code that, when inlined, performs some +operation on the instance. -=item B +=item B<< $metainstance->inline_rebless_instance_structure($instance_variable, $class_variable) >> -=item B +This takes the name of a variable that will, when inlined, represent the object +instance, and the name of a variable that will represent the class to rebless +into, and returns code to rebless an instance into a class. -=item B +=back -=item B +=head2 Introspection -=item B +=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 @@ -386,7 +453,7 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006-2008 by Infinity Interactive, Inc. +Copyright 2006-2010 by Infinity Interactive, Inc. L