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