2 package Class::MOP::Instance;
7 use Scalar::Util 'weaken', 'blessed';
10 our $AUTHORITY = 'cpan:STEVAN';
12 use base 'Class::MOP::Object';
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 = bless {
40 # I am not sure that it makes
41 # sense to pass in the meta
42 # The ideal would be to just
43 # pass in the class name, but
44 # that is placing too much of
45 # an assumption on bless(),
46 # which is *probably* a safe
47 # assumption,.. but you can
49 'associated_metaclass' => $options->{associated_metaclass},
50 'attributes' => $options->{attributes},
51 'slots' => $options->{slots},
52 'slot_hash' => $options->{slot_hash},
55 # FIXME weak_ref => 1,
56 weaken($instance->{'associated_metaclass'});
61 sub _class_name { $_[0]->{_class_name} ||= $_[0]->associated_metaclass->name }
63 sub associated_metaclass { $_[0]{'associated_metaclass'} }
67 bless {}, $self->_class_name;
71 sub bless_instance_structure {
72 my ($self, $instance_structure) = @_;
73 bless $instance_structure, $self->_class_name;
77 my ($self, $instance) = @_;
78 bless { %$instance }, $self->_class_name;
81 # operations on meta instance
85 return @{$self->{'slots'}};
89 my ($self, $slot_name) = @_;
90 exists $self->{'slot_hash'}->{$slot_name};
93 # operations on created instances
96 my ($self, $instance, $slot_name) = @_;
97 $instance->{$slot_name};
101 my ($self, $instance, $slot_name, $value) = @_;
102 $instance->{$slot_name} = $value;
105 sub initialize_slot {
106 my ($self, $instance, $slot_name) = @_;
110 sub deinitialize_slot {
111 my ( $self, $instance, $slot_name ) = @_;
112 delete $instance->{$slot_name};
115 sub initialize_all_slots {
116 my ($self, $instance) = @_;
117 foreach my $slot_name ($self->get_all_slots) {
118 $self->initialize_slot($instance, $slot_name);
122 sub deinitialize_all_slots {
123 my ($self, $instance) = @_;
124 foreach my $slot_name ($self->get_all_slots) {
125 $self->deinitialize_slot($instance, $slot_name);
129 sub is_slot_initialized {
130 my ($self, $instance, $slot_name, $value) = @_;
131 exists $instance->{$slot_name};
134 sub weaken_slot_value {
135 my ($self, $instance, $slot_name) = @_;
136 weaken $instance->{$slot_name};
139 sub strengthen_slot_value {
140 my ($self, $instance, $slot_name) = @_;
141 $self->set_slot_value($instance, $slot_name, $self->get_slot_value($instance, $slot_name));
144 sub rebless_instance_structure {
145 my ($self, $instance, $metaclass) = @_;
146 bless $instance, $metaclass->name;
149 sub is_dependent_on_superclasses {
150 return; # for meta instances that require updates on inherited slot changes
153 # inlinable operation snippets
155 sub is_inlinable { 1 }
157 sub inline_create_instance {
158 my ($self, $class_variable) = @_;
159 'bless {} => ' . $class_variable;
162 sub inline_slot_access {
163 my ($self, $instance, $slot_name) = @_;
164 sprintf "%s->{%s}", $instance, $slot_name;
167 sub inline_get_slot_value {
168 my ($self, $instance, $slot_name) = @_;
169 $self->inline_slot_access($instance, $slot_name);
172 sub inline_set_slot_value {
173 my ($self, $instance, $slot_name, $value) = @_;
174 $self->inline_slot_access($instance, $slot_name) . " = $value",
177 sub inline_initialize_slot {
178 my ($self, $instance, $slot_name) = @_;
182 sub inline_deinitialize_slot {
183 my ($self, $instance, $slot_name) = @_;
184 "delete " . $self->inline_slot_access($instance, $slot_name);
186 sub inline_is_slot_initialized {
187 my ($self, $instance, $slot_name) = @_;
188 "exists " . $self->inline_slot_access($instance, $slot_name);
191 sub inline_weaken_slot_value {
192 my ($self, $instance, $slot_name) = @_;
193 sprintf "Scalar::Util::weaken( %s )", $self->inline_slot_access($instance, $slot_name);
196 sub inline_strengthen_slot_value {
197 my ($self, $instance, $slot_name) = @_;
198 $self->inline_set_slot_value($instance, $slot_name, $self->inline_slot_access($instance, $slot_name));
209 Class::MOP::Instance - Instance Meta Object
213 The meta instance is used by attributes for low level storage.
215 Using this API generally violates attribute encapsulation and is not
216 recommended, instead look at L<Class::MOP::Attribute/get_value>,
217 L<Class::MOP::Attribute/set_value> for the recommended way to fiddle with
218 attribute values in a generic way, independent of how/whether accessors have
219 been defined. Accessors can be found using L<Class::MOP::Class/get_attribute>.
221 This may seem like over-abstraction, but by abstracting
222 this process into a sub-protocol we make it possible to
223 easily switch the details of how an object's instance is
224 stored with minimal impact. In most cases just subclassing
225 this class will be all you need to do (see the examples;
226 F<examples/ArrayBasedStorage.pod> and
227 F<examples/InsideOutClass.pod> for details).
235 Creates a new instance meta-object and gathers all the slots from
236 the list of C<@attrs> given.
240 Processes arguments for compatibility.
244 Returns the metaclass of L<Class::MOP::Instance>.
248 =head2 Creation of Instances
252 =item B<create_instance>
254 This creates the appropriate structure needed for the instance and blesses it.
256 =item B<bless_instance_structure ($instance_structure)>
258 This does just exactly what it says it does.
260 This method has been deprecated but remains for compatibility reasons. None of
261 the subclasses of L<Class::MOP::Instance> ever bothered to actually make use of
262 it, so it was deemed unnecessary fluff.
264 =item B<clone_instance ($instance_structure)>
266 Creates a shallow clone of $instance_structure.
272 NOTE: There might be more methods added to this part of the API,
273 we will add then when we need them basically.
277 =item B<associated_metaclass>
279 This returns the metaclass associated with this instance.
281 =item B<get_all_slots>
283 This will return the current list of slots based on what was
284 given to this object in C<new>.
286 =item B<is_valid_slot ($slot_name)>
288 This will return true if C<$slot_name> is a valid slot name.
290 =item B<is_dependent_on_superclasses>
292 This method returns true when the meta instance must be recreated on any
299 =head2 Operations on Instance Structures
301 An important distinction of this sub-protocol is that the
302 instance meta-object is a different entity from the actual
303 instance it creates. For this reason, any actions on slots
304 require that the C<$instance_structure> is passed into them.
306 The names of these methods pretty much explain exactly
307 what they do, if that is not enough then I suggest reading
308 the source, it is very straightfoward.
312 =item B<get_slot_value ($instance_structure, $slot_name)>
314 =item B<set_slot_value ($instance_structure, $slot_name, $value)>
316 =item B<initialize_slot ($instance_structure, $slot_name)>
318 =item B<deinitialize_slot ($instance_structure, $slot_name)>
320 =item B<initialize_all_slots ($instance_structure)>
322 =item B<deinitialize_all_slots ($instance_structure)>
324 =item B<is_slot_initialized ($instance_structure, $slot_name)>
326 =item B<weaken_slot_value ($instance_structure, $slot_name)>
328 =item B<strengthen_slot_value ($instance_structure, $slot_name)>
330 =item B<rebless_instance_structure ($instance_structure, $new_metaclass)>
334 =head2 Inlineable Instance Operations
338 =item B<is_inlinable>
340 Each meta-instance should override this method to tell Class::MOP if it's
341 possible to inline the slot access. This is currently only used by
342 L<Class::MOP::Immutable> when performing optimizations.
344 =item B<inline_create_instance>
346 =item B<inline_slot_access ($instance_structure, $slot_name)>
348 =item B<inline_get_slot_value ($instance_structure, $slot_name)>
350 =item B<inline_set_slot_value ($instance_structure, $slot_name, $value)>
352 =item B<inline_initialize_slot ($instance_structure, $slot_name)>
354 =item B<inline_deinitialize_slot ($instance_structure, $slot_name)>
356 =item B<inline_is_slot_initialized ($instance_structure, $slot_name)>
358 =item B<inline_weaken_slot_value ($instance_structure, $slot_name)>
360 =item B<inline_strengthen_slot_value ($instance_structure, $slot_name)>
366 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
368 Stevan Little E<lt>stevan@iinteractive.comE<gt>
370 =head1 COPYRIGHT AND LICENSE
372 Copyright 2006-2008 by Infinity Interactive, Inc.
374 L<http://www.iinteractive.com>
376 This library is free software; you can redistribute it and/or modify
377 it under the same terms as Perl itself.