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/cmop/rebless_overload.t regressions
155 bless $_[1], $metaclass->name;
158 sub is_dependent_on_superclasses {
159 return; # for meta instances that require updates on inherited slot changes
163 my ($self, $instance) = @_;
164 $self->get_slot_value($instance, $RESERVED_MOP_SLOT);
168 my ($self, $instance, $value) = @_;
169 $self->set_slot_value($instance, $RESERVED_MOP_SLOT, $value);
172 sub _clear_mop_slot {
173 my ($self, $instance) = @_;
174 $self->deinitialize_slot($instance, $RESERVED_MOP_SLOT);
177 # inlinable operation snippets
179 sub is_inlinable { 1 }
181 sub inline_create_instance {
182 my ($self, $class_variable) = @_;
183 'bless {} => ' . $class_variable;
186 sub inline_slot_access {
187 my ($self, $instance, $slot_name) = @_;
188 sprintf q[%s->{"%s"}], $instance, quotemeta($slot_name);
191 sub inline_get_is_lvalue { 1 }
193 sub inline_get_slot_value {
194 my ($self, $instance, $slot_name) = @_;
195 $self->inline_slot_access($instance, $slot_name);
198 sub inline_set_slot_value {
199 my ($self, $instance, $slot_name, $value) = @_;
200 $self->inline_slot_access($instance, $slot_name) . " = $value",
203 sub inline_initialize_slot {
204 my ($self, $instance, $slot_name) = @_;
208 sub inline_deinitialize_slot {
209 my ($self, $instance, $slot_name) = @_;
210 "delete " . $self->inline_slot_access($instance, $slot_name);
212 sub inline_is_slot_initialized {
213 my ($self, $instance, $slot_name) = @_;
214 "exists " . $self->inline_slot_access($instance, $slot_name);
217 sub inline_weaken_slot_value {
218 my ($self, $instance, $slot_name) = @_;
219 sprintf "Scalar::Util::weaken( %s )", $self->inline_slot_access($instance, $slot_name);
222 sub inline_strengthen_slot_value {
223 my ($self, $instance, $slot_name) = @_;
224 $self->inline_set_slot_value($instance, $slot_name, $self->inline_slot_access($instance, $slot_name));
227 sub inline_rebless_instance_structure {
228 my ($self, $instance, $class_variable) = @_;
229 "bless $instance => $class_variable";
232 sub _inline_get_mop_slot {
233 my ($self, $instance) = @_;
234 $self->inline_get_slot_value($instance, $RESERVED_MOP_SLOT);
237 sub _inline_set_mop_slot {
238 my ($self, $instance, $value) = @_;
239 $self->inline_set_slot_value($instance, $RESERVED_MOP_SLOT, $value);
242 sub _inline_clear_mop_slot {
243 my ($self, $instance) = @_;
244 $self->inline_deinitialize_slot($instance, $RESERVED_MOP_SLOT);
249 # ABSTRACT: Instance Meta Object
257 The Instance Protocol controls the creation of object instances, and
258 the storage of attribute values in those instances.
260 Using this API directly in your own code violates encapsulation, and
261 we recommend that you use the appropriate APIs in L<Class::MOP::Class>
262 and L<Class::MOP::Attribute> instead. Those APIs in turn call the
263 methods in this class as appropriate.
265 This class also participates in generating inlined code by providing
266 snippets of code to access an object instance.
270 =head2 Object construction
274 =item B<< Class::MOP::Instance->new(%options) >>
276 This method creates a new meta-instance object.
278 It accepts the following keys in C<%options>:
282 =item * associated_metaclass
284 The L<Class::MOP::Class> object for which instances will be created.
288 An array reference of L<Class::MOP::Attribute> objects. These are the
289 attributes which can be stored in each instance.
295 =head2 Creating and altering instances
299 =item B<< $metainstance->create_instance >>
301 This method returns a reference blessed into the associated
304 The default is to use a hash reference. Subclasses can override this.
306 =item B<< $metainstance->clone_instance($instance) >>
308 Given an instance, this method creates a new object by making
309 I<shallow> clone of the original.
317 =item B<< $metainstance->associated_metaclass >>
319 This returns the L<Class::MOP::Class> object associated with the
320 meta-instance object.
322 =item B<< $metainstance->get_all_slots >>
324 This returns a list of slot names stored in object instances. In
325 almost all cases, slot names correspond directly attribute names.
327 =item B<< $metainstance->is_valid_slot($slot_name) >>
329 This will return true if C<$slot_name> is a valid slot name.
331 =item B<< $metainstance->get_all_attributes >>
333 This returns a list of attributes corresponding to the attributes
334 passed to the constructor.
338 =head2 Operations on Instance Structures
340 It's important to understand that the meta-instance object is a
341 different entity from the actual instances it creates. For this
342 reason, any operations on the C<$instance_structure> always require
343 that the object instance be passed to the method.
347 =item B<< $metainstance->get_slot_value($instance_structure, $slot_name) >>
349 =item B<< $metainstance->set_slot_value($instance_structure, $slot_name, $value) >>
351 =item B<< $metainstance->initialize_slot($instance_structure, $slot_name) >>
353 =item B<< $metainstance->deinitialize_slot($instance_structure, $slot_name) >>
355 =item B<< $metainstance->initialize_all_slots($instance_structure) >>
357 =item B<< $metainstance->deinitialize_all_slots($instance_structure) >>
359 =item B<< $metainstance->is_slot_initialized($instance_structure, $slot_name) >>
361 =item B<< $metainstance->weaken_slot_value($instance_structure, $slot_name) >>
363 =item B<< $metainstance->strengthen_slot_value($instance_structure, $slot_name) >>
365 =item B<< $metainstance->rebless_instance_structure($instance_structure, $new_metaclass) >>
367 The exact details of what each method does should be fairly obvious
368 from the method name.
372 =head2 Inlinable Instance Operations
376 =item B<< $metainstance->is_inlinable >>
378 This is a boolean that indicates whether or not slot access operations
379 can be inlined. By default it is true, but subclasses can override
382 =item B<< $metainstance->inline_create_instance($class_variable) >>
384 This method expects a string that, I<when inlined>, will become a
385 class name. This would literally be something like C<'$class'>, not an
388 It returns a snippet of code that creates a new object for the
389 class. This is something like C< bless {}, $class_name >.
391 =item B<< $metainstance->inline_get_is_lvalue >>
393 Returns whether or not C<inline_get_slot_value> is a valid lvalue. This can be
394 used to do extra optimizations when generating inlined methods.
396 =item B<< $metainstance->inline_slot_access($instance_variable, $slot_name) >>
398 =item B<< $metainstance->inline_get_slot_value($instance_variable, $slot_name) >>
400 =item B<< $metainstance->inline_set_slot_value($instance_variable, $slot_name, $value) >>
402 =item B<< $metainstance->inline_initialize_slot($instance_variable, $slot_name) >>
404 =item B<< $metainstance->inline_deinitialize_slot($instance_variable, $slot_name) >>
406 =item B<< $metainstance->inline_is_slot_initialized($instance_variable, $slot_name) >>
408 =item B<< $metainstance->inline_weaken_slot_value($instance_variable, $slot_name) >>
410 =item B<< $metainstance->inline_strengthen_slot_value($instance_variable, $slot_name) >>
412 These methods all expect two arguments. The first is the name of a
413 variable, than when inlined, will represent the object
414 instance. Typically this will be a literal string like C<'$_[0]'>.
416 The second argument is a slot name.
418 The method returns a snippet of code that, when inlined, performs some
419 operation on the instance.
421 =item B<< $metainstance->inline_rebless_instance_structure($instance_variable, $class_variable) >>
423 This takes the name of a variable that will, when inlined, represent the object
424 instance, and the name of a variable that will represent the class to rebless
425 into, and returns code to rebless an instance into a class.
433 =item B<< Class::MOP::Instance->meta >>
435 This will return a L<Class::MOP::Class> instance for this class.
437 It should also be noted that L<Class::MOP> will actually bootstrap
438 this module by installing a number of attribute meta-objects into its