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