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};
69 # operations on created instances
72 my ($self, $instance, $slot_name) = @_;
73 $instance->{$slot_name};
77 my ($self, $instance, $slot_name, $value) = @_;
78 $instance->{$slot_name} = $value;
81 sub _set_initial_slot_value {
82 my ($self, $instance, $slot_name, $value, $initializer) = @_;
84 return $self->set_slot_value($instance, $slot_name, $value)
88 $self->set_slot_value($instance, $slot_name, $_[0]);
91 # most things will just want to set a value, so make it first arg
92 $instance->$initializer($value, $slot_name, $callback);
96 my ($self, $instance, $slot_name) = @_;
97 #$self->set_slot_value($instance, $slot_name, undef);
100 sub deinitialize_slot {
101 my ( $self, $instance, $slot_name ) = @_;
102 delete $instance->{$slot_name};
105 sub initialize_all_slots {
106 my ($self, $instance) = @_;
107 foreach my $slot_name ($self->get_all_slots) {
108 $self->initialize_slot($instance, $slot_name);
112 sub deinitialize_all_slots {
113 my ($self, $instance) = @_;
114 foreach my $slot_name ($self->get_all_slots) {
115 $self->deinitialize_slot($instance, $slot_name);
119 sub is_slot_initialized {
120 my ($self, $instance, $slot_name, $value) = @_;
121 exists $instance->{$slot_name};
124 sub weaken_slot_value {
125 my ($self, $instance, $slot_name) = @_;
126 weaken $instance->{$slot_name};
129 sub strengthen_slot_value {
130 my ($self, $instance, $slot_name) = @_;
131 $self->set_slot_value($instance, $slot_name, $self->get_slot_value($instance, $slot_name));
134 sub rebless_instance_structure {
135 my ($self, $instance, $metaclass) = @_;
136 bless $instance, $metaclass->name;
139 # inlinable operation snippets
141 sub is_inlinable { 1 }
143 sub inline_create_instance {
144 my ($self, $class_variable) = @_;
145 'bless {} => ' . $class_variable;
148 sub inline_slot_access {
149 my ($self, $instance, $slot_name) = @_;
150 sprintf "%s->{%s}", $instance, $slot_name;
153 sub inline_get_slot_value {
154 my ($self, $instance, $slot_name) = @_;
155 $self->inline_slot_access($instance, $slot_name);
158 sub inline_set_slot_value {
159 my ($self, $instance, $slot_name, $value) = @_;
160 $self->inline_slot_access($instance, $slot_name) . " = $value",
163 sub inline_initialize_slot {
164 my ($self, $instance, $slot_name) = @_;
165 $self->inline_set_slot_value($instance, $slot_name, 'undef'),
168 sub inline_deinitialize_slot {
169 my ($self, $instance, $slot_name) = @_;
170 "delete " . $self->inline_slot_access($instance, $slot_name);
172 sub inline_is_slot_initialized {
173 my ($self, $instance, $slot_name) = @_;
174 "exists " . $self->inline_slot_access($instance, $slot_name);
177 sub inline_weaken_slot_value {
178 my ($self, $instance, $slot_name) = @_;
179 sprintf "Scalar::Util::weaken( %s )", $self->inline_slot_access($instance, $slot_name);
182 sub inline_strengthen_slot_value {
183 my ($self, $instance, $slot_name) = @_;
184 $self->inline_set_slot_value($instance, $slot_name, $self->inline_slot_access($instance, $slot_name));
195 Class::MOP::Instance - Instance Meta Object
199 # This API is largely internal
200 # you shouldn't need it unless you are writing meta attributes or meta
205 The meta instance is used by attributes for low level storage.
207 Using this API generally violates attribute encapsulation and is not
208 reccomended, instead look at L<Class::MOP::Attribute/get_value>,
209 L<Class::MOP::Attribute/set_value> for the reccomended way to fiddle with
210 attribute values in a generic way, independant 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).
225 =item B<new ($meta, @attrs)>
227 Creates a new instance meta-object and gathers all the slots from
228 the list of C<@attrs> given.
232 This will return a B<Class::MOP::Class> instance which is related
237 =head2 Creation of Instances
241 =item B<create_instance>
243 This creates the appropriate structure needed for the instance and
244 then calls C<bless_instance_structure> to bless it into the class.
246 =item B<bless_instance_structure ($instance_structure)>
248 This does just exactly what it says it does.
250 =item B<clone_instance ($instance_structure)>
254 =head2 Instrospection
256 NOTE: There might be more methods added to this part of the API,
257 we will add then when we need them basically.
261 =item B<associated_metaclass>
263 =item B<get_all_slots>
265 This will return the current list of slots based on what was
266 given to this object in C<new>.
268 =item B<is_valid_slot ($slot_name)>
272 =head2 Operations on Instance Structures
274 An important distinction of this sub-protocol is that the
275 instance meta-object is a different entity from the actual
276 instance it creates. For this reason, any actions on slots
277 require that the C<$instance_structure> is passed into them.
281 =item B<get_slot_value ($instance_structure, $slot_name)>
283 =item B<set_slot_value ($instance_structure, $slot_name, $value)>
285 =item B<initialize_slot ($instance_structure, $slot_name)>
287 =item B<deinitialize_slot ($instance_structure, $slot_name)>
289 =item B<initialize_all_slots ($instance_structure)>
291 =item B<deinitialize_all_slots ($instance_structure)>
293 =item B<is_slot_initialized ($instance_structure, $slot_name)>
295 =item B<weaken_slot_value ($instance_structure, $slot_name)>
297 =item B<strengthen_slot_value ($instance_structure, $slot_name)>
299 =item B<rebless_instance_structure ($instance_structure, $new_metaclass)>
303 =head2 Inlineable Instance Operations
305 This part of the API is currently un-used. It is there for use
306 in future experiments in class finailization mostly. Best to
311 =item B<is_inlinable>
313 Each meta-instance should override this method to tell Class::MOP if it's
314 possible to inline the slot access.
316 This is currently only used by Class::MOP::Class::Immutable when performing
319 =item B<inline_create_instance>
321 =item B<inline_slot_access ($instance_structure, $slot_name)>
323 =item B<inline_get_slot_value ($instance_structure, $slot_name)>
325 =item B<inline_set_slot_value ($instance_structure, $slot_name, $value)>
327 =item B<inline_initialize_slot ($instance_structure, $slot_name)>
329 =item B<inline_deinitialize_slot ($instance_structure, $slot_name)>
331 =item B<inline_is_slot_initialized ($instance_structure, $slot_name)>
333 =item B<inline_weaken_slot_value ($instance_structure, $slot_name)>
335 =item B<inline_strengthen_slot_value ($instance_structure, $slot_name)>
341 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
343 Stevan Little E<lt>stevan@iinteractive.comE<gt>
345 =head1 COPYRIGHT AND LICENSE
347 Copyright 2006-2008 by Infinity Interactive, Inc.
349 L<http://www.iinteractive.com>
351 This library is free software; you can redistribute it and/or modify
352 it under the same terms as Perl itself.