Expect a meta class for UNIVERSAL
[gitmo/Moose.git] / examples / ArrayBasedStorage.pod
CommitLineData
38bf2a25 1
2package # hide the package from PAUSE
3 ArrayBasedStorage::Instance;
4
5use strict;
6use warnings;
7use Scalar::Util qw/refaddr/;
8
9use Carp 'confess';
10
11our $VERSION = '0.01';
12my $unbound = \'empty-slot-value';
13
14use base 'Class::MOP::Instance';
15
16sub new {
17 my ($class, $meta, @attrs) = @_;
18 my $self = $class->SUPER::new($meta, @attrs);
19 my $index = 0;
20 $self->{'slot_index_map'} = { map { $_ => $index++ } $self->get_all_slots };
21 return $self;
22}
23
24sub create_instance {
25 my $self = shift;
26 my $instance = bless [], $self->_class_name;
27 $self->initialize_all_slots($instance);
28 return $instance;
29}
30
31sub clone_instance {
32 my ($self, $instance) = shift;
33 $self->bless_instance_structure([ @$instance ]);
34}
35
36# operations on meta instance
37
38sub get_slot_index_map { (shift)->{'slot_index_map'} }
39
40sub initialize_slot {
41 my ($self, $instance, $slot_name) = @_;
42 $self->set_slot_value($instance, $slot_name, $unbound);
43}
44
45sub deinitialize_slot {
46 my ( $self, $instance, $slot_name ) = @_;
47 $self->set_slot_value($instance, $slot_name, $unbound);
48}
49
50sub get_all_slots {
51 my $self = shift;
52 return sort $self->SUPER::get_all_slots;
53}
54
55sub get_slot_value {
56 my ($self, $instance, $slot_name) = @_;
57 my $value = $instance->[ $self->{'slot_index_map'}->{$slot_name} ];
58 return $value unless ref $value;
59 refaddr $value eq refaddr $unbound ? undef : $value;
60}
61
62sub set_slot_value {
63 my ($self, $instance, $slot_name, $value) = @_;
64 $instance->[ $self->{'slot_index_map'}->{$slot_name} ] = $value;
65}
66
67sub is_slot_initialized {
68 my ($self, $instance, $slot_name) = @_;
69 # NOTE: maybe use CLOS's *special-unbound-value* for this?
70 my $value = $instance->[ $self->{'slot_index_map'}->{$slot_name} ];
71 return 1 unless ref $value;
72 refaddr $value eq refaddr $unbound ? 0 : 1;
73}
74
75sub is_dependent_on_superclasses { 1 }
76
771;
78
79__END__
80
81=pod
82
83=head1 NAME
84
85ArrayBasedStorage - An example of an Array based instance storage
86
87=head1 SYNOPSIS
88
89 package Foo;
90
91 use metaclass (
92 ':instance_metaclass' => 'ArrayBasedStorage::Instance'
93 );
94
95 __PACKAGE__->meta->add_attribute('foo' => (
96 reader => 'get_foo',
97 writer => 'set_foo'
98 ));
99
100 sub new {
101 my $class = shift;
102 $class->meta->new_object(@_);
103 }
104
105 # now you can just use the class as normal
106
107=head1 DESCRIPTION
108
109This is a proof of concept using the Instance sub-protocol
110which uses ARRAY refs to store the instance data.
111
112This is very similar now to the InsideOutClass example, and
113in fact, they both share the exact same test suite, with
114the only difference being the Instance metaclass they use.
115
116=head1 AUTHORS
117
118Stevan Little E<lt>stevan@iinteractive.comE<gt>
119
120Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
121
122=head1 SEE ALSO
123
124=head1 COPYRIGHT AND LICENSE
125
126Copyright 2006-2008 by Infinity Interactive, Inc.
127
128L<http://www.iinteractive.com>
129
130This library is free software; you can redistribute it and/or modify
131it under the same terms as Perl itself.
132
133=cut