renumber to 0.77_01 for a dev release
[gitmo/Class-MOP.git] / lib / Class / MOP / Instance.pm
CommitLineData
24869f62 1
2package Class::MOP::Instance;
3
4use strict;
5use warnings;
6
fa16e528 7use Scalar::Util 'weaken', 'blessed';
24869f62 8
097eeb20 9our $VERSION = '0.77_01';
d519662a 10$VERSION = eval $VERSION;
f0480c45 11our $AUTHORITY = 'cpan:STEVAN';
24869f62 12
d7b2249e 13use base 'Class::MOP::Object';
24869f62 14
63d08a9e 15sub BUILDARGS {
d43737b3 16 my ($class, @args) = @_;
17
18 if ( @args == 1 ) {
63d08a9e 19 unshift @args, "associated_metaclass";
d43737b3 20 } elsif ( @args >= 2 && blessed($args[0]) && $args[0]->isa("Class::MOP::Class") ) {
21 # compat mode
22 my ( $meta, @attrs ) = @args;
63d08a9e 23 @args = ( associated_metaclass => $meta, attributes => \@attrs );
d43737b3 24 }
25
26 my %options = @args;
7c7fd869 27 # FIXME lazy_build
d43737b3 28 $options{slots} ||= [ map { $_->slots } @{ $options{attributes} || [] } ];
63d08a9e 29 $options{slot_hash} = { map { $_ => undef } @{ $options{slots} } }; # FIXME lazy_build
30
31 return \%options;
32}
33
34sub new {
35 my $class = shift;
36 my $options = $class->BUILDARGS(@_);
d43737b3 37
38 # FIXME replace with a proper constructor
b4b5d65a 39 my $instance = $class->_new(%$options);
40
41 # FIXME weak_ref => 1,
42 weaken($instance->{'associated_metaclass'});
43
44 return $instance;
45}
46
47sub _new {
48 my ( $class, %options ) = @_;
49 bless {
fc3ddd1d 50 # NOTE:
51 # I am not sure that it makes
52 # sense to pass in the meta
8d2d4c67 53 # The ideal would be to just
54 # pass in the class name, but
55 # that is placing too much of
56 # an assumption on bless(),
fc3ddd1d 57 # which is *probably* a safe
8d2d4c67 58 # assumption,.. but you can
fc3ddd1d 59 # never tell <:)
b4b5d65a 60 'associated_metaclass' => $options{associated_metaclass},
61 'attributes' => $options{attributes},
62 'slots' => $options{slots},
63 'slot_hash' => $options{slot_hash},
8d2d4c67 64 } => $class;
24869f62 65}
66
74890687 67sub _class_name { $_[0]->{_class_name} ||= $_[0]->associated_metaclass->name }
68
69sub associated_metaclass { $_[0]{'associated_metaclass'} }
c23184fc 70
49c93440 71sub create_instance {
72 my $self = shift;
becd03c6 73 bless {}, $self->_class_name;
2d711cc8 74}
75
becd03c6 76# for compatibility
49c93440 77sub bless_instance_structure {
78 my ($self, $instance_structure) = @_;
74890687 79 bless $instance_structure, $self->_class_name;
2d711cc8 80}
81
f7259199 82sub clone_instance {
83 my ($self, $instance) = @_;
becd03c6 84 bless { %$instance }, $self->_class_name;
f7259199 85}
86
2d711cc8 87# operations on meta instance
88
eb49acde 89sub get_all_slots {
90 my $self = shift;
7c7fd869 91 return @{$self->{'slots'}};
f7259199 92}
93
0b5d46da 94sub get_all_attributes {
95 my $self = shift;
96 return @{$self->{attributes}};
97}
98
f7259199 99sub is_valid_slot {
100 my ($self, $slot_name) = @_;
7c7fd869 101 exists $self->{'slot_hash'}->{$slot_name};
839ea973 102}
103
2d711cc8 104# operations on created instances
105
839ea973 106sub get_slot_value {
2bab2be6 107 my ($self, $instance, $slot_name) = @_;
230472a7 108 $instance->{$slot_name};
839ea973 109}
110
2bab2be6 111sub set_slot_value {
112 my ($self, $instance, $slot_name, $value) = @_;
113 $instance->{$slot_name} = $value;
114}
115
2d711cc8 116sub initialize_slot {
49c93440 117 my ($self, $instance, $slot_name) = @_;
a007159d 118 return;
2d711cc8 119}
120
7d28758b 121sub deinitialize_slot {
122 my ( $self, $instance, $slot_name ) = @_;
123 delete $instance->{$slot_name};
124}
125
c174112e 126sub initialize_all_slots {
127 my ($self, $instance) = @_;
128 foreach my $slot_name ($self->get_all_slots) {
129 $self->initialize_slot($instance, $slot_name);
130 }
131}
132
7d28758b 133sub deinitialize_all_slots {
134 my ($self, $instance) = @_;
135 foreach my $slot_name ($self->get_all_slots) {
136 $self->deinitialize_slot($instance, $slot_name);
137 }
138}
139
49c93440 140sub is_slot_initialized {
141 my ($self, $instance, $slot_name, $value) = @_;
230472a7 142 exists $instance->{$slot_name};
2bab2be6 143}
839ea973 144
5582521c 145sub weaken_slot_value {
69e3ab0a 146 my ($self, $instance, $slot_name) = @_;
147 weaken $instance->{$slot_name};
5582521c 148}
149
150sub strengthen_slot_value {
69e3ab0a 151 my ($self, $instance, $slot_name) = @_;
152 $self->set_slot_value($instance, $slot_name, $self->get_slot_value($instance, $slot_name));
5582521c 153}
154
3d9e4646 155sub rebless_instance_structure {
156 my ($self, $instance, $metaclass) = @_;
157 bless $instance, $metaclass->name;
158}
159
da5680be 160sub is_dependent_on_superclasses {
161 return; # for meta instances that require updates on inherited slot changes
162}
163
ee7c0467 164# inlinable operation snippets
165
c0cbf4d9 166sub is_inlinable { 1 }
167
168sub inline_create_instance {
169 my ($self, $class_variable) = @_;
170 'bless {} => ' . $class_variable;
171}
172
ee7c0467 173sub inline_slot_access {
174 my ($self, $instance, $slot_name) = @_;
e9a19694 175 sprintf q[%s->{"%s"}], $instance, quotemeta($slot_name);
ee7c0467 176}
177
178sub inline_get_slot_value {
179 my ($self, $instance, $slot_name) = @_;
230472a7 180 $self->inline_slot_access($instance, $slot_name);
ee7c0467 181}
182
183sub inline_set_slot_value {
184 my ($self, $instance, $slot_name, $value) = @_;
8d2d4c67 185 $self->inline_slot_access($instance, $slot_name) . " = $value",
ee7c0467 186}
187
188sub inline_initialize_slot {
189 my ($self, $instance, $slot_name) = @_;
a007159d 190 return '';
ee7c0467 191}
192
7d28758b 193sub inline_deinitialize_slot {
194 my ($self, $instance, $slot_name) = @_;
195 "delete " . $self->inline_slot_access($instance, $slot_name);
196}
ee7c0467 197sub inline_is_slot_initialized {
198 my ($self, $instance, $slot_name) = @_;
230472a7 199 "exists " . $self->inline_slot_access($instance, $slot_name);
ee7c0467 200}
201
202sub inline_weaken_slot_value {
203 my ($self, $instance, $slot_name) = @_;
204 sprintf "Scalar::Util::weaken( %s )", $self->inline_slot_access($instance, $slot_name);
205}
206
207sub inline_strengthen_slot_value {
208 my ($self, $instance, $slot_name) = @_;
209 $self->inline_set_slot_value($instance, $slot_name, $self->inline_slot_access($instance, $slot_name));
210}
211
24869f62 2121;
213
214__END__
215
216=pod
217
8d2d4c67 218=head1 NAME
24869f62 219
220Class::MOP::Instance - Instance Meta Object
221
24869f62 222=head1 DESCRIPTION
223
bc9e7815 224The meta instance is used by attributes for low level storage.
225
226Using this API generally violates attribute encapsulation and is not
98bf345b 227recommended, instead look at L<Class::MOP::Attribute/get_value>,
228L<Class::MOP::Attribute/set_value> for the recommended way to fiddle with
229attribute values in a generic way, independent of how/whether accessors have
bc9e7815 230been defined. Accessors can be found using L<Class::MOP::Class/get_attribute>.
9fa4d0b4 231
8d2d4c67 232This may seem like over-abstraction, but by abstracting
233this process into a sub-protocol we make it possible to
234easily switch the details of how an object's instance is
235stored with minimal impact. In most cases just subclassing
236this class will be all you need to do (see the examples;
237F<examples/ArrayBasedStorage.pod> and
1becdfcc 238F<examples/InsideOutClass.pod> for details).
9fa4d0b4 239
24869f62 240=head1 METHODS
241
242=over 4
243
63d08a9e 244=item B<new %args>
9fa4d0b4 245
8d2d4c67 246Creates a new instance meta-object and gathers all the slots from
9fa4d0b4 247the list of C<@attrs> given.
248
63d08a9e 249=item B<BUILDARGS>
250
251Processes arguments for compatibility.
252
9fa4d0b4 253=item B<meta>
254
63d08a9e 255Returns the metaclass of L<Class::MOP::Instance>.
9fa4d0b4 256
257=back
258
259=head2 Creation of Instances
260
261=over 4
24869f62 262
58287a97 263=item B<create_instance>
264
becd03c6 265This creates the appropriate structure needed for the instance and blesses it.
0e76a376 266
9fa4d0b4 267=item B<bless_instance_structure ($instance_structure)>
839ea973 268
9fa4d0b4 269This does just exactly what it says it does.
0e76a376 270
becd03c6 271This method has been deprecated but remains for compatibility reasons. None of
272the subclasses of L<Class::MOP::Instance> ever bothered to actually make use of
273it, so it was deemed unnecessary fluff.
274
f7259199 275=item B<clone_instance ($instance_structure)>
276
becd03c6 277Creates a shallow clone of $instance_structure.
127d39a7 278
9fa4d0b4 279=back
839ea973 280
98bf345b 281=head2 Introspection
58287a97 282
8d2d4c67 283NOTE: There might be more methods added to this part of the API,
9fa4d0b4 284we will add then when we need them basically.
58287a97 285
9fa4d0b4 286=over 4
287
c23184fc 288=item B<associated_metaclass>
289
127d39a7 290This returns the metaclass associated with this instance.
291
9fa4d0b4 292=item B<get_all_slots>
293
8d2d4c67 294This will return the current list of slots based on what was
9fa4d0b4 295given to this object in C<new>.
58287a97 296
f7259199 297=item B<is_valid_slot ($slot_name)>
298
127d39a7 299This will return true if C<$slot_name> is a valid slot name.
300
da5680be 301=item B<is_dependent_on_superclasses>
302
303This method returns true when the meta instance must be recreated on any
304superclass changes.
305
306Defaults to false.
307
0202ee96 308=item B<get_all_attributes>
309
310This will return the current list of attributes (as
311Class::MOP::Attribute objects) based on what was given to this object
312in C<new>.
313
24869f62 314=back
315
9fa4d0b4 316=head2 Operations on Instance Structures
317
8d2d4c67 318An important distinction of this sub-protocol is that the
319instance meta-object is a different entity from the actual
320instance it creates. For this reason, any actions on slots
9fa4d0b4 321require that the C<$instance_structure> is passed into them.
24869f62 322
127d39a7 323The names of these methods pretty much explain exactly
324what they do, if that is not enough then I suggest reading
325the source, it is very straightfoward.
326
24869f62 327=over 4
328
9fa4d0b4 329=item B<get_slot_value ($instance_structure, $slot_name)>
24869f62 330
9fa4d0b4 331=item B<set_slot_value ($instance_structure, $slot_name, $value)>
332
333=item B<initialize_slot ($instance_structure, $slot_name)>
334
7d28758b 335=item B<deinitialize_slot ($instance_structure, $slot_name)>
336
9fa4d0b4 337=item B<initialize_all_slots ($instance_structure)>
338
7d28758b 339=item B<deinitialize_all_slots ($instance_structure)>
340
9fa4d0b4 341=item B<is_slot_initialized ($instance_structure, $slot_name)>
24869f62 342
ee7c0467 343=item B<weaken_slot_value ($instance_structure, $slot_name)>
344
345=item B<strengthen_slot_value ($instance_structure, $slot_name)>
346
5fdf066d 347=item B<rebless_instance_structure ($instance_structure, $new_metaclass)>
348
ee7c0467 349=back
350
351=head2 Inlineable Instance Operations
352
353=over 4
354
c0cbf4d9 355=item B<is_inlinable>
356
8d2d4c67 357Each meta-instance should override this method to tell Class::MOP if it's
127d39a7 358possible to inline the slot access. This is currently only used by
359L<Class::MOP::Immutable> when performing optimizations.
c0cbf4d9 360
495af518 361=item B<inline_create_instance>
362
ee7c0467 363=item B<inline_slot_access ($instance_structure, $slot_name)>
364
365=item B<inline_get_slot_value ($instance_structure, $slot_name)>
366
367=item B<inline_set_slot_value ($instance_structure, $slot_name, $value)>
368
369=item B<inline_initialize_slot ($instance_structure, $slot_name)>
370
7d28758b 371=item B<inline_deinitialize_slot ($instance_structure, $slot_name)>
372
ee7c0467 373=item B<inline_is_slot_initialized ($instance_structure, $slot_name)>
5582521c 374
ee7c0467 375=item B<inline_weaken_slot_value ($instance_structure, $slot_name)>
5582521c 376
ee7c0467 377=item B<inline_strengthen_slot_value ($instance_structure, $slot_name)>
5582521c 378
24869f62 379=back
380
1a09d9cc 381=head1 AUTHORS
24869f62 382
9fa4d0b4 383Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
384
24869f62 385Stevan Little E<lt>stevan@iinteractive.comE<gt>
386
387=head1 COPYRIGHT AND LICENSE
388
69e3ab0a 389Copyright 2006-2008 by Infinity Interactive, Inc.
24869f62 390
391L<http://www.iinteractive.com>
392
393This library is free software; you can redistribute it and/or modify
8d2d4c67 394it under the same terms as Perl itself.
24869f62 395
84ef30d1 396=cut
5582521c 397