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