Conflicts with the last Moose 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
b7e04496 9our $VERSION = '0.88';
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) = @_;
e9a19694 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
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
388=back
389
390=head2 Introspection
391
392=over 4
7d28758b 393
88bb3cf1 394=item B<< Class::MOP::Instance->meta >>
5582521c 395
88bb3cf1 396This will return a L<Class::MOP::Class> instance for this class.
5582521c 397
88bb3cf1 398It should also be noted that L<Class::MOP> will actually bootstrap
399this module by installing a number of attribute meta-objects into its
400metaclass.
5582521c 401
24869f62 402=back
403
1a09d9cc 404=head1 AUTHORS
24869f62 405
9fa4d0b4 406Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
407
24869f62 408Stevan Little E<lt>stevan@iinteractive.comE<gt>
409
410=head1 COPYRIGHT AND LICENSE
411
070bb6c9 412Copyright 2006-2009 by Infinity Interactive, Inc.
24869f62 413
414L<http://www.iinteractive.com>
415
416This library is free software; you can redistribute it and/or modify
8d2d4c67 417it under the same terms as Perl itself.
24869f62 418
84ef30d1 419=cut
5582521c 420