2 package Class::MOP::Instance;
7 use Scalar::Util 'weaken', 'blessed';
10 our $AUTHORITY = 'cpan:STEVAN';
13 require Class::MOP::Class;
14 Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
18 my ($class, $meta, @attrs) = @_;
19 my @slots = map { $_->slots } @attrs;
20 my $instance = bless {
22 # I am not sure that it makes
23 # sense to pass in the meta
24 # The ideal would be to just
25 # pass in the class name, but
26 # that is placing too much of
27 # an assumption on bless(),
28 # which is *probably* a safe
29 # assumption,.. but you can
32 '@!slots' => { map { $_ => undef } @slots },
35 weaken($instance->{'$!meta'});
40 sub associated_metaclass { (shift)->{'$!meta'} }
44 $self->bless_instance_structure({});
47 sub bless_instance_structure {
48 my ($self, $instance_structure) = @_;
49 bless $instance_structure, $self->associated_metaclass->name;
53 my ($self, $instance) = @_;
54 $self->bless_instance_structure({ %$instance });
57 # operations on meta instance
61 return keys %{$self->{'@!slots'}};
65 my ($self, $slot_name) = @_;
66 exists $self->{'@!slots'}->{$slot_name} ? 1 : 0;
69 # operations on created instances
72 my ($self, $instance, $slot_name) = @_;
73 $self->is_slot_initialized($instance, $slot_name) ? $instance->{$slot_name} : undef;
77 my ($self, $instance, $slot_name, $value) = @_;
78 $instance->{$slot_name} = $value;
82 my ($self, $instance, $slot_name) = @_;
83 #$self->set_slot_value($instance, $slot_name, undef);
86 sub deinitialize_slot {
87 my ( $self, $instance, $slot_name ) = @_;
88 delete $instance->{$slot_name};
91 sub initialize_all_slots {
92 my ($self, $instance) = @_;
93 foreach my $slot_name ($self->get_all_slots) {
94 $self->initialize_slot($instance, $slot_name);
98 sub deinitialize_all_slots {
99 my ($self, $instance) = @_;
100 foreach my $slot_name ($self->get_all_slots) {
101 $self->deinitialize_slot($instance, $slot_name);
105 sub is_slot_initialized {
106 my ($self, $instance, $slot_name, $value) = @_;
107 exists $instance->{$slot_name} ? 1 : 0;
110 sub weaken_slot_value {
111 my ($self, $instance, $slot_name) = @_;
112 weaken $instance->{$slot_name};
115 sub strengthen_slot_value {
116 my ($self, $instance, $slot_name) = @_;
117 $self->set_slot_value($instance, $slot_name, $self->get_slot_value($instance, $slot_name));
120 sub rebless_instance_structure {
121 my ($self, $instance, $metaclass) = @_;
122 bless $instance, $metaclass->name;
125 sub get_all_slot_values {
126 my ($self, $instance) = @_;
129 map { $_->name => $_->get_value($instance) }
130 grep { $_->has_value($instance) }
131 $self->associated_metaclass->compute_all_applicable_attributes
135 # inlinable operation snippets
137 sub is_inlinable { 1 }
139 sub inline_create_instance {
140 my ($self, $class_variable) = @_;
141 'bless {} => ' . $class_variable;
144 sub inline_slot_access {
145 my ($self, $instance, $slot_name) = @_;
146 sprintf "%s->{%s}", $instance, $slot_name;
149 sub inline_get_slot_value {
150 my ($self, $instance, $slot_name) = @_;
151 'exists ' . $self->inline_slot_access($instance, $slot_name) .
152 ' ? ' . $self->inline_slot_access($instance, $slot_name) . ' : undef'
155 sub inline_set_slot_value {
156 my ($self, $instance, $slot_name, $value) = @_;
157 $self->inline_slot_access($instance, $slot_name) . " = $value",
160 sub inline_initialize_slot {
161 my ($self, $instance, $slot_name) = @_;
162 $self->inline_set_slot_value($instance, $slot_name, 'undef'),
165 sub inline_deinitialize_slot {
166 my ($self, $instance, $slot_name) = @_;
167 "delete " . $self->inline_slot_access($instance, $slot_name);
169 sub inline_is_slot_initialized {
170 my ($self, $instance, $slot_name) = @_;
171 "exists " . $self->inline_slot_access($instance, $slot_name) . " ? 1 : 0";
174 sub inline_weaken_slot_value {
175 my ($self, $instance, $slot_name) = @_;
176 sprintf "Scalar::Util::weaken( %s )", $self->inline_slot_access($instance, $slot_name);
179 sub inline_strengthen_slot_value {
180 my ($self, $instance, $slot_name) = @_;
181 $self->inline_set_slot_value($instance, $slot_name, $self->inline_slot_access($instance, $slot_name));
192 Class::MOP::Instance - Instance Meta Object
196 # for the most part, this protocol is internal
197 # and not for public usage, but this how one
205 ':instance_metaclass' => 'ArrayBasedStorage::Instance',
208 # now Foo->new produces blessed ARRAY ref based objects
212 This is a sub-protocol which governs instance creation
213 and access to the slots of the instance structure.
215 This may seem like over-abstraction, but by abstracting
216 this process into a sub-protocol we make it possible to
217 easily switch the details of how an object's instance is
218 stored with minimal impact. In most cases just subclassing
219 this class will be all you need to do (see the examples;
220 F<examples/ArrayBasedStorage.pod> and
221 F<examples/InsideOutClass.pod> for details).
227 =item B<new ($meta, @attrs)>
229 Creates a new instance meta-object and gathers all the slots from
230 the list of C<@attrs> given.
234 This will return a B<Class::MOP::Class> instance which is related
239 =head2 Creation of Instances
243 =item B<create_instance>
245 This creates the appropriate structure needed for the instance and
246 then calls C<bless_instance_structure> to bless it into the class.
248 =item B<bless_instance_structure ($instance_structure)>
250 This does just exactly what it says it does.
252 =item B<clone_instance ($instance_structure)>
256 =head2 Instrospection
258 NOTE: There might be more methods added to this part of the API,
259 we will add then when we need them basically.
263 =item B<associated_metaclass>
265 =item B<get_all_slots>
267 This will return the current list of slots based on what was
268 given to this object in C<new>.
270 =item B<is_valid_slot ($slot_name)>
274 =head2 Operations on Instance Structures
276 An important distinction of this sub-protocol is that the
277 instance meta-object is a different entity from the actual
278 instance it creates. For this reason, any actions on slots
279 require that the C<$instance_structure> is passed into them.
283 =item B<get_slot_value ($instance_structure, $slot_name)>
285 =item B<set_slot_value ($instance_structure, $slot_name, $value)>
287 =item B<get_all_slot_values ($instance_structure)>
289 =item B<initialize_slot ($instance_structure, $slot_name)>
291 =item B<deinitialize_slot ($instance_structure, $slot_name)>
293 =item B<initialize_all_slots ($instance_structure)>
295 =item B<deinitialize_all_slots ($instance_structure)>
297 =item B<is_slot_initialized ($instance_structure, $slot_name)>
299 =item B<weaken_slot_value ($instance_structure, $slot_name)>
301 =item B<strengthen_slot_value ($instance_structure, $slot_name)>
303 =item B<rebless_instance_structure ($instance_structure, $new_metaclass)>
307 =head2 Inlineable Instance Operations
309 This part of the API is currently un-used. It is there for use
310 in future experiments in class finailization mostly. Best to
315 =item B<is_inlinable>
317 Each meta-instance should override this method to tell Class::MOP if it's
318 possible to inline the slot access.
320 This is currently only used by Class::MOP::Class::Immutable when performing
323 =item B<inline_create_instance>
325 =item B<inline_slot_access ($instance_structure, $slot_name)>
327 =item B<inline_get_slot_value ($instance_structure, $slot_name)>
329 =item B<inline_set_slot_value ($instance_structure, $slot_name, $value)>
331 =item B<inline_initialize_slot ($instance_structure, $slot_name)>
333 =item B<inline_deinitialize_slot ($instance_structure, $slot_name)>
335 =item B<inline_is_slot_initialized ($instance_structure, $slot_name)>
337 =item B<inline_weaken_slot_value ($instance_structure, $slot_name)>
339 =item B<inline_strengthen_slot_value ($instance_structure, $slot_name)>
345 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
347 Stevan Little E<lt>stevan@iinteractive.comE<gt>
349 =head1 COPYRIGHT AND LICENSE
351 Copyright 2006-2008 by Infinity Interactive, Inc.
353 L<http://www.iinteractive.com>
355 This library is free software; you can redistribute it and/or modify
356 it under the same terms as Perl itself.