2 package Class::MOP::Instance;
7 use Scalar::Util 'isweak', 'weaken', 'blessed';
9 use base 'Class::MOP::Object';
11 # make this not a valid method name, to avoid (most) attribute conflicts
12 my $RESERVED_MOP_SLOT = '<<MOP>>';
15 my ($class, @args) = @_;
18 unshift @args, "associated_metaclass";
19 } elsif ( @args >= 2 && blessed($args[0]) && $args[0]->isa("Class::MOP::Class") ) {
21 my ( $meta, @attrs ) = @args;
22 @args = ( associated_metaclass => $meta, attributes => \@attrs );
27 $options{slots} ||= [ map { $_->slots } @{ $options{attributes} || [] } ];
28 $options{slot_hash} = { map { $_ => undef } @{ $options{slots} } }; # FIXME lazy_build
35 my $options = $class->BUILDARGS(@_);
37 # FIXME replace with a proper constructor
38 my $instance = $class->_new(%$options);
40 # FIXME weak_ref => 1,
41 weaken($instance->{'associated_metaclass'});
48 return Class::MOP::Class->initialize($class)->new_object(@_)
49 if $class ne __PACKAGE__;
51 my $params = @_ == 1 ? $_[0] : {@_};
54 # I am not sure that it makes
55 # sense to pass in the meta
56 # The ideal would be to just
57 # pass in the class name, but
58 # that is placing too much of
59 # an assumption on bless(),
60 # which is *probably* a safe
61 # assumption,.. but you can
63 'associated_metaclass' => $params->{associated_metaclass},
64 'attributes' => $params->{attributes},
65 'slots' => $params->{slots},
66 'slot_hash' => $params->{slot_hash},
70 sub _class_name { $_[0]->{_class_name} ||= $_[0]->associated_metaclass->name }
74 bless {}, $self->_class_name;
78 my ($self, $instance) = @_;
80 my $clone = $self->create_instance;
81 for my $attr ($self->get_all_attributes) {
82 next unless $attr->has_value($instance);
83 for my $slot ($attr->slots) {
84 my $val = $self->get_slot_value($instance, $slot);
85 $self->set_slot_value($clone, $slot, $val);
86 $self->weaken_slot_value($clone, $slot)
87 if $self->slot_value_is_weak($instance, $slot);
91 $self->_set_mop_slot($clone, $self->_get_mop_slot($instance))
92 if $self->_has_mop_slot($instance);
97 # operations on meta instance
101 return @{$self->{'slots'}};
104 sub get_all_attributes {
106 return @{$self->{attributes}};
110 my ($self, $slot_name) = @_;
111 exists $self->{'slot_hash'}->{$slot_name};
114 # operations on created instances
117 my ($self, $instance, $slot_name) = @_;
118 $instance->{$slot_name};
122 my ($self, $instance, $slot_name, $value) = @_;
123 $instance->{$slot_name} = $value;
126 sub initialize_slot {
127 my ($self, $instance, $slot_name) = @_;
131 sub deinitialize_slot {
132 my ( $self, $instance, $slot_name ) = @_;
133 delete $instance->{$slot_name};
136 sub initialize_all_slots {
137 my ($self, $instance) = @_;
138 foreach my $slot_name ($self->get_all_slots) {
139 $self->initialize_slot($instance, $slot_name);
143 sub deinitialize_all_slots {
144 my ($self, $instance) = @_;
145 foreach my $slot_name ($self->get_all_slots) {
146 $self->deinitialize_slot($instance, $slot_name);
150 sub is_slot_initialized {
151 my ($self, $instance, $slot_name, $value) = @_;
152 exists $instance->{$slot_name};
155 sub weaken_slot_value {
156 my ($self, $instance, $slot_name) = @_;
157 weaken $instance->{$slot_name};
160 sub slot_value_is_weak {
161 my ($self, $instance, $slot_name) = @_;
162 isweak $instance->{$slot_name};
165 sub strengthen_slot_value {
166 my ($self, $instance, $slot_name) = @_;
167 $self->set_slot_value($instance, $slot_name, $self->get_slot_value($instance, $slot_name));
170 sub rebless_instance_structure {
171 my ($self, $instance, $metaclass) = @_;
173 # we use $_[1] here because of t/cmop/rebless_overload.t regressions
175 bless $_[1], $metaclass->name;
178 sub is_dependent_on_superclasses {
179 return; # for meta instances that require updates on inherited slot changes
183 my ($self, $instance) = @_;
184 $self->get_slot_value($instance, $RESERVED_MOP_SLOT);
188 my ($self, $instance) = @_;
189 $self->is_slot_initialized($instance, $RESERVED_MOP_SLOT);
193 my ($self, $instance, $value) = @_;
194 $self->set_slot_value($instance, $RESERVED_MOP_SLOT, $value);
197 sub _clear_mop_slot {
198 my ($self, $instance) = @_;
199 $self->deinitialize_slot($instance, $RESERVED_MOP_SLOT);
202 # inlinable operation snippets
204 sub is_inlinable { 1 }
206 sub inline_create_instance {
207 my ($self, $class_variable) = @_;
208 'bless {} => ' . $class_variable;
211 sub inline_slot_access {
212 my ($self, $instance, $slot_name) = @_;
213 sprintf q[%s->{"%s"}], $instance, quotemeta($slot_name);
216 sub inline_get_is_lvalue { 1 }
218 sub inline_get_slot_value {
219 my ($self, $instance, $slot_name) = @_;
220 $self->inline_slot_access($instance, $slot_name);
223 sub inline_set_slot_value {
224 my ($self, $instance, $slot_name, $value) = @_;
225 $self->inline_slot_access($instance, $slot_name) . " = $value",
228 sub inline_initialize_slot {
229 my ($self, $instance, $slot_name) = @_;
233 sub inline_deinitialize_slot {
234 my ($self, $instance, $slot_name) = @_;
235 "delete " . $self->inline_slot_access($instance, $slot_name);
237 sub inline_is_slot_initialized {
238 my ($self, $instance, $slot_name) = @_;
239 "exists " . $self->inline_slot_access($instance, $slot_name);
242 sub inline_weaken_slot_value {
243 my ($self, $instance, $slot_name) = @_;
244 sprintf "Scalar::Util::weaken( %s )", $self->inline_slot_access($instance, $slot_name);
247 sub inline_strengthen_slot_value {
248 my ($self, $instance, $slot_name) = @_;
249 $self->inline_set_slot_value($instance, $slot_name, $self->inline_slot_access($instance, $slot_name));
252 sub inline_rebless_instance_structure {
253 my ($self, $instance, $class_variable) = @_;
254 "bless $instance => $class_variable";
257 sub _inline_get_mop_slot {
258 my ($self, $instance) = @_;
259 $self->inline_get_slot_value($instance, $RESERVED_MOP_SLOT);
262 sub _inline_set_mop_slot {
263 my ($self, $instance, $value) = @_;
264 $self->inline_set_slot_value($instance, $RESERVED_MOP_SLOT, $value);
267 sub _inline_clear_mop_slot {
268 my ($self, $instance) = @_;
269 $self->inline_deinitialize_slot($instance, $RESERVED_MOP_SLOT);
274 # ABSTRACT: Instance Meta Object
282 The Instance Protocol controls the creation of object instances, and
283 the storage of attribute values in those instances.
285 Using this API directly in your own code violates encapsulation, and
286 we recommend that you use the appropriate APIs in L<Class::MOP::Class>
287 and L<Class::MOP::Attribute> instead. Those APIs in turn call the
288 methods in this class as appropriate.
290 This class also participates in generating inlined code by providing
291 snippets of code to access an object instance.
295 =head2 Object construction
299 =item B<< Class::MOP::Instance->new(%options) >>
301 This method creates a new meta-instance object.
303 It accepts the following keys in C<%options>:
307 =item * associated_metaclass
309 The L<Class::MOP::Class> object for which instances will be created.
313 An array reference of L<Class::MOP::Attribute> objects. These are the
314 attributes which can be stored in each instance.
320 =head2 Creating and altering instances
324 =item B<< $metainstance->create_instance >>
326 This method returns a reference blessed into the associated
329 The default is to use a hash reference. Subclasses can override this.
331 =item B<< $metainstance->clone_instance($instance) >>
333 Given an instance, this method creates a new object by making
334 I<shallow> clone of the original.
342 =item B<< $metainstance->associated_metaclass >>
344 This returns the L<Class::MOP::Class> object associated with the
345 meta-instance object.
347 =item B<< $metainstance->get_all_slots >>
349 This returns a list of slot names stored in object instances. In
350 almost all cases, slot names correspond directly attribute names.
352 =item B<< $metainstance->is_valid_slot($slot_name) >>
354 This will return true if C<$slot_name> is a valid slot name.
356 =item B<< $metainstance->get_all_attributes >>
358 This returns a list of attributes corresponding to the attributes
359 passed to the constructor.
363 =head2 Operations on Instance Structures
365 It's important to understand that the meta-instance object is a
366 different entity from the actual instances it creates. For this
367 reason, any operations on the C<$instance_structure> always require
368 that the object instance be passed to the method.
372 =item B<< $metainstance->get_slot_value($instance_structure, $slot_name) >>
374 =item B<< $metainstance->set_slot_value($instance_structure, $slot_name, $value) >>
376 =item B<< $metainstance->initialize_slot($instance_structure, $slot_name) >>
378 =item B<< $metainstance->deinitialize_slot($instance_structure, $slot_name) >>
380 =item B<< $metainstance->initialize_all_slots($instance_structure) >>
382 =item B<< $metainstance->deinitialize_all_slots($instance_structure) >>
384 =item B<< $metainstance->is_slot_initialized($instance_structure, $slot_name) >>
386 =item B<< $metainstance->weaken_slot_value($instance_structure, $slot_name) >>
388 =item B<< $metainstance->slot_value_is_weak($instance_structure, $slot_name) >>
390 =item B<< $metainstance->strengthen_slot_value($instance_structure, $slot_name) >>
392 =item B<< $metainstance->rebless_instance_structure($instance_structure, $new_metaclass) >>
394 The exact details of what each method does should be fairly obvious
395 from the method name.
399 =head2 Inlinable Instance Operations
403 =item B<< $metainstance->is_inlinable >>
405 This is a boolean that indicates whether or not slot access operations
406 can be inlined. By default it is true, but subclasses can override
409 =item B<< $metainstance->inline_create_instance($class_variable) >>
411 This method expects a string that, I<when inlined>, will become a
412 class name. This would literally be something like C<'$class'>, not an
415 It returns a snippet of code that creates a new object for the
416 class. This is something like C< bless {}, $class_name >.
418 =item B<< $metainstance->inline_get_is_lvalue >>
420 Returns whether or not C<inline_get_slot_value> is a valid lvalue. This can be
421 used to do extra optimizations when generating inlined methods.
423 =item B<< $metainstance->inline_slot_access($instance_variable, $slot_name) >>
425 =item B<< $metainstance->inline_get_slot_value($instance_variable, $slot_name) >>
427 =item B<< $metainstance->inline_set_slot_value($instance_variable, $slot_name, $value) >>
429 =item B<< $metainstance->inline_initialize_slot($instance_variable, $slot_name) >>
431 =item B<< $metainstance->inline_deinitialize_slot($instance_variable, $slot_name) >>
433 =item B<< $metainstance->inline_is_slot_initialized($instance_variable, $slot_name) >>
435 =item B<< $metainstance->inline_weaken_slot_value($instance_variable, $slot_name) >>
437 =item B<< $metainstance->inline_strengthen_slot_value($instance_variable, $slot_name) >>
439 These methods all expect two arguments. The first is the name of a
440 variable, than when inlined, will represent the object
441 instance. Typically this will be a literal string like C<'$_[0]'>.
443 The second argument is a slot name.
445 The method returns a snippet of code that, when inlined, performs some
446 operation on the instance.
448 =item B<< $metainstance->inline_rebless_instance_structure($instance_variable, $class_variable) >>
450 This takes the name of a variable that will, when inlined, represent the object
451 instance, and the name of a variable that will represent the class to rebless
452 into, and returns code to rebless an instance into a class.
460 =item B<< Class::MOP::Instance->meta >>
462 This will return a L<Class::MOP::Class> instance for this class.
464 It should also be noted that L<Class::MOP> will actually bootstrap
465 this module by installing a number of attribute meta-objects into its