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) = @_;
157 bless $instance, $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 "%s->{%s}", $instance, $slot_name;
178 sub inline_get_slot_value {
179 my ($self, $instance, $slot_name) = @_;
180 $self->inline_slot_access($instance, $slot_name);
183 sub inline_set_slot_value {
184 my ($self, $instance, $slot_name, $value) = @_;
185 $self->inline_slot_access($instance, $slot_name) . " = $value",
188 sub inline_initialize_slot {
189 my ($self, $instance, $slot_name) = @_;
193 sub inline_deinitialize_slot {
194 my ($self, $instance, $slot_name) = @_;
195 "delete " . $self->inline_slot_access($instance, $slot_name);
197 sub inline_is_slot_initialized {
198 my ($self, $instance, $slot_name) = @_;
199 "exists " . $self->inline_slot_access($instance, $slot_name);
202 sub inline_weaken_slot_value {
203 my ($self, $instance, $slot_name) = @_;
204 sprintf "Scalar::Util::weaken( %s )", $self->inline_slot_access($instance, $slot_name);
207 sub inline_strengthen_slot_value {
208 my ($self, $instance, $slot_name) = @_;
209 $self->inline_set_slot_value($instance, $slot_name, $self->inline_slot_access($instance, $slot_name));
220 Class::MOP::Instance - Instance Meta Object
224 The meta instance is used by attributes for low level storage.
226 Using this API generally violates attribute encapsulation and is not
227 recommended, instead look at L<Class::MOP::Attribute/get_value>,
228 L<Class::MOP::Attribute/set_value> for the recommended way to fiddle with
229 attribute values in a generic way, independent of how/whether accessors have
230 been defined. Accessors can be found using L<Class::MOP::Class/get_attribute>.
232 This may seem like over-abstraction, but by abstracting
233 this process into a sub-protocol we make it possible to
234 easily switch the details of how an object's instance is
235 stored with minimal impact. In most cases just subclassing
236 this class will be all you need to do (see the examples;
237 F<examples/ArrayBasedStorage.pod> and
238 F<examples/InsideOutClass.pod> for details).
246 Creates a new instance meta-object and gathers all the slots from
247 the list of C<@attrs> given.
251 Processes arguments for compatibility.
255 Returns the metaclass of L<Class::MOP::Instance>.
259 =head2 Creation of Instances
263 =item B<create_instance>
265 This creates the appropriate structure needed for the instance and blesses it.
267 =item B<bless_instance_structure ($instance_structure)>
269 This does just exactly what it says it does.
271 This method has been deprecated but remains for compatibility reasons. None of
272 the subclasses of L<Class::MOP::Instance> ever bothered to actually make use of
273 it, so it was deemed unnecessary fluff.
275 =item B<clone_instance ($instance_structure)>
277 Creates a shallow clone of $instance_structure.
283 NOTE: There might be more methods added to this part of the API,
284 we will add then when we need them basically.
288 =item B<associated_metaclass>
290 This returns the metaclass associated with this instance.
292 =item B<get_all_slots>
294 This will return the current list of slots based on what was
295 given to this object in C<new>.
297 =item B<is_valid_slot ($slot_name)>
299 This will return true if C<$slot_name> is a valid slot name.
301 =item B<is_dependent_on_superclasses>
303 This method returns true when the meta instance must be recreated on any
308 =item B<get_all_attributes>
310 This will return the current list of attributes (as
311 Class::MOP::Attribute objects) based on what was given to this object
316 =head2 Operations on Instance Structures
318 An important distinction of this sub-protocol is that the
319 instance meta-object is a different entity from the actual
320 instance it creates. For this reason, any actions on slots
321 require that the C<$instance_structure> is passed into them.
323 The names of these methods pretty much explain exactly
324 what they do, if that is not enough then I suggest reading
325 the source, it is very straightfoward.
329 =item B<get_slot_value ($instance_structure, $slot_name)>
331 =item B<set_slot_value ($instance_structure, $slot_name, $value)>
333 =item B<initialize_slot ($instance_structure, $slot_name)>
335 =item B<deinitialize_slot ($instance_structure, $slot_name)>
337 =item B<initialize_all_slots ($instance_structure)>
339 =item B<deinitialize_all_slots ($instance_structure)>
341 =item B<is_slot_initialized ($instance_structure, $slot_name)>
343 =item B<weaken_slot_value ($instance_structure, $slot_name)>
345 =item B<strengthen_slot_value ($instance_structure, $slot_name)>
347 =item B<rebless_instance_structure ($instance_structure, $new_metaclass)>
351 =head2 Inlineable Instance Operations
355 =item B<is_inlinable>
357 Each meta-instance should override this method to tell Class::MOP if it's
358 possible to inline the slot access. This is currently only used by
359 L<Class::MOP::Immutable> when performing optimizations.
361 =item B<inline_create_instance>
363 =item B<inline_slot_access ($instance_structure, $slot_name)>
365 =item B<inline_get_slot_value ($instance_structure, $slot_name)>
367 =item B<inline_set_slot_value ($instance_structure, $slot_name, $value)>
369 =item B<inline_initialize_slot ($instance_structure, $slot_name)>
371 =item B<inline_deinitialize_slot ($instance_structure, $slot_name)>
373 =item B<inline_is_slot_initialized ($instance_structure, $slot_name)>
375 =item B<inline_weaken_slot_value ($instance_structure, $slot_name)>
377 =item B<inline_strengthen_slot_value ($instance_structure, $slot_name)>
383 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
385 Stevan Little E<lt>stevan@iinteractive.comE<gt>
387 =head1 COPYRIGHT AND LICENSE
389 Copyright 2006-2008 by Infinity Interactive, Inc.
391 L<http://www.iinteractive.com>
393 This library is free software; you can redistribute it and/or modify
394 it under the same terms as Perl itself.