2 package Class::MOP::Instance;
7 use Scalar::Util 'weaken', 'blessed';
9 our $VERSION = '0.78_02';
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'});
48 my ( $class, %options ) = @_;
51 # I am not sure that it makes
52 # sense to pass in the meta
53 # The ideal would be to just
54 # pass in the class name, but
55 # that is placing too much of
56 # an assumption on bless(),
57 # which is *probably* a safe
58 # assumption,.. but you can
60 'associated_metaclass' => $options{associated_metaclass},
61 'attributes' => $options{attributes},
62 'slots' => $options{slots},
63 'slot_hash' => $options{slot_hash},
67 sub _class_name { $_[0]->{_class_name} ||= $_[0]->associated_metaclass->name }
69 sub associated_metaclass { $_[0]{'associated_metaclass'} }
73 bless {}, $self->_class_name;
77 sub bless_instance_structure {
78 my ($self, $instance_structure) = @_;
79 bless $instance_structure, $self->_class_name;
83 my ($self, $instance) = @_;
84 bless { %$instance }, $self->_class_name;
87 # operations on meta instance
91 return @{$self->{'slots'}};
94 sub get_all_attributes {
96 return @{$self->{attributes}};
100 my ($self, $slot_name) = @_;
101 exists $self->{'slot_hash'}->{$slot_name};
104 # operations on created instances
107 my ($self, $instance, $slot_name) = @_;
108 $instance->{$slot_name};
112 my ($self, $instance, $slot_name, $value) = @_;
113 $instance->{$slot_name} = $value;
116 sub initialize_slot {
117 my ($self, $instance, $slot_name) = @_;
121 sub deinitialize_slot {
122 my ( $self, $instance, $slot_name ) = @_;
123 delete $instance->{$slot_name};
126 sub initialize_all_slots {
127 my ($self, $instance) = @_;
128 foreach my $slot_name ($self->get_all_slots) {
129 $self->initialize_slot($instance, $slot_name);
133 sub deinitialize_all_slots {
134 my ($self, $instance) = @_;
135 foreach my $slot_name ($self->get_all_slots) {
136 $self->deinitialize_slot($instance, $slot_name);
140 sub is_slot_initialized {
141 my ($self, $instance, $slot_name, $value) = @_;
142 exists $instance->{$slot_name};
145 sub weaken_slot_value {
146 my ($self, $instance, $slot_name) = @_;
147 weaken $instance->{$slot_name};
150 sub strengthen_slot_value {
151 my ($self, $instance, $slot_name) = @_;
152 $self->set_slot_value($instance, $slot_name, $self->get_slot_value($instance, $slot_name));
155 sub rebless_instance_structure {
156 my ($self, $instance, $metaclass) = @_;
158 # we use $_[1] here because of t/306_rebless_overload.t regressions on 5.8.8
159 bless $_[1], $metaclass->name;
162 sub is_dependent_on_superclasses {
163 return; # for meta instances that require updates on inherited slot changes
166 # inlinable operation snippets
168 sub is_inlinable { 1 }
170 sub inline_create_instance {
171 my ($self, $class_variable) = @_;
172 'bless {} => ' . $class_variable;
175 sub inline_slot_access {
176 my ($self, $instance, $slot_name) = @_;
177 sprintf q[%s->{"%s"}], $instance, quotemeta($slot_name);
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));
222 Class::MOP::Instance - Instance Meta Object
226 The Instance Protocol controls the creation of object instances, and
227 the storage of attribute values in those instances.
229 Using this API directly in your own code violates encapsulation, and
230 we recommend that you use the appropriate APIs in L<Class::MOP::Class>
231 and L<Class::MOP::Attribute> instead. Those APIs in turn call the
232 methods in this class as appropriate.
234 This class also participates in generating inlined code by providing
235 snippets of code to access an object instance.
239 =head2 Object construction
243 =item B<< Class::MOP::Instance->new(%options) >>
245 This method creates a new meta-instance object.
247 It accepts the following keys in C<%options>:
251 =item * associated_metaclass
253 The L<Class::MOP::Class> object for which instances will be created.
257 An array reference of L<Class::MOP::Attribute> objects. These are the
258 attributes which can be stored in each instance.
264 =head2 Creating and altering instances
268 =item B<< $metainstance->create_instance >>
270 This method returns a reference blessed into the associated
273 The default is to use a hash reference. Subclasses can override this.
275 =item B<< $metainstance->clone_instance($instance) >>
277 Given an instance, this method creates a new object by making
278 I<shallow> clone of the original.
286 =item B<< $metainstance->associated_metaclass >>
288 This returns the L<Class::MOP::Class> object associated with the
289 meta-instance object.
291 =item B<< $metainstance->get_all_slots >>
293 This returns a list of slot names stored in object instances. In
294 almost all cases, slot names correspond directly attribute names.
296 =item B<< $metainstance->is_valid_slot($slot_name) >>
298 This will return true if C<$slot_name> is a valid slot name.
300 =item B<< $metainstance->get_all_attributes >>
302 This returns a list of attributes corresponding to the attributes
303 passed to the constructor.
307 =head2 Operations on Instance Structures
309 It's important to understand that the meta-instance object is a
310 different entity from the actual instances it creates. For this
311 reason, any operations on the C<$instance_structure> always require
312 that the object instance be passed to the method.
316 =item B<< $metainstance->get_slot_value($instance_structure, $slot_name) >>
318 =item B<< $metainstance->set_slot_value($instance_structure, $slot_name, $value) >>
320 =item B<< $metainstance->initialize_slot($instance_structure, $slot_name) >>
322 =item B<< $metainstance->deinitialize_slot($instance_structure, $slot_name) >>
324 =item B<< $metainstance->initialize_all_slots($instance_structure) >>
326 =item B<< $metainstance->deinitialize_all_slots($instance_structure) >>
328 =item B<< $metainstance->is_slot_initialized($instance_structure, $slot_name) >>
330 =item B<< $metainstance->weaken_slot_value($instance_structure, $slot_name) >>
332 =item B<< $metainstance->strengthen_slot_value($instance_structure, $slot_name) >>
334 =item B<< $metainstance->rebless_instance_structure($instance_structure, $new_metaclass) >>
336 The exact details of what each method does should be fairly obvious
337 from the method name.
341 =head2 Inlinable Instance Operations
345 =item B<< $metainstance->is_inlinable >>
347 This is a boolean that indicates whether or not slot access operations
348 can be inlined. By default it is true, but subclasses can override
351 =item B<< $metainstance->inline_create_instance($class_variable) >>
353 This method expects a string that, I<when inlined>, will become a
354 class name. This would literally be something like C<'$class'>, not an
357 It returns a snippet of code that creates a new object for the
358 class. This is something like C< bless {}, $class_name >.
360 =item B<< $metainstance->inline_slot_access($instance_variable, $slot_name) >>
362 =item B<< $metainstance->inline_get_slot_value($instance_variable, $slot_name) >>
364 =item B<< $metainstance->inline_set_slot_value($instance_variable, $slot_name, $value) >>
366 =item B<< $metainstance->inline_initialize_slot($instance_variable, $slot_name) >>
368 =item B<< $metainstance->inline_deinitialize_slot($instance_variable, $slot_name) >>
370 =item B<< $metainstance->inline_is_slot_initialized($instance_variable, $slot_name) >>
372 =item B<< $metainstance->inline_weaken_slot_value($instance_variable, $slot_name) >>
374 =item B<< $metainstance->inline_strengthen_slot_value($instance_variable, $slot_name) >>
376 These methods all expect two arguments. The first is the name of a
377 variable, than when inlined, will represent the object
378 instance. Typically this will be a literal string like C<'$_[0]'>.
380 The second argument is a slot name.
382 The method returns a snippet of code that, when inlined, performs some
383 operation on the instance.
391 =item B<< Class::MOP::Instance->meta >>
393 This will return a L<Class::MOP::Class> instance for this class.
395 It should also be noted that L<Class::MOP> will actually bootstrap
396 this module by installing a number of attribute meta-objects into its
403 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
405 Stevan Little E<lt>stevan@iinteractive.comE<gt>
407 =head1 COPYRIGHT AND LICENSE
409 Copyright 2006-2009 by Infinity Interactive, Inc.
411 L<http://www.iinteractive.com>
413 This library is free software; you can redistribute it and/or modify
414 it under the same terms as Perl itself.