Remove recipe on providing an alternate base class
[gitmo/Moose.git] / examples / LazyClass.pod
1
2 package # hide the package from PAUSE
3     LazyClass::Attribute;
4
5 use strict;
6 use warnings;
7
8 use Carp 'confess';
9
10 our $VERSION = '0.05';
11
12 use base 'Class::MOP::Attribute';
13
14 sub initialize_instance_slot {
15     my ($self, $meta_instance, $instance, $params) = @_;
16
17     # if the attr has an init_arg, use that, otherwise,
18     # use the attributes name itself as the init_arg
19     my $init_arg = $self->init_arg();
20
21         if ( exists $params->{$init_arg} ) {
22                 my $val = $params->{$init_arg};
23                 $meta_instance->set_slot_value($instance, $self->name, $val);
24         }
25 }
26
27 sub accessor_metaclass { 'LazyClass::Method::Accessor' }
28
29 package # hide the package from PAUSE
30     LazyClass::Method::Accessor;
31
32 use strict;
33 use warnings;
34
35 use Carp 'confess';
36
37 our $VERSION = '0.01';
38
39 use base 'Class::MOP::Method::Accessor';
40
41 sub _generate_accessor_method {
42     my $attr = (shift)->associated_attribute;
43
44         my $attr_name = $attr->name;
45         my $meta_instance = $attr->associated_class->get_meta_instance;
46
47     sub {
48         if (scalar(@_) == 2) {
49                         $meta_instance->set_slot_value($_[0], $attr_name, $_[1]);
50         }
51         else {
52                         unless ( $meta_instance->is_slot_initialized($_[0], $attr_name) ) {
53                                 my $value = $attr->has_default ? $attr->default($_[0]) : undef;
54                                 $meta_instance->set_slot_value($_[0], $attr_name, $value);
55             }
56
57             $meta_instance->get_slot_value($_[0], $attr_name);
58         }
59     };
60 }
61
62 sub _generate_reader_method {
63     my $attr = (shift)->associated_attribute;
64
65         my $attr_name = $attr->name;
66         my $meta_instance = $attr->associated_class->get_meta_instance;
67
68     sub {
69         confess "Cannot assign a value to a read-only accessor" if @_ > 1;        
70
71                 unless ( $meta_instance->is_slot_initialized($_[0], $attr_name) ) {
72                         my $value = $attr->has_default ? $attr->default($_[0]) : undef;
73                         $meta_instance->set_slot_value($_[0], $attr_name, $value);
74                 }
75
76                 $meta_instance->get_slot_value($_[0], $attr_name);
77     };   
78 }
79
80 package # hide the package from PAUSE
81     LazyClass::Instance;
82
83 use strict;
84 use warnings;
85
86 our $VERSION = '0.01';
87
88 use base 'Class::MOP::Instance';
89
90 sub initialize_all_slots {}
91
92 1;
93
94 __END__
95
96 =pod
97
98 =head1 NAME
99
100 LazyClass - An example metaclass with lazy initialization
101
102 =head1 SYNOPSIS
103
104   package BinaryTree;
105   
106   use metaclass (
107       ':attribute_metaclass' => 'LazyClass::Attribute',
108       ':instance_metaclass'  => 'LazyClass::Instance',      
109   );
110   
111   BinaryTree->meta->add_attribute('node' => (
112       accessor => 'node',
113       init_arg => ':node'
114   ));
115   
116   BinaryTree->meta->add_attribute('left' => (
117       reader  => 'left',
118       default => sub { BinaryTree->new() }
119   ));
120   
121   BinaryTree->meta->add_attribute('right' => (
122       reader  => 'right',
123       default => sub { BinaryTree->new() }    
124   ));    
125   
126   sub new  {
127       my $class = shift;
128       $class->meta->new_object(@_);
129   }
130   
131   # ... later in code
132   
133   my $btree = BinaryTree->new();
134   # ... $btree is an empty hash, no keys are initialized yet
135
136 =head1 DESCRIPTION
137
138 This is an example metclass in which all attributes are created 
139 lazily. This means that no entries are made in the instance HASH 
140 until the last possible moment. 
141
142 The example above of a binary tree is a good use for such a 
143 metaclass because it allows the class to be space efficient 
144 without complicating the programing of it. This would also be 
145 ideal for a class which has a large amount of attributes, 
146 several of which are optional. 
147
148 =head1 AUTHORS
149
150 Stevan Little E<lt>stevan@iinteractive.comE<gt>
151
152 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
153
154 =head1 COPYRIGHT AND LICENSE
155
156 Copyright 2006-2008 by Infinity Interactive, Inc.
157
158 L<http://www.iinteractive.com>
159
160 This library is free software; you can redistribute it and/or modify
161 it under the same terms as Perl itself.
162
163 =cut