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 # inlinable operation snippets
122 sub is_inlinable { 1 }
124 sub inline_create_instance {
125 my ($self, $class_variable) = @_;
126 'bless {} => ' . $class_variable;
129 sub inline_slot_access {
130 my ($self, $instance, $slot_name) = @_;
131 sprintf "%s->{%s}", $instance, $slot_name;
134 sub inline_get_slot_value {
135 my ($self, $instance, $slot_name) = @_;
136 'exists ' . $self->inline_slot_access($instance, $slot_name) .
137 ' ? ' . $self->inline_slot_access($instance, $slot_name) . ' : undef'
140 sub inline_set_slot_value {
141 my ($self, $instance, $slot_name, $value) = @_;
142 $self->inline_slot_access($instance, $slot_name) . " = $value",
145 sub inline_initialize_slot {
146 my ($self, $instance, $slot_name) = @_;
147 $self->inline_set_slot_value($instance, $slot_name, 'undef'),
150 sub inline_deinitialize_slot {
151 my ($self, $instance, $slot_name) = @_;
152 "delete " . $self->inline_slot_access($instance, $slot_name);
154 sub inline_is_slot_initialized {
155 my ($self, $instance, $slot_name) = @_;
156 "exists " . $self->inline_slot_access($instance, $slot_name) . " ? 1 : 0";
159 sub inline_weaken_slot_value {
160 my ($self, $instance, $slot_name) = @_;
161 sprintf "Scalar::Util::weaken( %s )", $self->inline_slot_access($instance, $slot_name);
164 sub inline_strengthen_slot_value {
165 my ($self, $instance, $slot_name) = @_;
166 $self->inline_set_slot_value($instance, $slot_name, $self->inline_slot_access($instance, $slot_name));
177 Class::MOP::Instance - Instance Meta Object
181 # for the most part, this protocol is internal
182 # and not for public usage, but this how one
190 ':instance_metaclass' => 'ArrayBasedStorage::Instance',
193 # now Foo->new produces blessed ARRAY ref based objects
197 This is a sub-protocol which governs instance creation
198 and access to the slots of the instance structure.
200 This may seem like over-abstraction, but by abstracting
201 this process into a sub-protocol we make it possible to
202 easily switch the details of how an object's instance is
203 stored with minimal impact. In most cases just subclassing
204 this class will be all you need to do (see the examples;
205 F<examples/ArrayBasedStorage.pod> and
206 F<examples/InsideOutClass.pod> for details).
212 =item B<new ($meta, @attrs)>
214 Creates a new instance meta-object and gathers all the slots from
215 the list of C<@attrs> given.
219 This will return a B<Class::MOP::Class> instance which is related
224 =head2 Creation of Instances
228 =item B<create_instance>
230 This creates the appropriate structure needed for the instance and
231 then calls C<bless_instance_structure> to bless it into the class.
233 =item B<bless_instance_structure ($instance_structure)>
235 This does just exactly what it says it does.
237 =item B<clone_instance ($instance_structure)>
241 =head2 Instrospection
243 NOTE: There might be more methods added to this part of the API,
244 we will add then when we need them basically.
248 =item B<associated_metaclass>
250 =item B<get_all_slots>
252 This will return the current list of slots based on what was
253 given to this object in C<new>.
255 =item B<is_valid_slot ($slot_name)>
259 =head2 Operations on Instance Structures
261 An important distinction of this sub-protocol is that the
262 instance meta-object is a different entity from the actual
263 instance it creates. For this reason, any actions on slots
264 require that the C<$instance_structure> is passed into them.
268 =item B<get_slot_value ($instance_structure, $slot_name)>
270 =item B<set_slot_value ($instance_structure, $slot_name, $value)>
272 =item B<initialize_slot ($instance_structure, $slot_name)>
274 =item B<deinitialize_slot ($instance_structure, $slot_name)>
276 =item B<initialize_all_slots ($instance_structure)>
278 =item B<deinitialize_all_slots ($instance_structure)>
280 =item B<is_slot_initialized ($instance_structure, $slot_name)>
282 =item B<weaken_slot_value ($instance_structure, $slot_name)>
284 =item B<strengthen_slot_value ($instance_structure, $slot_name)>
288 =head2 Inlineable Instance Operations
290 This part of the API is currently un-used. It is there for use
291 in future experiments in class finailization mostly. Best to
296 =item B<is_inlinable>
298 Each meta-instance should override this method to tell Class::MOP if it's
299 possible to inline the slot access.
301 This is currently only used by Class::MOP::Class::Immutable when performing
304 =item B<inline_create_instance>
306 =item B<inline_slot_access ($instance_structure, $slot_name)>
308 =item B<inline_get_slot_value ($instance_structure, $slot_name)>
310 =item B<inline_set_slot_value ($instance_structure, $slot_name, $value)>
312 =item B<inline_initialize_slot ($instance_structure, $slot_name)>
314 =item B<inline_deinitialize_slot ($instance_structure, $slot_name)>
316 =item B<inline_is_slot_initialized ($instance_structure, $slot_name)>
318 =item B<inline_weaken_slot_value ($instance_structure, $slot_name)>
320 =item B<inline_strengthen_slot_value ($instance_structure, $slot_name)>
326 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
328 Stevan Little E<lt>stevan@iinteractive.comE<gt>
330 =head1 COPYRIGHT AND LICENSE
332 Copyright 2006, 2007 by Infinity Interactive, Inc.
334 L<http://www.iinteractive.com>
336 This library is free software; you can redistribute it and/or modify
337 it under the same terms as Perl itself.