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 'slots' => $options->{slots},
51 'slot_hash' => $options->{slot_hash},
54 # FIXME weak_ref => 1,
55 weaken($instance->{'associated_metaclass'});
60 sub associated_metaclass { (shift)->{'associated_metaclass'} }
64 $self->bless_instance_structure({});
67 sub bless_instance_structure {
68 my ($self, $instance_structure) = @_;
69 bless $instance_structure, $self->associated_metaclass->name;
73 my ($self, $instance) = @_;
74 $self->bless_instance_structure({ %$instance });
77 # operations on meta instance
81 return @{$self->{'slots'}};
85 my ($self, $slot_name) = @_;
86 exists $self->{'slot_hash'}->{$slot_name};
89 # operations on created instances
92 my ($self, $instance, $slot_name) = @_;
93 $instance->{$slot_name};
97 my ($self, $instance, $slot_name, $value) = @_;
98 $instance->{$slot_name} = $value;
101 sub initialize_slot {
102 my ($self, $instance, $slot_name) = @_;
106 sub deinitialize_slot {
107 my ( $self, $instance, $slot_name ) = @_;
108 delete $instance->{$slot_name};
111 sub initialize_all_slots {
112 my ($self, $instance) = @_;
113 foreach my $slot_name ($self->get_all_slots) {
114 $self->initialize_slot($instance, $slot_name);
118 sub deinitialize_all_slots {
119 my ($self, $instance) = @_;
120 foreach my $slot_name ($self->get_all_slots) {
121 $self->deinitialize_slot($instance, $slot_name);
125 sub is_slot_initialized {
126 my ($self, $instance, $slot_name, $value) = @_;
127 exists $instance->{$slot_name};
130 sub weaken_slot_value {
131 my ($self, $instance, $slot_name) = @_;
132 weaken $instance->{$slot_name};
135 sub strengthen_slot_value {
136 my ($self, $instance, $slot_name) = @_;
137 $self->set_slot_value($instance, $slot_name, $self->get_slot_value($instance, $slot_name));
140 sub rebless_instance_structure {
141 my ($self, $instance, $metaclass) = @_;
142 bless $instance, $metaclass->name;
145 # inlinable operation snippets
147 sub is_inlinable { 1 }
149 sub inline_create_instance {
150 my ($self, $class_variable) = @_;
151 'bless {} => ' . $class_variable;
154 sub inline_slot_access {
155 my ($self, $instance, $slot_name) = @_;
156 sprintf "%s->{%s}", $instance, $slot_name;
159 sub inline_get_slot_value {
160 my ($self, $instance, $slot_name) = @_;
161 $self->inline_slot_access($instance, $slot_name);
164 sub inline_set_slot_value {
165 my ($self, $instance, $slot_name, $value) = @_;
166 $self->inline_slot_access($instance, $slot_name) . " = $value",
169 sub inline_initialize_slot {
170 my ($self, $instance, $slot_name) = @_;
174 sub inline_deinitialize_slot {
175 my ($self, $instance, $slot_name) = @_;
176 "delete " . $self->inline_slot_access($instance, $slot_name);
178 sub inline_is_slot_initialized {
179 my ($self, $instance, $slot_name) = @_;
180 "exists " . $self->inline_slot_access($instance, $slot_name);
183 sub inline_weaken_slot_value {
184 my ($self, $instance, $slot_name) = @_;
185 sprintf "Scalar::Util::weaken( %s )", $self->inline_slot_access($instance, $slot_name);
188 sub inline_strengthen_slot_value {
189 my ($self, $instance, $slot_name) = @_;
190 $self->inline_set_slot_value($instance, $slot_name, $self->inline_slot_access($instance, $slot_name));
201 Class::MOP::Instance - Instance Meta Object
205 The meta instance is used by attributes for low level storage.
207 Using this API generally violates attribute encapsulation and is not
208 recommended, instead look at L<Class::MOP::Attribute/get_value>,
209 L<Class::MOP::Attribute/set_value> for the recommended way to fiddle with
210 attribute values in a generic way, independent of how/whether accessors have
211 been defined. Accessors can be found using L<Class::MOP::Class/get_attribute>.
213 This may seem like over-abstraction, but by abstracting
214 this process into a sub-protocol we make it possible to
215 easily switch the details of how an object's instance is
216 stored with minimal impact. In most cases just subclassing
217 this class will be all you need to do (see the examples;
218 F<examples/ArrayBasedStorage.pod> and
219 F<examples/InsideOutClass.pod> for details).
227 Creates a new instance meta-object and gathers all the slots from
228 the list of C<@attrs> given.
232 Processes arguments for compatibility.
236 Returns the metaclass of L<Class::MOP::Instance>.
240 =head2 Creation of Instances
244 =item B<create_instance>
246 This creates the appropriate structure needed for the instance and
247 then calls C<bless_instance_structure> to bless it into the class.
249 =item B<bless_instance_structure ($instance_structure)>
251 This does just exactly what it says it does.
253 =item B<clone_instance ($instance_structure)>
255 This too does just exactly what it says it does.
261 NOTE: There might be more methods added to this part of the API,
262 we will add then when we need them basically.
266 =item B<associated_metaclass>
268 This returns the metaclass associated with this instance.
270 =item B<get_all_slots>
272 This will return the current list of slots based on what was
273 given to this object in C<new>.
275 =item B<is_valid_slot ($slot_name)>
277 This will return true if C<$slot_name> is a valid slot name.
281 =head2 Operations on Instance Structures
283 An important distinction of this sub-protocol is that the
284 instance meta-object is a different entity from the actual
285 instance it creates. For this reason, any actions on slots
286 require that the C<$instance_structure> is passed into them.
288 The names of these methods pretty much explain exactly
289 what they do, if that is not enough then I suggest reading
290 the source, it is very straightfoward.
294 =item B<get_slot_value ($instance_structure, $slot_name)>
296 =item B<set_slot_value ($instance_structure, $slot_name, $value)>
298 =item B<initialize_slot ($instance_structure, $slot_name)>
300 =item B<deinitialize_slot ($instance_structure, $slot_name)>
302 =item B<initialize_all_slots ($instance_structure)>
304 =item B<deinitialize_all_slots ($instance_structure)>
306 =item B<is_slot_initialized ($instance_structure, $slot_name)>
308 =item B<weaken_slot_value ($instance_structure, $slot_name)>
310 =item B<strengthen_slot_value ($instance_structure, $slot_name)>
312 =item B<rebless_instance_structure ($instance_structure, $new_metaclass)>
316 =head2 Inlineable Instance Operations
320 =item B<is_inlinable>
322 Each meta-instance should override this method to tell Class::MOP if it's
323 possible to inline the slot access. This is currently only used by
324 L<Class::MOP::Immutable> when performing optimizations.
326 =item B<inline_create_instance>
328 =item B<inline_slot_access ($instance_structure, $slot_name)>
330 =item B<inline_get_slot_value ($instance_structure, $slot_name)>
332 =item B<inline_set_slot_value ($instance_structure, $slot_name, $value)>
334 =item B<inline_initialize_slot ($instance_structure, $slot_name)>
336 =item B<inline_deinitialize_slot ($instance_structure, $slot_name)>
338 =item B<inline_is_slot_initialized ($instance_structure, $slot_name)>
340 =item B<inline_weaken_slot_value ($instance_structure, $slot_name)>
342 =item B<inline_strengthen_slot_value ($instance_structure, $slot_name)>
348 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
350 Stevan Little E<lt>stevan@iinteractive.comE<gt>
352 =head1 COPYRIGHT AND LICENSE
354 Copyright 2006-2008 by Infinity Interactive, Inc.
356 L<http://www.iinteractive.com>
358 This library is free software; you can redistribute it and/or modify
359 it under the same terms as Perl itself.