2 package Class::MOP::Instance;
7 use Scalar::Util '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) = @_;
79 bless { %$instance }, $self->_class_name;
82 # operations on meta instance
86 return @{$self->{'slots'}};
89 sub get_all_attributes {
91 return @{$self->{attributes}};
95 my ($self, $slot_name) = @_;
96 exists $self->{'slot_hash'}->{$slot_name};
99 # operations on created instances
102 my ($self, $instance, $slot_name) = @_;
103 $instance->{$slot_name};
107 my ($self, $instance, $slot_name, $value) = @_;
108 $instance->{$slot_name} = $value;
111 sub initialize_slot {
112 my ($self, $instance, $slot_name) = @_;
116 sub deinitialize_slot {
117 my ( $self, $instance, $slot_name ) = @_;
118 delete $instance->{$slot_name};
121 sub initialize_all_slots {
122 my ($self, $instance) = @_;
123 foreach my $slot_name ($self->get_all_slots) {
124 $self->initialize_slot($instance, $slot_name);
128 sub deinitialize_all_slots {
129 my ($self, $instance) = @_;
130 foreach my $slot_name ($self->get_all_slots) {
131 $self->deinitialize_slot($instance, $slot_name);
135 sub is_slot_initialized {
136 my ($self, $instance, $slot_name, $value) = @_;
137 exists $instance->{$slot_name};
140 sub weaken_slot_value {
141 my ($self, $instance, $slot_name) = @_;
142 weaken $instance->{$slot_name};
145 sub strengthen_slot_value {
146 my ($self, $instance, $slot_name) = @_;
147 $self->set_slot_value($instance, $slot_name, $self->get_slot_value($instance, $slot_name));
150 sub rebless_instance_structure {
151 my ($self, $instance, $metaclass) = @_;
153 # we use $_[1] here because of t/306_rebless_overload.t regressions on 5.8.8
154 bless $_[1], $metaclass->name;
157 sub is_dependent_on_superclasses {
158 return; # for meta instances that require updates on inherited slot changes
162 my ($self, $instance) = @_;
163 $self->get_slot_value($instance, $RESERVED_MOP_SLOT);
167 my ($self, $instance, $value) = @_;
168 $self->set_slot_value($instance, $RESERVED_MOP_SLOT, $value);
171 sub _clear_mop_slot {
172 my ($self, $instance) = @_;
173 $self->deinitialize_slot($instance, $RESERVED_MOP_SLOT);
176 # inlinable operation snippets
178 sub is_inlinable { 1 }
180 sub inline_create_instance {
181 my ($self, $class_variable) = @_;
182 'bless {} => ' . $class_variable;
185 sub inline_slot_access {
186 my ($self, $instance, $slot_name) = @_;
187 sprintf q[%s->{"%s"}], $instance, quotemeta($slot_name);
190 sub inline_get_is_lvalue { 1 }
192 sub inline_get_slot_value {
193 my ($self, $instance, $slot_name) = @_;
194 $self->inline_slot_access($instance, $slot_name);
197 sub inline_set_slot_value {
198 my ($self, $instance, $slot_name, $value) = @_;
199 $self->inline_slot_access($instance, $slot_name) . " = $value",
202 sub inline_initialize_slot {
203 my ($self, $instance, $slot_name) = @_;
207 sub inline_deinitialize_slot {
208 my ($self, $instance, $slot_name) = @_;
209 "delete " . $self->inline_slot_access($instance, $slot_name);
211 sub inline_is_slot_initialized {
212 my ($self, $instance, $slot_name) = @_;
213 "exists " . $self->inline_slot_access($instance, $slot_name);
216 sub inline_weaken_slot_value {
217 my ($self, $instance, $slot_name) = @_;
218 sprintf "Scalar::Util::weaken( %s )", $self->inline_slot_access($instance, $slot_name);
221 sub inline_strengthen_slot_value {
222 my ($self, $instance, $slot_name) = @_;
223 $self->inline_set_slot_value($instance, $slot_name, $self->inline_slot_access($instance, $slot_name));
226 sub inline_rebless_instance_structure {
227 my ($self, $instance, $class_variable) = @_;
228 "bless $instance => $class_variable";
231 sub _inline_get_mop_slot {
232 my ($self, $instance) = @_;
233 $self->inline_get_slot_value($instance, $RESERVED_MOP_SLOT);
236 sub _inline_set_mop_slot {
237 my ($self, $instance, $value) = @_;
238 $self->inline_set_slot_value($instance, $RESERVED_MOP_SLOT, $value);
241 sub _inline_clear_mop_slot {
242 my ($self, $instance) = @_;
243 $self->inline_deinitialize_slot($instance, $RESERVED_MOP_SLOT);
248 # ABSTRACT: Instance Meta Object
256 The Instance Protocol controls the creation of object instances, and
257 the storage of attribute values in those instances.
259 Using this API directly in your own code violates encapsulation, and
260 we recommend that you use the appropriate APIs in L<Class::MOP::Class>
261 and L<Class::MOP::Attribute> instead. Those APIs in turn call the
262 methods in this class as appropriate.
264 This class also participates in generating inlined code by providing
265 snippets of code to access an object instance.
269 =head2 Object construction
273 =item B<< Class::MOP::Instance->new(%options) >>
275 This method creates a new meta-instance object.
277 It accepts the following keys in C<%options>:
281 =item * associated_metaclass
283 The L<Class::MOP::Class> object for which instances will be created.
287 An array reference of L<Class::MOP::Attribute> objects. These are the
288 attributes which can be stored in each instance.
294 =head2 Creating and altering instances
298 =item B<< $metainstance->create_instance >>
300 This method returns a reference blessed into the associated
303 The default is to use a hash reference. Subclasses can override this.
305 =item B<< $metainstance->clone_instance($instance) >>
307 Given an instance, this method creates a new object by making
308 I<shallow> clone of the original.
316 =item B<< $metainstance->associated_metaclass >>
318 This returns the L<Class::MOP::Class> object associated with the
319 meta-instance object.
321 =item B<< $metainstance->get_all_slots >>
323 This returns a list of slot names stored in object instances. In
324 almost all cases, slot names correspond directly attribute names.
326 =item B<< $metainstance->is_valid_slot($slot_name) >>
328 This will return true if C<$slot_name> is a valid slot name.
330 =item B<< $metainstance->get_all_attributes >>
332 This returns a list of attributes corresponding to the attributes
333 passed to the constructor.
337 =head2 Operations on Instance Structures
339 It's important to understand that the meta-instance object is a
340 different entity from the actual instances it creates. For this
341 reason, any operations on the C<$instance_structure> always require
342 that the object instance be passed to the method.
346 =item B<< $metainstance->get_slot_value($instance_structure, $slot_name) >>
348 =item B<< $metainstance->set_slot_value($instance_structure, $slot_name, $value) >>
350 =item B<< $metainstance->initialize_slot($instance_structure, $slot_name) >>
352 =item B<< $metainstance->deinitialize_slot($instance_structure, $slot_name) >>
354 =item B<< $metainstance->initialize_all_slots($instance_structure) >>
356 =item B<< $metainstance->deinitialize_all_slots($instance_structure) >>
358 =item B<< $metainstance->is_slot_initialized($instance_structure, $slot_name) >>
360 =item B<< $metainstance->weaken_slot_value($instance_structure, $slot_name) >>
362 =item B<< $metainstance->strengthen_slot_value($instance_structure, $slot_name) >>
364 =item B<< $metainstance->rebless_instance_structure($instance_structure, $new_metaclass) >>
366 The exact details of what each method does should be fairly obvious
367 from the method name.
371 =head2 Inlinable Instance Operations
375 =item B<< $metainstance->is_inlinable >>
377 This is a boolean that indicates whether or not slot access operations
378 can be inlined. By default it is true, but subclasses can override
381 =item B<< $metainstance->inline_create_instance($class_variable) >>
383 This method expects a string that, I<when inlined>, will become a
384 class name. This would literally be something like C<'$class'>, not an
387 It returns a snippet of code that creates a new object for the
388 class. This is something like C< bless {}, $class_name >.
390 =item B<< $metainstance->inline_get_is_lvalue >>
392 Returns whether or not C<inline_get_slot_value> is a valid lvalue. This can be
393 used to do extra optimizations when generating inlined methods.
395 =item B<< $metainstance->inline_slot_access($instance_variable, $slot_name) >>
397 =item B<< $metainstance->inline_get_slot_value($instance_variable, $slot_name) >>
399 =item B<< $metainstance->inline_set_slot_value($instance_variable, $slot_name, $value) >>
401 =item B<< $metainstance->inline_initialize_slot($instance_variable, $slot_name) >>
403 =item B<< $metainstance->inline_deinitialize_slot($instance_variable, $slot_name) >>
405 =item B<< $metainstance->inline_is_slot_initialized($instance_variable, $slot_name) >>
407 =item B<< $metainstance->inline_weaken_slot_value($instance_variable, $slot_name) >>
409 =item B<< $metainstance->inline_strengthen_slot_value($instance_variable, $slot_name) >>
411 These methods all expect two arguments. The first is the name of a
412 variable, than when inlined, will represent the object
413 instance. Typically this will be a literal string like C<'$_[0]'>.
415 The second argument is a slot name.
417 The method returns a snippet of code that, when inlined, performs some
418 operation on the instance.
420 =item B<< $metainstance->inline_rebless_instance_structure($instance_variable, $class_variable) >>
422 This takes the name of a variable that will, when inlined, represent the object
423 instance, and the name of a variable that will represent the class to rebless
424 into, and returns code to rebless an instance into a class.
432 =item B<< Class::MOP::Instance->meta >>
434 This will return a L<Class::MOP::Class> instance for this class.
436 It should also be noted that L<Class::MOP> will actually bootstrap
437 this module by installing a number of attribute meta-objects into its