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