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