Merge branch 'master' of gitmo@git.moose.perl.org:Class-MOP
[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
074ec38f 9our $VERSION = '0.89';
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 {
c7e28c19 78 Carp::cluck('The bless_instance_structure method is deprecated.'
79 . " It will be removed in a future release.\n");
cf11901e 80
49c93440 81 my ($self, $instance_structure) = @_;
74890687 82 bless $instance_structure, $self->_class_name;
2d711cc8 83}
84
f7259199 85sub clone_instance {
86 my ($self, $instance) = @_;
becd03c6 87 bless { %$instance }, $self->_class_name;
f7259199 88}
89
2d711cc8 90# operations on meta instance
91
eb49acde 92sub get_all_slots {
93 my $self = shift;
7c7fd869 94 return @{$self->{'slots'}};
f7259199 95}
96
0b5d46da 97sub get_all_attributes {
98 my $self = shift;
99 return @{$self->{attributes}};
100}
101
f7259199 102sub is_valid_slot {
103 my ($self, $slot_name) = @_;
7c7fd869 104 exists $self->{'slot_hash'}->{$slot_name};
839ea973 105}
106
2d711cc8 107# operations on created instances
108
839ea973 109sub get_slot_value {
2bab2be6 110 my ($self, $instance, $slot_name) = @_;
230472a7 111 $instance->{$slot_name};
839ea973 112}
113
2bab2be6 114sub set_slot_value {
115 my ($self, $instance, $slot_name, $value) = @_;
116 $instance->{$slot_name} = $value;
117}
118
2d711cc8 119sub initialize_slot {
49c93440 120 my ($self, $instance, $slot_name) = @_;
a007159d 121 return;
2d711cc8 122}
123
7d28758b 124sub deinitialize_slot {
125 my ( $self, $instance, $slot_name ) = @_;
126 delete $instance->{$slot_name};
127}
128
c174112e 129sub initialize_all_slots {
130 my ($self, $instance) = @_;
131 foreach my $slot_name ($self->get_all_slots) {
132 $self->initialize_slot($instance, $slot_name);
133 }
134}
135
7d28758b 136sub deinitialize_all_slots {
137 my ($self, $instance) = @_;
138 foreach my $slot_name ($self->get_all_slots) {
139 $self->deinitialize_slot($instance, $slot_name);
140 }
141}
142
49c93440 143sub is_slot_initialized {
144 my ($self, $instance, $slot_name, $value) = @_;
230472a7 145 exists $instance->{$slot_name};
2bab2be6 146}
839ea973 147
5582521c 148sub weaken_slot_value {
69e3ab0a 149 my ($self, $instance, $slot_name) = @_;
150 weaken $instance->{$slot_name};
5582521c 151}
152
153sub strengthen_slot_value {
69e3ab0a 154 my ($self, $instance, $slot_name) = @_;
155 $self->set_slot_value($instance, $slot_name, $self->get_slot_value($instance, $slot_name));
5582521c 156}
157
3d9e4646 158sub rebless_instance_structure {
159 my ($self, $instance, $metaclass) = @_;
feb93c85 160
161 # we use $_[1] here because of t/306_rebless_overload.t regressions on 5.8.8
162 bless $_[1], $metaclass->name;
3d9e4646 163}
164
da5680be 165sub is_dependent_on_superclasses {
166 return; # for meta instances that require updates on inherited slot changes
167}
168
ee7c0467 169# inlinable operation snippets
170
c0cbf4d9 171sub is_inlinable { 1 }
172
173sub inline_create_instance {
174 my ($self, $class_variable) = @_;
175 'bless {} => ' . $class_variable;
176}
177
ee7c0467 178sub inline_slot_access {
179 my ($self, $instance, $slot_name) = @_;
5fb4edd5 180 sprintf q[%s->{'%s'}], $instance, quotemeta($slot_name);
ee7c0467 181}
182
183sub inline_get_slot_value {
184 my ($self, $instance, $slot_name) = @_;
230472a7 185 $self->inline_slot_access($instance, $slot_name);
ee7c0467 186}
187
188sub inline_set_slot_value {
189 my ($self, $instance, $slot_name, $value) = @_;
8d2d4c67 190 $self->inline_slot_access($instance, $slot_name) . " = $value",
ee7c0467 191}
192
193sub inline_initialize_slot {
194 my ($self, $instance, $slot_name) = @_;
a007159d 195 return '';
ee7c0467 196}
197
7d28758b 198sub inline_deinitialize_slot {
199 my ($self, $instance, $slot_name) = @_;
200 "delete " . $self->inline_slot_access($instance, $slot_name);
201}
ee7c0467 202sub inline_is_slot_initialized {
203 my ($self, $instance, $slot_name) = @_;
230472a7 204 "exists " . $self->inline_slot_access($instance, $slot_name);
ee7c0467 205}
206
207sub inline_weaken_slot_value {
208 my ($self, $instance, $slot_name) = @_;
209 sprintf "Scalar::Util::weaken( %s )", $self->inline_slot_access($instance, $slot_name);
210}
211
212sub inline_strengthen_slot_value {
213 my ($self, $instance, $slot_name) = @_;
214 $self->inline_set_slot_value($instance, $slot_name, $self->inline_slot_access($instance, $slot_name));
215}
216
bc3c58a0 217sub inline_rebless_instance_structure {
218 my ($self, $instance, $class_variable) = @_;
219 "bless $instance => $class_variable";
220}
221
24869f62 2221;
223
224__END__
225
226=pod
227
8d2d4c67 228=head1 NAME
24869f62 229
230Class::MOP::Instance - Instance Meta Object
231
24869f62 232=head1 DESCRIPTION
233
1cbf42df 234The Instance Protocol controls the creation of object instances, and
88bb3cf1 235the storage of attribute values in those instances.
236
237Using this API directly in your own code violates encapsulation, and
238we recommend that you use the appropriate APIs in L<Class::MOP::Class>
239and L<Class::MOP::Attribute> instead. Those APIs in turn call the
240methods in this class as appropriate.
241
242This class also participates in generating inlined code by providing
243snippets of code to access an object instance.
9fa4d0b4 244
24869f62 245=head1 METHODS
246
88bb3cf1 247=head2 Object construction
248
24869f62 249=over 4
250
88bb3cf1 251=item B<< Class::MOP::Instance->new(%options) >>
9fa4d0b4 252
88bb3cf1 253This method creates a new meta-instance object.
9fa4d0b4 254
88bb3cf1 255It accepts the following keys in C<%options>:
63d08a9e 256
88bb3cf1 257=over 8
63d08a9e 258
88bb3cf1 259=item * associated_metaclass
9fa4d0b4 260
88bb3cf1 261The L<Class::MOP::Class> object for which instances will be created.
9fa4d0b4 262
88bb3cf1 263=item * attributes
9fa4d0b4 264
88bb3cf1 265An array reference of L<Class::MOP::Attribute> objects. These are the
266attributes which can be stored in each instance.
9fa4d0b4 267
88bb3cf1 268=back
24869f62 269
88bb3cf1 270=back
58287a97 271
88bb3cf1 272=head2 Creating and altering instances
0e76a376 273
88bb3cf1 274=over 4
839ea973 275
88bb3cf1 276=item B<< $metainstance->create_instance >>
0e76a376 277
88bb3cf1 278This method returns a reference blessed into the associated
279metaclass's class.
becd03c6 280
88bb3cf1 281The default is to use a hash reference. Subclasses can override this.
f7259199 282
88bb3cf1 283=item B<< $metainstance->clone_instance($instance) >>
284
285Given an instance, this method creates a new object by making
286I<shallow> clone of the original.
127d39a7 287
9fa4d0b4 288=back
839ea973 289
98bf345b 290=head2 Introspection
58287a97 291
9fa4d0b4 292=over 4
293
88bb3cf1 294=item B<< $metainstance->associated_metaclass >>
c23184fc 295
88bb3cf1 296This returns the L<Class::MOP::Class> object associated with the
297meta-instance object.
127d39a7 298
88bb3cf1 299=item B<< $metainstance->get_all_slots >>
9fa4d0b4 300
88bb3cf1 301This returns a list of slot names stored in object instances. In
302almost all cases, slot names correspond directly attribute names.
58287a97 303
88bb3cf1 304=item B<< $metainstance->is_valid_slot($slot_name) >>
f7259199 305
127d39a7 306This will return true if C<$slot_name> is a valid slot name.
307
88bb3cf1 308=item B<< $metainstance->get_all_attributes >>
da5680be 309
88bb3cf1 310This returns a list of attributes corresponding to the attributes
311passed to the constructor.
0202ee96 312
24869f62 313=back
314
9fa4d0b4 315=head2 Operations on Instance Structures
316
88bb3cf1 317It's important to understand that the meta-instance object is a
318different entity from the actual instances it creates. For this
319reason, any operations on the C<$instance_structure> always require
320that the object instance be passed to the method.
127d39a7 321
24869f62 322=over 4
323
88bb3cf1 324=item B<< $metainstance->get_slot_value($instance_structure, $slot_name) >>
325
326=item B<< $metainstance->set_slot_value($instance_structure, $slot_name, $value) >>
24869f62 327
88bb3cf1 328=item B<< $metainstance->initialize_slot($instance_structure, $slot_name) >>
9fa4d0b4 329
88bb3cf1 330=item B<< $metainstance->deinitialize_slot($instance_structure, $slot_name) >>
9fa4d0b4 331
88bb3cf1 332=item B<< $metainstance->initialize_all_slots($instance_structure) >>
7d28758b 333
88bb3cf1 334=item B<< $metainstance->deinitialize_all_slots($instance_structure) >>
9fa4d0b4 335
88bb3cf1 336=item B<< $metainstance->is_slot_initialized($instance_structure, $slot_name) >>
7d28758b 337
88bb3cf1 338=item B<< $metainstance->weaken_slot_value($instance_structure, $slot_name) >>
24869f62 339
88bb3cf1 340=item B<< $metainstance->strengthen_slot_value($instance_structure, $slot_name) >>
ee7c0467 341
88bb3cf1 342=item B<< $metainstance->rebless_instance_structure($instance_structure, $new_metaclass) >>
ee7c0467 343
88bb3cf1 344The exact details of what each method does should be fairly obvious
345from the method name.
5fdf066d 346
ee7c0467 347=back
348
88bb3cf1 349=head2 Inlinable Instance Operations
ee7c0467 350
351=over 4
352
88bb3cf1 353=item B<< $metainstance->is_inlinable >>
c0cbf4d9 354
88bb3cf1 355This is a boolean that indicates whether or not slot access operations
356can be inlined. By default it is true, but subclasses can override
357this.
c0cbf4d9 358
88bb3cf1 359=item B<< $metainstance->inline_create_instance($class_variable) >>
495af518 360
88bb3cf1 361This method expects a string that, I<when inlined>, will become a
362class name. This would literally be something like C<'$class'>, not an
363actual class name.
ee7c0467 364
88bb3cf1 365It returns a snippet of code that creates a new object for the
366class. This is something like C< bless {}, $class_name >.
ee7c0467 367
88bb3cf1 368=item B<< $metainstance->inline_slot_access($instance_variable, $slot_name) >>
ee7c0467 369
88bb3cf1 370=item B<< $metainstance->inline_get_slot_value($instance_variable, $slot_name) >>
ee7c0467 371
88bb3cf1 372=item B<< $metainstance->inline_set_slot_value($instance_variable, $slot_name, $value) >>
373
374=item B<< $metainstance->inline_initialize_slot($instance_variable, $slot_name) >>
375
376=item B<< $metainstance->inline_deinitialize_slot($instance_variable, $slot_name) >>
377
378=item B<< $metainstance->inline_is_slot_initialized($instance_variable, $slot_name) >>
379
380=item B<< $metainstance->inline_weaken_slot_value($instance_variable, $slot_name) >>
381
382=item B<< $metainstance->inline_strengthen_slot_value($instance_variable, $slot_name) >>
383
384These methods all expect two arguments. The first is the name of a
385variable, than when inlined, will represent the object
386instance. Typically this will be a literal string like C<'$_[0]'>.
387
388The second argument is a slot name.
389
390The method returns a snippet of code that, when inlined, performs some
391operation on the instance.
392
0fab42eb 393=item B<< $metainstance->inline_rebless_instance_structure($instance_variable, $class_variable) >>
394
395This takes the name of a variable that will, when inlined, represent the object
396instance, and the name of a variable that will represent the class to rebless
397into, and returns code to rebless an instance into a class.
398
88bb3cf1 399=back
400
401=head2 Introspection
402
403=over 4
7d28758b 404
88bb3cf1 405=item B<< Class::MOP::Instance->meta >>
5582521c 406
88bb3cf1 407This will return a L<Class::MOP::Class> instance for this class.
5582521c 408
88bb3cf1 409It should also be noted that L<Class::MOP> will actually bootstrap
410this module by installing a number of attribute meta-objects into its
411metaclass.
5582521c 412
24869f62 413=back
414
1a09d9cc 415=head1 AUTHORS
24869f62 416
9fa4d0b4 417Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
418
24869f62 419Stevan Little E<lt>stevan@iinteractive.comE<gt>
420
421=head1 COPYRIGHT AND LICENSE
422
070bb6c9 423Copyright 2006-2009 by Infinity Interactive, Inc.
24869f62 424
425L<http://www.iinteractive.com>
426
427This library is free software; you can redistribute it and/or modify
8d2d4c67 428it under the same terms as Perl itself.
24869f62 429
84ef30d1 430=cut
5582521c 431