A little code tidying
[gitmo/Moose.git] / examples / ArrayBasedStorage.pod
1   
2 package # hide the package from PAUSE
3     ArrayBasedStorage::Instance;
4
5 use strict;
6 use warnings;
7 use Scalar::Util qw/refaddr/;
8
9 use Carp 'confess';
10
11 our $VERSION = '0.01';
12 my $unbound = \'empty-slot-value';
13
14 use base 'Class::MOP::Instance';
15
16 sub 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
24 sub create_instance {
25     my $self = shift;
26     my $instance = bless [], $self->_class_name;
27     $self->initialize_all_slots($instance);
28     return $instance;
29 }
30
31 sub clone_instance {
32     my ($self, $instance) = shift;
33     $self->bless_instance_structure([ @$instance ]);
34 }
35
36 # operations on meta instance
37
38 sub get_slot_index_map { (shift)->{'slot_index_map'} }
39
40 sub initialize_slot {
41     my ($self, $instance, $slot_name) = @_;
42     $self->set_slot_value($instance, $slot_name, $unbound);
43 }
44
45 sub deinitialize_slot {
46     my ( $self, $instance, $slot_name ) = @_;
47     $self->set_slot_value($instance, $slot_name, $unbound);
48 }
49
50 sub get_all_slots {
51     my $self = shift;
52     return sort $self->SUPER::get_all_slots;
53 }
54
55 sub 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
62 sub set_slot_value {
63     my ($self, $instance, $slot_name, $value) = @_;
64     $instance->[ $self->{'slot_index_map'}->{$slot_name} ] = $value;
65 }
66
67 sub 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
75 sub is_dependent_on_superclasses { 1 }
76
77 1;
78
79 __END__
80
81 =pod
82
83 =head1 NAME
84
85 ArrayBasedStorage - 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
109 This is a proof of concept using the Instance sub-protocol 
110 which uses ARRAY refs to store the instance data. 
111
112 This is very similar now to the InsideOutClass example, and 
113 in fact, they both share the exact same test suite, with 
114 the only difference being the Instance metaclass they use.
115
116 =head1 AUTHORS
117
118 Stevan Little E<lt>stevan@iinteractive.comE<gt>
119
120 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
121
122 =head1 SEE ALSO
123
124 =head1 COPYRIGHT AND LICENSE
125
126 Copyright 2006-2008 by Infinity Interactive, Inc.
127
128 L<http://www.iinteractive.com>
129
130 This library is free software; you can redistribute it and/or modify
131 it under the same terms as Perl itself. 
132
133 =cut