Some simplifications and corrections suggested by nothingmuch++
[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
f0480c45 9our $VERSION = '0.03';
10our $AUTHORITY = 'cpan:STEVAN';
24869f62 11
8d2d4c67 12sub meta {
24869f62 13 require Class::MOP::Class;
14 Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
15}
16
8d2d4c67 17sub new {
052c2a1a 18 my ($class, $meta, @attrs) = @_;
c57c8b10 19 my @slots = map { $_->slots } @attrs;
c23184fc 20 my $instance = bless {
fc3ddd1d 21 # NOTE:
22 # I am not sure that it makes
23 # sense to pass in the meta
8d2d4c67 24 # The ideal would be to just
25 # pass in the class name, but
26 # that is placing too much of
27 # an assumption on bless(),
fc3ddd1d 28 # which is *probably* a safe
8d2d4c67 29 # assumption,.. but you can
fc3ddd1d 30 # never tell <:)
c23184fc 31 '$!meta' => $meta,
32 '@!slots' => { map { $_ => undef } @slots },
8d2d4c67 33 } => $class;
34
c23184fc 35 weaken($instance->{'$!meta'});
8d2d4c67 36
c23184fc 37 return $instance;
24869f62 38}
39
c23184fc 40sub associated_metaclass { (shift)->{'$!meta'} }
41
49c93440 42sub create_instance {
43 my $self = shift;
44 $self->bless_instance_structure({});
2d711cc8 45}
46
49c93440 47sub bless_instance_structure {
48 my ($self, $instance_structure) = @_;
c23184fc 49 bless $instance_structure, $self->associated_metaclass->name;
2d711cc8 50}
51
f7259199 52sub clone_instance {
53 my ($self, $instance) = @_;
54 $self->bless_instance_structure({ %$instance });
55}
56
2d711cc8 57# operations on meta instance
58
eb49acde 59sub get_all_slots {
60 my $self = shift;
c23184fc 61 return keys %{$self->{'@!slots'}};
f7259199 62}
63
64sub is_valid_slot {
65 my ($self, $slot_name) = @_;
c23184fc 66 exists $self->{'@!slots'}->{$slot_name} ? 1 : 0;
839ea973 67}
68
2d711cc8 69# operations on created instances
70
839ea973 71sub get_slot_value {
2bab2be6 72 my ($self, $instance, $slot_name) = @_;
8d2d4c67 73 $self->is_slot_initialized($instance, $slot_name) ? $instance->{$slot_name} : undef;
839ea973 74}
75
2bab2be6 76sub set_slot_value {
77 my ($self, $instance, $slot_name, $value) = @_;
78 $instance->{$slot_name} = $value;
79}
80
2d711cc8 81sub initialize_slot {
49c93440 82 my ($self, $instance, $slot_name) = @_;
8d2d4c67 83 #$self->set_slot_value($instance, $slot_name, undef);
2d711cc8 84}
85
7d28758b 86sub deinitialize_slot {
87 my ( $self, $instance, $slot_name ) = @_;
88 delete $instance->{$slot_name};
89}
90
c174112e 91sub initialize_all_slots {
92 my ($self, $instance) = @_;
93 foreach my $slot_name ($self->get_all_slots) {
94 $self->initialize_slot($instance, $slot_name);
95 }
96}
97
7d28758b 98sub deinitialize_all_slots {
99 my ($self, $instance) = @_;
100 foreach my $slot_name ($self->get_all_slots) {
101 $self->deinitialize_slot($instance, $slot_name);
102 }
103}
104
49c93440 105sub is_slot_initialized {
106 my ($self, $instance, $slot_name, $value) = @_;
2d711cc8 107 exists $instance->{$slot_name} ? 1 : 0;
2bab2be6 108}
839ea973 109
5582521c 110sub weaken_slot_value {
69e3ab0a 111 my ($self, $instance, $slot_name) = @_;
112 weaken $instance->{$slot_name};
5582521c 113}
114
115sub strengthen_slot_value {
69e3ab0a 116 my ($self, $instance, $slot_name) = @_;
117 $self->set_slot_value($instance, $slot_name, $self->get_slot_value($instance, $slot_name));
5582521c 118}
119
3d9e4646 120sub rebless_instance_structure {
121 my ($self, $instance, $metaclass) = @_;
122 bless $instance, $metaclass->name;
123}
124
ad074154 125sub get_all_slot_values {
126 my ($self, $instance) = @_;
ad074154 127
3f59a80e 128 return +{
129 map { $_->name => $_->get_value($instance) }
130 grep { $_->has_value($instance) }
131 $self->associated_metaclass->compute_all_applicable_attributes
132 };
ad074154 133}
134
ee7c0467 135# inlinable operation snippets
136
c0cbf4d9 137sub is_inlinable { 1 }
138
139sub inline_create_instance {
140 my ($self, $class_variable) = @_;
141 'bless {} => ' . $class_variable;
142}
143
ee7c0467 144sub inline_slot_access {
145 my ($self, $instance, $slot_name) = @_;
146 sprintf "%s->{%s}", $instance, $slot_name;
147}
148
149sub inline_get_slot_value {
150 my ($self, $instance, $slot_name) = @_;
8d2d4c67 151 'exists ' . $self->inline_slot_access($instance, $slot_name) .
152 ' ? ' . $self->inline_slot_access($instance, $slot_name) . ' : undef'
ee7c0467 153}
154
155sub inline_set_slot_value {
156 my ($self, $instance, $slot_name, $value) = @_;
8d2d4c67 157 $self->inline_slot_access($instance, $slot_name) . " = $value",
ee7c0467 158}
159
160sub inline_initialize_slot {
161 my ($self, $instance, $slot_name) = @_;
162 $self->inline_set_slot_value($instance, $slot_name, 'undef'),
163}
164
7d28758b 165sub inline_deinitialize_slot {
166 my ($self, $instance, $slot_name) = @_;
167 "delete " . $self->inline_slot_access($instance, $slot_name);
168}
ee7c0467 169sub inline_is_slot_initialized {
170 my ($self, $instance, $slot_name) = @_;
171 "exists " . $self->inline_slot_access($instance, $slot_name) . " ? 1 : 0";
172}
173
174sub inline_weaken_slot_value {
175 my ($self, $instance, $slot_name) = @_;
176 sprintf "Scalar::Util::weaken( %s )", $self->inline_slot_access($instance, $slot_name);
177}
178
179sub inline_strengthen_slot_value {
180 my ($self, $instance, $slot_name) = @_;
181 $self->inline_set_slot_value($instance, $slot_name, $self->inline_slot_access($instance, $slot_name));
182}
183
24869f62 1841;
185
186__END__
187
188=pod
189
8d2d4c67 190=head1 NAME
24869f62 191
192Class::MOP::Instance - Instance Meta Object
193
194=head1 SYNOPSIS
195
8d2d4c67 196 # for the most part, this protocol is internal
197 # and not for public usage, but this how one
9fa4d0b4 198 # might use it
8d2d4c67 199
9fa4d0b4 200 package Foo;
8d2d4c67 201
9fa4d0b4 202 use strict;
203 use warnings;
1becdfcc 204 use metaclass (
9fa4d0b4 205 ':instance_metaclass' => 'ArrayBasedStorage::Instance',
206 );
8d2d4c67 207
9fa4d0b4 208 # now Foo->new produces blessed ARRAY ref based objects
209
24869f62 210=head1 DESCRIPTION
211
8d2d4c67 212This is a sub-protocol which governs instance creation
9fa4d0b4 213and access to the slots of the instance structure.
214
8d2d4c67 215This may seem like over-abstraction, but by abstracting
216this process into a sub-protocol we make it possible to
217easily switch the details of how an object's instance is
218stored with minimal impact. In most cases just subclassing
219this class will be all you need to do (see the examples;
220F<examples/ArrayBasedStorage.pod> and
1becdfcc 221F<examples/InsideOutClass.pod> for details).
9fa4d0b4 222
24869f62 223=head1 METHODS
224
225=over 4
226
9fa4d0b4 227=item B<new ($meta, @attrs)>
228
8d2d4c67 229Creates a new instance meta-object and gathers all the slots from
9fa4d0b4 230the list of C<@attrs> given.
231
232=item B<meta>
233
8d2d4c67 234This will return a B<Class::MOP::Class> instance which is related
9fa4d0b4 235to this class.
236
237=back
238
239=head2 Creation of Instances
240
241=over 4
24869f62 242
58287a97 243=item B<create_instance>
244
8d2d4c67 245This creates the appropriate structure needed for the instance and
9fa4d0b4 246then calls C<bless_instance_structure> to bless it into the class.
0e76a376 247
9fa4d0b4 248=item B<bless_instance_structure ($instance_structure)>
839ea973 249
9fa4d0b4 250This does just exactly what it says it does.
0e76a376 251
f7259199 252=item B<clone_instance ($instance_structure)>
253
9fa4d0b4 254=back
839ea973 255
9fa4d0b4 256=head2 Instrospection
58287a97 257
8d2d4c67 258NOTE: There might be more methods added to this part of the API,
9fa4d0b4 259we will add then when we need them basically.
58287a97 260
9fa4d0b4 261=over 4
262
c23184fc 263=item B<associated_metaclass>
264
9fa4d0b4 265=item B<get_all_slots>
266
8d2d4c67 267This will return the current list of slots based on what was
9fa4d0b4 268given to this object in C<new>.
58287a97 269
f7259199 270=item B<is_valid_slot ($slot_name)>
271
24869f62 272=back
273
9fa4d0b4 274=head2 Operations on Instance Structures
275
8d2d4c67 276An important distinction of this sub-protocol is that the
277instance meta-object is a different entity from the actual
278instance it creates. For this reason, any actions on slots
9fa4d0b4 279require that the C<$instance_structure> is passed into them.
24869f62 280
281=over 4
282
9fa4d0b4 283=item B<get_slot_value ($instance_structure, $slot_name)>
24869f62 284
9fa4d0b4 285=item B<set_slot_value ($instance_structure, $slot_name, $value)>
286
ad074154 287=item B<get_all_slot_values ($instance_structure)>
288
9fa4d0b4 289=item B<initialize_slot ($instance_structure, $slot_name)>
290
7d28758b 291=item B<deinitialize_slot ($instance_structure, $slot_name)>
292
9fa4d0b4 293=item B<initialize_all_slots ($instance_structure)>
294
7d28758b 295=item B<deinitialize_all_slots ($instance_structure)>
296
9fa4d0b4 297=item B<is_slot_initialized ($instance_structure, $slot_name)>
24869f62 298
ee7c0467 299=item B<weaken_slot_value ($instance_structure, $slot_name)>
300
301=item B<strengthen_slot_value ($instance_structure, $slot_name)>
302
5fdf066d 303=item B<rebless_instance_structure ($instance_structure, $new_metaclass)>
304
ee7c0467 305=back
306
307=head2 Inlineable Instance Operations
308
8d2d4c67 309This part of the API is currently un-used. It is there for use
310in future experiments in class finailization mostly. Best to
f7259199 311ignore this for now.
312
ee7c0467 313=over 4
314
c0cbf4d9 315=item B<is_inlinable>
316
8d2d4c67 317Each meta-instance should override this method to tell Class::MOP if it's
318possible to inline the slot access.
c0cbf4d9 319
8d2d4c67 320This is currently only used by Class::MOP::Class::Immutable when performing
c0cbf4d9 321optimizations.
322
495af518 323=item B<inline_create_instance>
324
ee7c0467 325=item B<inline_slot_access ($instance_structure, $slot_name)>
326
327=item B<inline_get_slot_value ($instance_structure, $slot_name)>
328
329=item B<inline_set_slot_value ($instance_structure, $slot_name, $value)>
330
331=item B<inline_initialize_slot ($instance_structure, $slot_name)>
332
7d28758b 333=item B<inline_deinitialize_slot ($instance_structure, $slot_name)>
334
ee7c0467 335=item B<inline_is_slot_initialized ($instance_structure, $slot_name)>
5582521c 336
ee7c0467 337=item B<inline_weaken_slot_value ($instance_structure, $slot_name)>
5582521c 338
ee7c0467 339=item B<inline_strengthen_slot_value ($instance_structure, $slot_name)>
5582521c 340
24869f62 341=back
342
1a09d9cc 343=head1 AUTHORS
24869f62 344
9fa4d0b4 345Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
346
24869f62 347Stevan Little E<lt>stevan@iinteractive.comE<gt>
348
349=head1 COPYRIGHT AND LICENSE
350
69e3ab0a 351Copyright 2006-2008 by Infinity Interactive, Inc.
24869f62 352
353L<http://www.iinteractive.com>
354
355This library is free software; you can redistribute it and/or modify
8d2d4c67 356it under the same terms as Perl itself.
24869f62 357
84ef30d1 358=cut
5582521c 359