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