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 = $class->_new(%$options);
40 # FIXME weak_ref => 1,
41 weaken($instance->{'associated_metaclass'});
47 my ( $class, %options ) = @_;
50 # I am not sure that it makes
51 # sense to pass in the meta
52 # The ideal would be to just
53 # pass in the class name, but
54 # that is placing too much of
55 # an assumption on bless(),
56 # which is *probably* a safe
57 # assumption,.. but you can
59 'associated_metaclass' => $options{associated_metaclass},
60 'attributes' => $options{attributes},
61 'slots' => $options{slots},
62 'slot_hash' => $options{slot_hash},
66 sub _class_name { $_[0]->{_class_name} ||= $_[0]->associated_metaclass->name }
68 sub associated_metaclass { $_[0]{'associated_metaclass'} }
72 bless {}, $self->_class_name;
76 sub bless_instance_structure {
77 my ($self, $instance_structure) = @_;
78 bless $instance_structure, $self->_class_name;
82 my ($self, $instance) = @_;
83 bless { %$instance }, $self->_class_name;
86 # operations on meta instance
90 return @{$self->{'slots'}};
94 my ($self, $slot_name) = @_;
95 exists $self->{'slot_hash'}->{$slot_name};
98 # operations on created instances
101 my ($self, $instance, $slot_name) = @_;
102 $instance->{$slot_name};
106 my ($self, $instance, $slot_name, $value) = @_;
107 $instance->{$slot_name} = $value;
110 sub initialize_slot {
111 my ($self, $instance, $slot_name) = @_;
115 sub deinitialize_slot {
116 my ( $self, $instance, $slot_name ) = @_;
117 delete $instance->{$slot_name};
120 sub initialize_all_slots {
121 my ($self, $instance) = @_;
122 foreach my $slot_name ($self->get_all_slots) {
123 $self->initialize_slot($instance, $slot_name);
127 sub deinitialize_all_slots {
128 my ($self, $instance) = @_;
129 foreach my $slot_name ($self->get_all_slots) {
130 $self->deinitialize_slot($instance, $slot_name);
134 sub is_slot_initialized {
135 my ($self, $instance, $slot_name, $value) = @_;
136 exists $instance->{$slot_name};
139 sub weaken_slot_value {
140 my ($self, $instance, $slot_name) = @_;
141 weaken $instance->{$slot_name};
144 sub strengthen_slot_value {
145 my ($self, $instance, $slot_name) = @_;
146 $self->set_slot_value($instance, $slot_name, $self->get_slot_value($instance, $slot_name));
149 sub rebless_instance_structure {
150 my ($self, $instance, $metaclass) = @_;
151 bless $instance, $metaclass->name;
154 sub is_dependent_on_superclasses {
155 return; # for meta instances that require updates on inherited slot changes
158 # inlinable operation snippets
160 sub is_inlinable { 1 }
162 sub inline_create_instance {
163 my ($self, $class_variable) = @_;
164 'bless {} => ' . $class_variable;
167 sub inline_slot_access {
168 my ($self, $instance, $slot_name) = @_;
169 sprintf "%s->{%s}", $instance, $slot_name;
172 sub inline_get_slot_value {
173 my ($self, $instance, $slot_name) = @_;
174 $self->inline_slot_access($instance, $slot_name);
177 sub inline_set_slot_value {
178 my ($self, $instance, $slot_name, $value) = @_;
179 $self->inline_slot_access($instance, $slot_name) . " = $value",
182 sub inline_initialize_slot {
183 my ($self, $instance, $slot_name) = @_;
187 sub inline_deinitialize_slot {
188 my ($self, $instance, $slot_name) = @_;
189 "delete " . $self->inline_slot_access($instance, $slot_name);
191 sub inline_is_slot_initialized {
192 my ($self, $instance, $slot_name) = @_;
193 "exists " . $self->inline_slot_access($instance, $slot_name);
196 sub inline_weaken_slot_value {
197 my ($self, $instance, $slot_name) = @_;
198 sprintf "Scalar::Util::weaken( %s )", $self->inline_slot_access($instance, $slot_name);
201 sub inline_strengthen_slot_value {
202 my ($self, $instance, $slot_name) = @_;
203 $self->inline_set_slot_value($instance, $slot_name, $self->inline_slot_access($instance, $slot_name));
214 Class::MOP::Instance - Instance Meta Object
218 The meta instance is used by attributes for low level storage.
220 Using this API generally violates attribute encapsulation and is not
221 recommended, instead look at L<Class::MOP::Attribute/get_value>,
222 L<Class::MOP::Attribute/set_value> for the recommended way to fiddle with
223 attribute values in a generic way, independent of how/whether accessors have
224 been defined. Accessors can be found using L<Class::MOP::Class/get_attribute>.
226 This may seem like over-abstraction, but by abstracting
227 this process into a sub-protocol we make it possible to
228 easily switch the details of how an object's instance is
229 stored with minimal impact. In most cases just subclassing
230 this class will be all you need to do (see the examples;
231 F<examples/ArrayBasedStorage.pod> and
232 F<examples/InsideOutClass.pod> for details).
240 Creates a new instance meta-object and gathers all the slots from
241 the list of C<@attrs> given.
245 Processes arguments for compatibility.
249 Returns the metaclass of L<Class::MOP::Instance>.
253 =head2 Creation of Instances
257 =item B<create_instance>
259 This creates the appropriate structure needed for the instance and blesses it.
261 =item B<bless_instance_structure ($instance_structure)>
263 This does just exactly what it says it does.
265 This method has been deprecated but remains for compatibility reasons. None of
266 the subclasses of L<Class::MOP::Instance> ever bothered to actually make use of
267 it, so it was deemed unnecessary fluff.
269 =item B<clone_instance ($instance_structure)>
271 Creates a shallow clone of $instance_structure.
277 NOTE: There might be more methods added to this part of the API,
278 we will add then when we need them basically.
282 =item B<associated_metaclass>
284 This returns the metaclass associated with this instance.
286 =item B<get_all_slots>
288 This will return the current list of slots based on what was
289 given to this object in C<new>.
291 =item B<is_valid_slot ($slot_name)>
293 This will return true if C<$slot_name> is a valid slot name.
295 =item B<is_dependent_on_superclasses>
297 This method returns true when the meta instance must be recreated on any
304 =head2 Operations on Instance Structures
306 An important distinction of this sub-protocol is that the
307 instance meta-object is a different entity from the actual
308 instance it creates. For this reason, any actions on slots
309 require that the C<$instance_structure> is passed into them.
311 The names of these methods pretty much explain exactly
312 what they do, if that is not enough then I suggest reading
313 the source, it is very straightfoward.
317 =item B<get_slot_value ($instance_structure, $slot_name)>
319 =item B<set_slot_value ($instance_structure, $slot_name, $value)>
321 =item B<initialize_slot ($instance_structure, $slot_name)>
323 =item B<deinitialize_slot ($instance_structure, $slot_name)>
325 =item B<initialize_all_slots ($instance_structure)>
327 =item B<deinitialize_all_slots ($instance_structure)>
329 =item B<is_slot_initialized ($instance_structure, $slot_name)>
331 =item B<weaken_slot_value ($instance_structure, $slot_name)>
333 =item B<strengthen_slot_value ($instance_structure, $slot_name)>
335 =item B<rebless_instance_structure ($instance_structure, $new_metaclass)>
339 =head2 Inlineable Instance Operations
343 =item B<is_inlinable>
345 Each meta-instance should override this method to tell Class::MOP if it's
346 possible to inline the slot access. This is currently only used by
347 L<Class::MOP::Immutable> when performing optimizations.
349 =item B<inline_create_instance>
351 =item B<inline_slot_access ($instance_structure, $slot_name)>
353 =item B<inline_get_slot_value ($instance_structure, $slot_name)>
355 =item B<inline_set_slot_value ($instance_structure, $slot_name, $value)>
357 =item B<inline_initialize_slot ($instance_structure, $slot_name)>
359 =item B<inline_deinitialize_slot ($instance_structure, $slot_name)>
361 =item B<inline_is_slot_initialized ($instance_structure, $slot_name)>
363 =item B<inline_weaken_slot_value ($instance_structure, $slot_name)>
365 =item B<inline_strengthen_slot_value ($instance_structure, $slot_name)>
371 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
373 Stevan Little E<lt>stevan@iinteractive.comE<gt>
375 =head1 COPYRIGHT AND LICENSE
377 Copyright 2006-2008 by Infinity Interactive, Inc.
379 L<http://www.iinteractive.com>
381 This library is free software; you can redistribute it and/or modify
382 it under the same terms as Perl itself.