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