Have is_class_loaded use the old code from Moose's ClassName type check
[gitmo/Class-MOP.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 = $self->bless_instance_structure([]);
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 1;
76
77 __END__
78
79 =pod
80
81 =head1 NAME
82
83 ArrayBasedStorage - An example of an Array based instance storage 
84
85 =head1 SYNOPSIS
86
87   package Foo;
88   
89   use metaclass (
90     ':instance_metaclass'  => 'ArrayBasedStorage::Instance'
91   );
92   
93   __PACKAGE__->meta->add_attribute('foo' => (
94       reader => 'get_foo',
95       writer => 'set_foo'
96   ));    
97   
98   sub new  {
99       my $class = shift;
100       $class->meta->new_object(@_);
101   } 
102   
103   # now you can just use the class as normal
104
105 =head1 DESCRIPTION
106
107 This is a proof of concept using the Instance sub-protocol 
108 which uses ARRAY refs to store the instance data. 
109
110 This is very similar now to the InsideOutClass example, and 
111 in fact, they both share the exact same test suite, with 
112 the only difference being the Instance metaclass they use.
113
114 =head1 AUTHORS
115
116 Stevan Little E<lt>stevan@iinteractive.comE<gt>
117
118 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
119
120 =head1 SEE ALSO
121
122 =head1 COPYRIGHT AND LICENSE
123
124 Copyright 2006-2008 by Infinity Interactive, Inc.
125
126 L<http://www.iinteractive.com>
127
128 This library is free software; you can redistribute it and/or modify
129 it under the same terms as Perl itself. 
130
131 =cut