2 package Class::MOP::Instance;
7 use Scalar::Util 'weaken', 'blessed';
10 $VERSION = eval $VERSION;
11 our $AUTHORITY = 'cpan:STEVAN';
13 use base 'Class::MOP::Object';
15 # make this not a valid method name, to avoid (most) attribute conflicts
16 my $RESERVED_MOP_SLOT = '<<MOP>>';
19 my ($class, @args) = @_;
22 unshift @args, "associated_metaclass";
23 } elsif ( @args >= 2 && blessed($args[0]) && $args[0]->isa("Class::MOP::Class") ) {
25 my ( $meta, @attrs ) = @args;
26 @args = ( associated_metaclass => $meta, attributes => \@attrs );
31 $options{slots} ||= [ map { $_->slots } @{ $options{attributes} || [] } ];
32 $options{slot_hash} = { map { $_ => undef } @{ $options{slots} } }; # FIXME lazy_build
39 my $options = $class->BUILDARGS(@_);
41 # FIXME replace with a proper constructor
42 my $instance = $class->_new(%$options);
44 # FIXME weak_ref => 1,
45 weaken($instance->{'associated_metaclass'});
52 return Class::MOP::Class->initialize($class)->new_object(@_)
53 if $class ne __PACKAGE__;
55 my $params = @_ == 1 ? $_[0] : {@_};
58 # I am not sure that it makes
59 # sense to pass in the meta
60 # The ideal would be to just
61 # pass in the class name, but
62 # that is placing too much of
63 # an assumption on bless(),
64 # which is *probably* a safe
65 # assumption,.. but you can
67 'associated_metaclass' => $params->{associated_metaclass},
68 'attributes' => $params->{attributes},
69 'slots' => $params->{slots},
70 'slot_hash' => $params->{slot_hash},
74 sub _class_name { $_[0]->{_class_name} ||= $_[0]->associated_metaclass->name }
78 bless {}, $self->_class_name;
82 my ($self, $instance) = @_;
83 bless { %$instance }, $self->_class_name;
86 # operations on meta instance
90 return @{$self->{'slots'}};
93 sub get_all_attributes {
95 return @{$self->{attributes}};
99 my ($self, $slot_name) = @_;
100 exists $self->{'slot_hash'}->{$slot_name};
103 # operations on created instances
106 my ($self, $instance, $slot_name) = @_;
107 $instance->{$slot_name};
111 my ($self, $instance, $slot_name, $value) = @_;
112 $instance->{$slot_name} = $value;
115 sub initialize_slot {
116 my ($self, $instance, $slot_name) = @_;
120 sub deinitialize_slot {
121 my ( $self, $instance, $slot_name ) = @_;
122 delete $instance->{$slot_name};
125 sub initialize_all_slots {
126 my ($self, $instance) = @_;
127 foreach my $slot_name ($self->get_all_slots) {
128 $self->initialize_slot($instance, $slot_name);
132 sub deinitialize_all_slots {
133 my ($self, $instance) = @_;
134 foreach my $slot_name ($self->get_all_slots) {
135 $self->deinitialize_slot($instance, $slot_name);
139 sub is_slot_initialized {
140 my ($self, $instance, $slot_name, $value) = @_;
141 exists $instance->{$slot_name};
144 sub weaken_slot_value {
145 my ($self, $instance, $slot_name) = @_;
146 weaken $instance->{$slot_name};
149 sub strengthen_slot_value {
150 my ($self, $instance, $slot_name) = @_;
151 $self->set_slot_value($instance, $slot_name, $self->get_slot_value($instance, $slot_name));
154 sub rebless_instance_structure {
155 my ($self, $instance, $metaclass) = @_;
157 # we use $_[1] here because of t/306_rebless_overload.t regressions on 5.8.8
158 bless $_[1], $metaclass->name;
161 sub is_dependent_on_superclasses {
162 return; # for meta instances that require updates on inherited slot changes
166 my ($self, $instance) = @_;
167 $self->get_slot_value($instance, $RESERVED_MOP_SLOT);
171 my ($self, $instance, $value) = @_;
172 $self->set_slot_value($instance, $RESERVED_MOP_SLOT, $value);
175 sub _clear_mop_slot {
176 my ($self, $instance) = @_;
177 $self->deinitialize_slot($instance, $RESERVED_MOP_SLOT);
180 # inlinable operation snippets
182 sub is_inlinable { 1 }
184 sub inline_create_instance {
185 my ($self, $class_variable) = @_;
186 'bless {} => ' . $class_variable;
189 sub inline_slot_access {
190 my ($self, $instance, $slot_name) = @_;
191 sprintf q[%s->{"%s"}], $instance, quotemeta($slot_name);
194 sub inline_get_is_lvalue { 1 }
196 sub inline_get_slot_value {
197 my ($self, $instance, $slot_name) = @_;
198 $self->inline_slot_access($instance, $slot_name);
201 sub inline_set_slot_value {
202 my ($self, $instance, $slot_name, $value) = @_;
203 $self->inline_slot_access($instance, $slot_name) . " = $value",
206 sub inline_initialize_slot {
207 my ($self, $instance, $slot_name) = @_;
211 sub inline_deinitialize_slot {
212 my ($self, $instance, $slot_name) = @_;
213 "delete " . $self->inline_slot_access($instance, $slot_name);
215 sub inline_is_slot_initialized {
216 my ($self, $instance, $slot_name) = @_;
217 "exists " . $self->inline_slot_access($instance, $slot_name);
220 sub inline_weaken_slot_value {
221 my ($self, $instance, $slot_name) = @_;
222 sprintf "Scalar::Util::weaken( %s )", $self->inline_slot_access($instance, $slot_name);
225 sub inline_strengthen_slot_value {
226 my ($self, $instance, $slot_name) = @_;
227 $self->inline_set_slot_value($instance, $slot_name, $self->inline_slot_access($instance, $slot_name));
230 sub inline_rebless_instance_structure {
231 my ($self, $instance, $class_variable) = @_;
232 "bless $instance => $class_variable";
235 sub _inline_get_mop_slot {
236 my ($self, $instance) = @_;
237 $self->inline_get_slot_value($instance, $RESERVED_MOP_SLOT);
240 sub _inline_set_mop_slot {
241 my ($self, $instance, $value) = @_;
242 $self->inline_set_slot_value($instance, $RESERVED_MOP_SLOT, $value);
245 sub _inline_clear_mop_slot {
246 my ($self, $instance) = @_;
247 $self->inline_deinitialize_slot($instance, $RESERVED_MOP_SLOT);
258 Class::MOP::Instance - Instance Meta Object
262 The Instance Protocol controls the creation of object instances, and
263 the storage of attribute values in those instances.
265 Using this API directly in your own code violates encapsulation, and
266 we recommend that you use the appropriate APIs in L<Class::MOP::Class>
267 and L<Class::MOP::Attribute> instead. Those APIs in turn call the
268 methods in this class as appropriate.
270 This class also participates in generating inlined code by providing
271 snippets of code to access an object instance.
275 =head2 Object construction
279 =item B<< Class::MOP::Instance->new(%options) >>
281 This method creates a new meta-instance object.
283 It accepts the following keys in C<%options>:
287 =item * associated_metaclass
289 The L<Class::MOP::Class> object for which instances will be created.
293 An array reference of L<Class::MOP::Attribute> objects. These are the
294 attributes which can be stored in each instance.
300 =head2 Creating and altering instances
304 =item B<< $metainstance->create_instance >>
306 This method returns a reference blessed into the associated
309 The default is to use a hash reference. Subclasses can override this.
311 =item B<< $metainstance->clone_instance($instance) >>
313 Given an instance, this method creates a new object by making
314 I<shallow> clone of the original.
322 =item B<< $metainstance->associated_metaclass >>
324 This returns the L<Class::MOP::Class> object associated with the
325 meta-instance object.
327 =item B<< $metainstance->get_all_slots >>
329 This returns a list of slot names stored in object instances. In
330 almost all cases, slot names correspond directly attribute names.
332 =item B<< $metainstance->is_valid_slot($slot_name) >>
334 This will return true if C<$slot_name> is a valid slot name.
336 =item B<< $metainstance->get_all_attributes >>
338 This returns a list of attributes corresponding to the attributes
339 passed to the constructor.
343 =head2 Operations on Instance Structures
345 It's important to understand that the meta-instance object is a
346 different entity from the actual instances it creates. For this
347 reason, any operations on the C<$instance_structure> always require
348 that the object instance be passed to the method.
352 =item B<< $metainstance->get_slot_value($instance_structure, $slot_name) >>
354 =item B<< $metainstance->set_slot_value($instance_structure, $slot_name, $value) >>
356 =item B<< $metainstance->initialize_slot($instance_structure, $slot_name) >>
358 =item B<< $metainstance->deinitialize_slot($instance_structure, $slot_name) >>
360 =item B<< $metainstance->initialize_all_slots($instance_structure) >>
362 =item B<< $metainstance->deinitialize_all_slots($instance_structure) >>
364 =item B<< $metainstance->is_slot_initialized($instance_structure, $slot_name) >>
366 =item B<< $metainstance->weaken_slot_value($instance_structure, $slot_name) >>
368 =item B<< $metainstance->strengthen_slot_value($instance_structure, $slot_name) >>
370 =item B<< $metainstance->rebless_instance_structure($instance_structure, $new_metaclass) >>
372 The exact details of what each method does should be fairly obvious
373 from the method name.
377 =head2 Inlinable Instance Operations
381 =item B<< $metainstance->is_inlinable >>
383 This is a boolean that indicates whether or not slot access operations
384 can be inlined. By default it is true, but subclasses can override
387 =item B<< $metainstance->inline_create_instance($class_variable) >>
389 This method expects a string that, I<when inlined>, will become a
390 class name. This would literally be something like C<'$class'>, not an
393 It returns a snippet of code that creates a new object for the
394 class. This is something like C< bless {}, $class_name >.
396 =item B<< $metainstance->inline_get_is_lvalue >>
398 Returns whether or not C<inline_get_slot_value> is a valid lvalue. This can be
399 used to do extra optimizations when generating inlined methods.
401 =item B<< $metainstance->inline_slot_access($instance_variable, $slot_name) >>
403 =item B<< $metainstance->inline_get_slot_value($instance_variable, $slot_name) >>
405 =item B<< $metainstance->inline_set_slot_value($instance_variable, $slot_name, $value) >>
407 =item B<< $metainstance->inline_initialize_slot($instance_variable, $slot_name) >>
409 =item B<< $metainstance->inline_deinitialize_slot($instance_variable, $slot_name) >>
411 =item B<< $metainstance->inline_is_slot_initialized($instance_variable, $slot_name) >>
413 =item B<< $metainstance->inline_weaken_slot_value($instance_variable, $slot_name) >>
415 =item B<< $metainstance->inline_strengthen_slot_value($instance_variable, $slot_name) >>
417 These methods all expect two arguments. The first is the name of a
418 variable, than when inlined, will represent the object
419 instance. Typically this will be a literal string like C<'$_[0]'>.
421 The second argument is a slot name.
423 The method returns a snippet of code that, when inlined, performs some
424 operation on the instance.
426 =item B<< $metainstance->inline_rebless_instance_structure($instance_variable, $class_variable) >>
428 This takes the name of a variable that will, when inlined, represent the object
429 instance, and the name of a variable that will represent the class to rebless
430 into, and returns code to rebless an instance into a class.
438 =item B<< Class::MOP::Instance->meta >>
440 This will return a L<Class::MOP::Class> instance for this class.
442 It should also be noted that L<Class::MOP> will actually bootstrap
443 this module by installing a number of attribute meta-objects into its
450 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
452 Stevan Little E<lt>stevan@iinteractive.comE<gt>
454 =head1 COPYRIGHT AND LICENSE
456 Copyright 2006-2010 by Infinity Interactive, Inc.
458 L<http://www.iinteractive.com>
460 This library is free software; you can redistribute it and/or modify
461 it under the same terms as Perl itself.