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