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';
16 my ($class, @args) = @_;
19 unshift @args, "associated_metaclass";
20 } elsif ( @args >= 2 && blessed($args[0]) && $args[0]->isa("Class::MOP::Class") ) {
22 my ( $meta, @attrs ) = @args;
23 @args = ( associated_metaclass => $meta, attributes => \@attrs );
28 $options{slots} ||= [ map { $_->slots } @{ $options{attributes} || [] } ];
29 $options{slot_hash} = { map { $_ => undef } @{ $options{slots} } }; # FIXME lazy_build
36 my $options = $class->BUILDARGS(@_);
38 # FIXME replace with a proper constructor
39 my $instance = $class->_new(%$options);
41 # FIXME weak_ref => 1,
42 weaken($instance->{'associated_metaclass'});
49 return Class::MOP::Class->initialize($class)->new_object(@_)
50 if $class ne __PACKAGE__;
52 my $params = @_ == 1 ? $_[0] : {@_};
55 # I am not sure that it makes
56 # sense to pass in the meta
57 # The ideal would be to just
58 # pass in the class name, but
59 # that is placing too much of
60 # an assumption on bless(),
61 # which is *probably* a safe
62 # assumption,.. but you can
64 'associated_metaclass' => $params->{associated_metaclass},
65 'attributes' => $params->{attributes},
66 'slots' => $params->{slots},
67 'slot_hash' => $params->{slot_hash},
71 sub _class_name { $_[0]->{_class_name} ||= $_[0]->associated_metaclass->name }
73 sub associated_metaclass { $_[0]{'associated_metaclass'} }
77 bless {}, $self->_class_name;
81 my ($self, $instance) = @_;
82 bless { %$instance }, $self->_class_name;
85 # operations on meta instance
89 return @{$self->{'slots'}};
92 sub get_all_attributes {
94 return @{$self->{attributes}};
98 my ($self, $slot_name) = @_;
99 exists $self->{'slot_hash'}->{$slot_name};
102 # operations on created instances
105 my ($self, $instance, $slot_name) = @_;
106 $instance->{$slot_name};
110 my ($self, $instance, $slot_name, $value) = @_;
111 $instance->{$slot_name} = $value;
114 sub initialize_slot {
115 my ($self, $instance, $slot_name) = @_;
119 sub deinitialize_slot {
120 my ( $self, $instance, $slot_name ) = @_;
121 delete $instance->{$slot_name};
124 sub initialize_all_slots {
125 my ($self, $instance) = @_;
126 foreach my $slot_name ($self->get_all_slots) {
127 $self->initialize_slot($instance, $slot_name);
131 sub deinitialize_all_slots {
132 my ($self, $instance) = @_;
133 foreach my $slot_name ($self->get_all_slots) {
134 $self->deinitialize_slot($instance, $slot_name);
138 sub is_slot_initialized {
139 my ($self, $instance, $slot_name, $value) = @_;
140 exists $instance->{$slot_name};
143 sub weaken_slot_value {
144 my ($self, $instance, $slot_name) = @_;
145 weaken $instance->{$slot_name};
148 sub strengthen_slot_value {
149 my ($self, $instance, $slot_name) = @_;
150 $self->set_slot_value($instance, $slot_name, $self->get_slot_value($instance, $slot_name));
153 sub rebless_instance_structure {
154 my ($self, $instance, $metaclass) = @_;
156 # we use $_[1] here because of t/306_rebless_overload.t regressions on 5.8.8
157 bless $_[1], $metaclass->name;
160 sub is_dependent_on_superclasses {
161 return; # for meta instances that require updates on inherited slot changes
164 # inlinable operation snippets
166 sub is_inlinable { 1 }
168 sub inline_create_instance {
169 my ($self, $class_variable) = @_;
170 'bless {} => ' . $class_variable;
173 sub inline_slot_access {
174 my ($self, $instance, $slot_name) = @_;
175 sprintf q[%s->{"%s"}], $instance, quotemeta($slot_name);
178 sub inline_get_is_lvalue { 1 }
180 sub inline_get_slot_value {
181 my ($self, $instance, $slot_name) = @_;
182 $self->inline_slot_access($instance, $slot_name);
185 sub inline_set_slot_value {
186 my ($self, $instance, $slot_name, $value) = @_;
187 $self->inline_slot_access($instance, $slot_name) . " = $value",
190 sub inline_initialize_slot {
191 my ($self, $instance, $slot_name) = @_;
195 sub inline_deinitialize_slot {
196 my ($self, $instance, $slot_name) = @_;
197 "delete " . $self->inline_slot_access($instance, $slot_name);
199 sub inline_is_slot_initialized {
200 my ($self, $instance, $slot_name) = @_;
201 "exists " . $self->inline_slot_access($instance, $slot_name);
204 sub inline_weaken_slot_value {
205 my ($self, $instance, $slot_name) = @_;
206 sprintf "Scalar::Util::weaken( %s )", $self->inline_slot_access($instance, $slot_name);
209 sub inline_strengthen_slot_value {
210 my ($self, $instance, $slot_name) = @_;
211 $self->inline_set_slot_value($instance, $slot_name, $self->inline_slot_access($instance, $slot_name));
214 sub inline_rebless_instance_structure {
215 my ($self, $instance, $class_variable) = @_;
216 "bless $instance => $class_variable";
227 Class::MOP::Instance - Instance Meta Object
231 The Instance Protocol controls the creation of object instances, and
232 the storage of attribute values in those instances.
234 Using this API directly in your own code violates encapsulation, and
235 we recommend that you use the appropriate APIs in L<Class::MOP::Class>
236 and L<Class::MOP::Attribute> instead. Those APIs in turn call the
237 methods in this class as appropriate.
239 This class also participates in generating inlined code by providing
240 snippets of code to access an object instance.
244 =head2 Object construction
248 =item B<< Class::MOP::Instance->new(%options) >>
250 This method creates a new meta-instance object.
252 It accepts the following keys in C<%options>:
256 =item * associated_metaclass
258 The L<Class::MOP::Class> object for which instances will be created.
262 An array reference of L<Class::MOP::Attribute> objects. These are the
263 attributes which can be stored in each instance.
269 =head2 Creating and altering instances
273 =item B<< $metainstance->create_instance >>
275 This method returns a reference blessed into the associated
278 The default is to use a hash reference. Subclasses can override this.
280 =item B<< $metainstance->clone_instance($instance) >>
282 Given an instance, this method creates a new object by making
283 I<shallow> clone of the original.
291 =item B<< $metainstance->associated_metaclass >>
293 This returns the L<Class::MOP::Class> object associated with the
294 meta-instance object.
296 =item B<< $metainstance->get_all_slots >>
298 This returns a list of slot names stored in object instances. In
299 almost all cases, slot names correspond directly attribute names.
301 =item B<< $metainstance->is_valid_slot($slot_name) >>
303 This will return true if C<$slot_name> is a valid slot name.
305 =item B<< $metainstance->get_all_attributes >>
307 This returns a list of attributes corresponding to the attributes
308 passed to the constructor.
312 =head2 Operations on Instance Structures
314 It's important to understand that the meta-instance object is a
315 different entity from the actual instances it creates. For this
316 reason, any operations on the C<$instance_structure> always require
317 that the object instance be passed to the method.
321 =item B<< $metainstance->get_slot_value($instance_structure, $slot_name) >>
323 =item B<< $metainstance->set_slot_value($instance_structure, $slot_name, $value) >>
325 =item B<< $metainstance->initialize_slot($instance_structure, $slot_name) >>
327 =item B<< $metainstance->deinitialize_slot($instance_structure, $slot_name) >>
329 =item B<< $metainstance->initialize_all_slots($instance_structure) >>
331 =item B<< $metainstance->deinitialize_all_slots($instance_structure) >>
333 =item B<< $metainstance->is_slot_initialized($instance_structure, $slot_name) >>
335 =item B<< $metainstance->weaken_slot_value($instance_structure, $slot_name) >>
337 =item B<< $metainstance->strengthen_slot_value($instance_structure, $slot_name) >>
339 =item B<< $metainstance->rebless_instance_structure($instance_structure, $new_metaclass) >>
341 The exact details of what each method does should be fairly obvious
342 from the method name.
346 =head2 Inlinable Instance Operations
350 =item B<< $metainstance->is_inlinable >>
352 This is a boolean that indicates whether or not slot access operations
353 can be inlined. By default it is true, but subclasses can override
356 =item B<< $metainstance->inline_create_instance($class_variable) >>
358 This method expects a string that, I<when inlined>, will become a
359 class name. This would literally be something like C<'$class'>, not an
362 It returns a snippet of code that creates a new object for the
363 class. This is something like C< bless {}, $class_name >.
365 =item B<< $metainstance->inline_get_is_lvalue >>
367 Returns whether or not C<inline_get_slot_value> is a valid lvalue. This can be
368 used to do extra optimizations when generating inlined methods.
370 =item B<< $metainstance->inline_slot_access($instance_variable, $slot_name) >>
372 =item B<< $metainstance->inline_get_slot_value($instance_variable, $slot_name) >>
374 =item B<< $metainstance->inline_set_slot_value($instance_variable, $slot_name, $value) >>
376 =item B<< $metainstance->inline_initialize_slot($instance_variable, $slot_name) >>
378 =item B<< $metainstance->inline_deinitialize_slot($instance_variable, $slot_name) >>
380 =item B<< $metainstance->inline_is_slot_initialized($instance_variable, $slot_name) >>
382 =item B<< $metainstance->inline_weaken_slot_value($instance_variable, $slot_name) >>
384 =item B<< $metainstance->inline_strengthen_slot_value($instance_variable, $slot_name) >>
386 These methods all expect two arguments. The first is the name of a
387 variable, than when inlined, will represent the object
388 instance. Typically this will be a literal string like C<'$_[0]'>.
390 The second argument is a slot name.
392 The method returns a snippet of code that, when inlined, performs some
393 operation on the instance.
395 =item B<< $metainstance->inline_rebless_instance_structure($instance_variable, $class_variable) >>
397 This takes the name of a variable that will, when inlined, represent the object
398 instance, and the name of a variable that will represent the class to rebless
399 into, and returns code to rebless an instance into a class.
407 =item B<< Class::MOP::Instance->meta >>
409 This will return a L<Class::MOP::Class> instance for this class.
411 It should also be noted that L<Class::MOP> will actually bootstrap
412 this module by installing a number of attribute meta-objects into its
419 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
421 Stevan Little E<lt>stevan@iinteractive.comE<gt>
423 =head1 COPYRIGHT AND LICENSE
425 Copyright 2006-2010 by Infinity Interactive, Inc.
427 L<http://www.iinteractive.com>
429 This library is free software; you can redistribute it and/or modify
430 it under the same terms as Perl itself.