hiding package names and adding test plan
[gitmo/Class-MOP.git] / examples / LazyClass.pod
1
2 package # hide the package from PAUSE
3     LazyClass;
4
5 use strict;
6 use warnings;
7
8 use Class::MOP 'meta';
9
10 our $VERSION = '0.01';
11
12 use base 'Class::MOP::Class';
13
14 sub construct_instance {
15     my ($class, %params) = @_;
16     my $instance = {};
17     foreach my $attr (map { $_->{attribute} } $class->compute_all_applicable_attributes()) {
18         # if the attr has an init_arg, use that, otherwise,
19         # use the attributes name itself as the init_arg
20         my $init_arg = $attr->has_init_arg() ? $attr->init_arg() : $attr->name;
21         # try to fetch the init arg from the %params ...
22         my $val;        
23         $val = $params{$init_arg} if exists $params{$init_arg};
24         # now add this to the instance structure
25         # only if we have found a value at all
26         $instance->{$attr->name} = $val if defined $val;
27     }
28     return $instance;    
29 }
30
31 package # hide the package from PAUSE
32     LazyClass::Attribute;
33
34 use strict;
35 use warnings;
36
37 use Class::MOP 'meta';
38
39 our $VERSION = '0.01';
40
41 use base 'Class::MOP::Attribute';
42
43 sub generate_accessor_method {
44     my ($self, $attr_name) = @_;
45     sub {
46         if (scalar(@_) == 2) {
47             $_[0]->{$attr_name} = $_[1];
48         }
49         else {
50             if (!exists $_[0]->{$attr_name}) {
51                 my $attr = $self->associated_class->get_attribute($attr_name);
52                 $_[0]->{$attr_name} = $attr->has_default ? $attr->default($_[0]) : undef;           
53             }            
54             $_[0]->{$attr_name};            
55         }
56     };
57 }
58
59 sub generate_reader_method {
60     my ($self, $attr_name) = @_; 
61     sub {
62         if (!exists $_[0]->{$attr_name}) {
63             my $attr = $self->associated_class->get_attribute($attr_name);
64             $_[0]->{$attr_name} = $attr->has_default ? $attr->default($_[0]) : undef;           
65         }
66         $_[0]->{$attr_name};
67     };   
68 }
69
70 1;
71
72 __END__
73
74 =pod
75
76 =head1 NAME
77
78 LazyClass - An example metaclass with lazy initialization
79
80 =head1 SYNOPSIS
81
82   package BinaryTree;
83   
84   sub meta {
85       LazyClass->initialize($_[0] => (
86           ':attribute_metaclass' => 'LazyClass::Attribute'
87       ));
88   }
89   
90   BinaryTree->meta->add_attribute('$:node' => (
91       accessor => 'node',
92       init_arg => ':node'
93   ));
94   
95   BinaryTree->meta->add_attribute('$:left' => (
96       reader  => 'left',
97       default => sub { BinaryTree->new() }
98   ));
99   
100   BinaryTree->meta->add_attribute('$:right' => (
101       reader  => 'right',
102       default => sub { BinaryTree->new() }    
103   ));    
104   
105   sub new {
106       my $class = shift;
107       bless $class->meta->construct_instance(@_) => $class;
108   }
109   
110   # ... later in code
111   
112   my $btree = BinaryTree->new();
113   # ... $btree is an empty hash, no keys are initialized yet
114
115 =head1 DESCRIPTION
116
117 This is an example metclass in which all attributes are created 
118 lazily. This means that no entries are made in the instance HASH 
119 until the last possible moment. 
120
121 The example above of a binary tree is a good use for such a 
122 metaclass because it allows the class to be space efficient 
123 without complicating the programing of it. This would also be 
124 ideal for a class which has a large amount of attributes, 
125 several of which are optional. 
126
127 =head1 AUTHOR
128
129 Stevan Little E<lt>stevan@iinteractive.comE<gt>
130
131 =head1 COPYRIGHT AND LICENSE
132
133 Copyright 2006 by Infinity Interactive, Inc.
134
135 L<http://www.iinteractive.com>
136
137 This library is free software; you can redistribute it and/or modify
138 it under the same terms as Perl itself.
139
140 =cut