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