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'});
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 meta instance is used by attributes for low level storage.
228 Using this API generally violates attribute encapsulation and is not
229 recommended, instead look at L<Class::MOP::Attribute/get_value>,
230 L<Class::MOP::Attribute/set_value> for the recommended way to fiddle with
231 attribute values in a generic way, independent of how/whether accessors have
232 been defined. Accessors can be found using L<Class::MOP::Class/get_attribute>.
234 This may seem like over-abstraction, but by abstracting
235 this process into a sub-protocol we make it possible to
236 easily switch the details of how an object's instance is
237 stored with minimal impact. In most cases just subclassing
238 this class will be all you need to do (see the examples;
239 F<examples/ArrayBasedStorage.pod> and
240 F<examples/InsideOutClass.pod> for details).
248 Creates a new instance meta-object and gathers all the slots from
249 the list of C<@attrs> given.
253 Processes arguments for compatibility.
257 Returns the metaclass of L<Class::MOP::Instance>.
261 =head2 Creation of Instances
265 =item B<create_instance>
267 This creates the appropriate structure needed for the instance and blesses it.
269 =item B<bless_instance_structure ($instance_structure)>
271 This does just exactly what it says it does.
273 This method has been deprecated but remains for compatibility reasons. None of
274 the subclasses of L<Class::MOP::Instance> ever bothered to actually make use of
275 it, so it was deemed unnecessary fluff.
277 =item B<clone_instance ($instance_structure)>
279 Creates a shallow clone of $instance_structure.
285 NOTE: There might be more methods added to this part of the API,
286 we will add then when we need them basically.
290 =item B<associated_metaclass>
292 This returns the metaclass associated with this instance.
294 =item B<get_all_slots>
296 This will return the current list of slots based on what was
297 given to this object in C<new>.
299 =item B<is_valid_slot ($slot_name)>
301 This will return true if C<$slot_name> is a valid slot name.
303 =item B<is_dependent_on_superclasses>
305 This method returns true when the meta instance must be recreated on any
310 =item B<get_all_attributes>
312 This will return the current list of attributes (as
313 Class::MOP::Attribute objects) based on what was given to this object
318 =head2 Operations on Instance Structures
320 An important distinction of this sub-protocol is that the
321 instance meta-object is a different entity from the actual
322 instance it creates. For this reason, any actions on slots
323 require that the C<$instance_structure> is passed into them.
325 The names of these methods pretty much explain exactly
326 what they do, if that is not enough then I suggest reading
327 the source, it is very straightfoward.
331 =item B<get_slot_value ($instance_structure, $slot_name)>
333 =item B<set_slot_value ($instance_structure, $slot_name, $value)>
335 =item B<initialize_slot ($instance_structure, $slot_name)>
337 =item B<deinitialize_slot ($instance_structure, $slot_name)>
339 =item B<initialize_all_slots ($instance_structure)>
341 =item B<deinitialize_all_slots ($instance_structure)>
343 =item B<is_slot_initialized ($instance_structure, $slot_name)>
345 =item B<weaken_slot_value ($instance_structure, $slot_name)>
347 =item B<strengthen_slot_value ($instance_structure, $slot_name)>
349 =item B<rebless_instance_structure ($instance_structure, $new_metaclass)>
353 =head2 Inlineable Instance Operations
357 =item B<is_inlinable>
359 Each meta-instance should override this method to tell Class::MOP if it's
360 possible to inline the slot access. This is currently only used by
361 L<Class::MOP::Immutable> when performing optimizations.
363 =item B<inline_create_instance>
365 =item B<inline_slot_access ($instance_structure, $slot_name)>
367 =item B<inline_get_slot_value ($instance_structure, $slot_name)>
369 =item B<inline_set_slot_value ($instance_structure, $slot_name, $value)>
371 =item B<inline_initialize_slot ($instance_structure, $slot_name)>
373 =item B<inline_deinitialize_slot ($instance_structure, $slot_name)>
375 =item B<inline_is_slot_initialized ($instance_structure, $slot_name)>
377 =item B<inline_weaken_slot_value ($instance_structure, $slot_name)>
379 =item B<inline_strengthen_slot_value ($instance_structure, $slot_name)>
385 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
387 Stevan Little E<lt>stevan@iinteractive.comE<gt>
389 =head1 COPYRIGHT AND LICENSE
391 Copyright 2006-2009 by Infinity Interactive, Inc.
393 L<http://www.iinteractive.com>
395 This library is free software; you can redistribute it and/or modify
396 it under the same terms as Perl itself.