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;
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 },
38 $self->bless_instance_structure({});
41 sub bless_instance_structure {
42 my ($self, $instance_structure) = @_;
43 bless $instance_structure, $self->{meta}->name;
47 my ($self, $instance) = @_;
48 $self->bless_instance_structure({ %$instance });
51 # operations on meta instance
55 return keys %{$self->{slots}};
59 my ($self, $slot_name) = @_;
60 exists $self->{slots}->{$slot_name} ? 1 : 0;
63 # operations on created instances
66 my ($self, $instance, $slot_name) = @_;
67 return $instance->{$slot_name};
71 my ($self, $instance, $slot_name, $value) = @_;
72 $instance->{$slot_name} = $value;
76 my ($self, $instance, $slot_name) = @_;
77 $self->set_slot_value($instance, $slot_name, undef);
80 sub deinitialize_slot {
81 my ( $self, $instance, $slot_name ) = @_;
82 delete $instance->{$slot_name};
85 sub initialize_all_slots {
86 my ($self, $instance) = @_;
87 foreach my $slot_name ($self->get_all_slots) {
88 $self->initialize_slot($instance, $slot_name);
92 sub deinitialize_all_slots {
93 my ($self, $instance) = @_;
94 foreach my $slot_name ($self->get_all_slots) {
95 $self->deinitialize_slot($instance, $slot_name);
99 sub is_slot_initialized {
100 my ($self, $instance, $slot_name, $value) = @_;
101 exists $instance->{$slot_name} ? 1 : 0;
104 sub weaken_slot_value {
105 my ($self, $instance, $slot_name) = @_;
106 weaken $instance->{$slot_name};
109 sub strengthen_slot_value {
110 my ($self, $instance, $slot_name) = @_;
111 $self->set_slot_value($instance, $slot_name, $self->get_slot_value($instance, $slot_name));
114 # inlinable operation snippets
116 sub is_inlinable { 1 }
118 sub inline_create_instance {
119 my ($self, $class_variable) = @_;
120 'bless {} => ' . $class_variable;
123 sub inline_slot_access {
124 my ($self, $instance, $slot_name) = @_;
125 sprintf "%s->{%s}", $instance, $slot_name;
128 sub inline_get_slot_value {
129 my ($self, $instance, $slot_name) = @_;
130 $self->inline_slot_access($instance, $slot_name);
133 sub inline_set_slot_value {
134 my ($self, $instance, $slot_name, $value) = @_;
135 $self->inline_slot_access($instance, $slot_name) . " = $value",
138 sub inline_initialize_slot {
139 my ($self, $instance, $slot_name) = @_;
140 $self->inline_set_slot_value($instance, $slot_name, 'undef'),
143 sub inline_deinitialize_slot {
144 my ($self, $instance, $slot_name) = @_;
145 "delete " . $self->inline_slot_access($instance, $slot_name);
147 sub inline_is_slot_initialized {
148 my ($self, $instance, $slot_name) = @_;
149 "exists " . $self->inline_slot_access($instance, $slot_name) . " ? 1 : 0";
152 sub inline_weaken_slot_value {
153 my ($self, $instance, $slot_name) = @_;
154 sprintf "Scalar::Util::weaken( %s )", $self->inline_slot_access($instance, $slot_name);
157 sub inline_strengthen_slot_value {
158 my ($self, $instance, $slot_name) = @_;
159 $self->inline_set_slot_value($instance, $slot_name, $self->inline_slot_access($instance, $slot_name));
170 Class::MOP::Instance - Instance Meta Object
174 # for the most part, this protocol is internal
175 # and not for public usage, but this how one
183 ':instance_metaclass' => 'ArrayBasedStorage::Instance',
186 # now Foo->new produces blessed ARRAY ref based objects
190 This is a sub-protocol which governs instance creation
191 and access to the slots of the instance structure.
193 This may seem like over-abstraction, but by abstracting
194 this process into a sub-protocol we make it possible to
195 easily switch the details of how an object's instance is
196 stored with minimal impact. In most cases just subclassing
197 this class will be all you need to do (see the examples;
198 F<examples/ArrayBasedStorage.pod> and
199 F<examples/InsideOutClass.pod> for details).
205 =item B<new ($meta, @attrs)>
207 Creates a new instance meta-object and gathers all the slots from
208 the list of C<@attrs> given.
212 This will return a B<Class::MOP::Class> instance which is related
217 =head2 Creation of Instances
221 =item B<create_instance>
223 This creates the appropriate structure needed for the instance and
224 then calls C<bless_instance_structure> to bless it into the class.
226 =item B<bless_instance_structure ($instance_structure)>
228 This does just exactly what it says it does.
230 =item B<clone_instance ($instance_structure)>
234 =head2 Instrospection
236 NOTE: There might be more methods added to this part of the API,
237 we will add then when we need them basically.
241 =item B<get_all_slots>
243 This will return the current list of slots based on what was
244 given to this object in C<new>.
246 =item B<is_valid_slot ($slot_name)>
250 =head2 Operations on Instance Structures
252 An important distinction of this sub-protocol is that the
253 instance meta-object is a different entity from the actual
254 instance it creates. For this reason, any actions on slots
255 require that the C<$instance_structure> is passed into them.
259 =item B<get_slot_value ($instance_structure, $slot_name)>
261 =item B<set_slot_value ($instance_structure, $slot_name, $value)>
263 =item B<initialize_slot ($instance_structure, $slot_name)>
265 =item B<deinitialize_slot ($instance_structure, $slot_name)>
267 =item B<initialize_all_slots ($instance_structure)>
269 =item B<deinitialize_all_slots ($instance_structure)>
271 =item B<is_slot_initialized ($instance_structure, $slot_name)>
273 =item B<weaken_slot_value ($instance_structure, $slot_name)>
275 =item B<strengthen_slot_value ($instance_structure, $slot_name)>
279 =head2 Inlineable Instance Operations
281 This part of the API is currently un-used. It is there for use
282 in future experiments in class finailization mostly. Best to
287 =item B<is_inlinable>
289 Each meta-instance should override this method to tell Class::MOP if it's
290 possible to inline the slot access.
292 This is currently only used by Class::MOP::Class::Immutable when performing
295 =item B<inline_create_instance>
297 =item B<inline_slot_access ($instance_structure, $slot_name)>
299 =item B<inline_get_slot_value ($instance_structure, $slot_name)>
301 =item B<inline_set_slot_value ($instance_structure, $slot_name, $value)>
303 =item B<inline_initialize_slot ($instance_structure, $slot_name)>
305 =item B<inline_deinitialize_slot ($instance_structure, $slot_name)>
307 =item B<inline_is_slot_initialized ($instance_structure, $slot_name)>
309 =item B<inline_weaken_slot_value ($instance_structure, $slot_name)>
311 =item B<inline_strengthen_slot_value ($instance_structure, $slot_name)>
317 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
319 Stevan Little E<lt>stevan@iinteractive.comE<gt>
321 =head1 COPYRIGHT AND LICENSE
323 Copyright 2006 by Infinity Interactive, Inc.
325 L<http://www.iinteractive.com>
327 This library is free software; you can redistribute it and/or modify
328 it under the same terms as Perl itself.