Commit | Line | Data |
471c4f09 |
1 | |
2 | =pod |
3 | |
4 | =head1 NAME |
5 | |
021b8139 |
6 | Moose::Cookbook::Basics::Recipe3 - A lazy B<BinaryTree> example |
471c4f09 |
7 | |
8 | =head1 SYNOPSIS |
9 | |
10 | package BinaryTree; |
471c4f09 |
11 | use Moose; |
c765b254 |
12 | |
13 | has 'node' => ( is => 'rw', isa => 'Any' ); |
14 | |
471c4f09 |
15 | has 'parent' => ( |
8597d950 |
16 | is => 'rw', |
c765b254 |
17 | isa => 'BinaryTree', |
471c4f09 |
18 | predicate => 'has_parent', |
8597d950 |
19 | weak_ref => 1, |
471c4f09 |
20 | ); |
c765b254 |
21 | |
471c4f09 |
22 | has 'left' => ( |
c765b254 |
23 | is => 'rw', |
24 | isa => 'BinaryTree', |
25 | predicate => 'has_left', |
7c6cacb4 |
26 | lazy => 1, |
c765b254 |
27 | default => sub { BinaryTree->new( parent => $_[0] ) }, |
0fde1850 |
28 | trigger => \&_set_parent_for_child |
471c4f09 |
29 | ); |
c765b254 |
30 | |
471c4f09 |
31 | has 'right' => ( |
c765b254 |
32 | is => 'rw', |
33 | isa => 'BinaryTree', |
34 | predicate => 'has_right', |
35 | lazy => 1, |
36 | default => sub { BinaryTree->new( parent => $_[0] ) }, |
0fde1850 |
37 | trigger => \&_set_parent_for_child |
471c4f09 |
38 | ); |
c765b254 |
39 | |
0fde1850 |
40 | sub _set_parent_for_child { |
41 | my ( $self, $child ) = @_; |
42 | |
43 | confess "You cannot insert a tree which already has a parent" |
44 | if $child->has_parent; |
45 | |
46 | $child->parent($self); |
47 | } |
471c4f09 |
48 | |
49 | =head1 DESCRIPTION |
50 | |
f6f9ec6a |
51 | This recipe shows how various advanced attribute features can be used |
0fde1850 |
52 | to create complex and powerful behaviors. In particular, we introduce |
53 | a number of new attribute options, including C<predicate>, C<lazy>, |
54 | and C<trigger>. |
8597d950 |
55 | |
f6f9ec6a |
56 | The example class is a classic binary tree. Each node in the tree is |
57 | itself an instance of C<BinaryTree>. It has a C<node>, which holds |
58 | some arbitrary value. It has C<right> and C<left> attributes, which |
59 | refer to its child trees, and a C<parent>. |
8597d950 |
60 | |
f6f9ec6a |
61 | Let's take a look at the C<node> attribute: |
8597d950 |
62 | |
c765b254 |
63 | has 'node' => ( is => 'rw', isa => 'Any' ); |
8597d950 |
64 | |
f6f9ec6a |
65 | Moose generates a read-write accessor for this attribute. The type |
ac4b3ad4 |
66 | constraint is C<Any>, which literally means it can contain anything. |
455ca293 |
67 | |
f6f9ec6a |
68 | We could have left out the C<isa> option, but in this case, we are |
19320607 |
69 | including it for the benefit of other programmers, not the computer. |
f6f9ec6a |
70 | |
71 | Next, let's move on to the C<parent> attribute: |
8597d950 |
72 | |
73 | has 'parent' => ( |
74 | is => 'rw', |
c765b254 |
75 | isa => 'BinaryTree', |
8597d950 |
76 | predicate => 'has_parent', |
77 | weak_ref => 1, |
78 | ); |
79 | |
f6f9ec6a |
80 | Again, we have a read-write accessor. This time, the C<isa> option |
81 | says that this attribute must always be an instance of |
82 | C<BinaryTree>. In the second recipe, we saw that every time we create |
83 | a Moose-based class, we also get a corresponding class type |
84 | constraint. |
8597d950 |
85 | |
f6f9ec6a |
86 | The C<predicate> option is new. It creates a method which can be used |
87 | to check whether or not a given attribute has been initialized. In |
88 | this case, the method is named C<has_parent>. |
8597d950 |
89 | |
f6f9ec6a |
90 | This brings us to our last attribute option, C<weak_ref>. Since |
91 | C<parent> is a circular reference (the tree in C<parent> should |
92 | already have a reference to this one, in its C<left> or C<right> |
93 | attribute), we want to make sure that we weaken the reference to avoid |
94 | memory leaks. If C<weak_ref> is true, it alters the accessor function |
95 | so that the reference is weakened when it is set. |
8597d950 |
96 | |
f6f9ec6a |
97 | Finally, we have the the C<left> and C<right> attributes. They are |
98 | essentially identical except for their names, so we'll just look at |
99 | C<left>: |
8597d950 |
100 | |
101 | has 'left' => ( |
c765b254 |
102 | is => 'rw', |
103 | isa => 'BinaryTree', |
104 | predicate => 'has_left', |
8597d950 |
105 | lazy => 1, |
c765b254 |
106 | default => sub { BinaryTree->new( parent => $_[0] ) }, |
0fde1850 |
107 | trigger => \&_set_parent_for_child |
8597d950 |
108 | ); |
109 | |
0fde1850 |
110 | There are three new options here, C<lazy>, C<default>, and |
111 | C<trigger>. The C<lazy> and C<default> options options are linked. In |
112 | fact, you cannot have a C<lazy> attribute unless it has a C<default> |
113 | (or a C<builder>, but we'll cover that later). If you try to make an |
114 | attribute lazy without a default, class creation will fail with an |
115 | exception. (2) |
f6f9ec6a |
116 | |
117 | In the second recipe the B<BankAccount>'s C<balance> attribute had a |
118 | default value of C<0>. Given a non-reference, Perl copies the |
119 | I<value>. However, given a reference, it does not do a deep clone, |
120 | instead simply copying the reference. If you just specified a simply |
121 | reference for a default, Perl would create it once and it would be |
122 | shared by all objects with that attribute. |
8597d950 |
123 | |
f6f9ec6a |
124 | As a workaround, we use an anonymous subroutine to generate a new |
125 | reference every time the default is called. |
8597d950 |
126 | |
f6f9ec6a |
127 | has 'foo' => ( is => 'rw', default => sub { [] } ); |
128 | |
129 | In fact, using a non-subroutine reference as a default is illegal in Moose. |
8597d950 |
130 | |
0fde1850 |
131 | # will fail |
c765b254 |
132 | has 'foo' => ( is => 'rw', default => [] ); |
8597d950 |
133 | |
f6f9ec6a |
134 | This will blow up, so don't do it. |
8597d950 |
135 | |
f6f9ec6a |
136 | You'll notice that we use C<$_[0]> in our default sub. When the |
137 | default subroutine is executed, it is called as a method on the |
138 | object. |
139 | |
140 | In our case, we're making a new C<BinaryTree> object in our default, |
141 | with the current tree as the parent. |
142 | |
19320607 |
143 | Normally, when an object is instantiated, any defaults are evaluated |
f6f9ec6a |
144 | immediately. With our C<BinaryTree> class, this would be a big |
145 | problem! We'd create the first object, which would immediately try to |
146 | populate its C<left> and C<right> attributes, which would create a new |
147 | C<BinaryTree>, which would populate I<its> C<left> and C<right> |
148 | slots. Kaboom! |
149 | |
150 | By making our C<left> and C<right> attributes C<lazy>, we avoid this |
151 | problem. If the attribute has a value when it is read, the default is |
152 | never executed at all. |
153 | |
154 | We still have one last bit of behavior to add. The autogenerated |
155 | C<right> and C<left> accessors are not quite correct. When one of |
156 | these is set, we want to make sure that we update the parent of the |
157 | C<left> or C<right> attribute's tree. |
8597d950 |
158 | |
f6f9ec6a |
159 | We could write our own accessors, but then why use Moose at all? |
0fde1850 |
160 | Instead, we use a C<trigger>. A C<trigger> accepts a subroutine |
161 | reference, which will be called as a method whenever the attribute is |
162 | set. This can happen both during object construction or later by |
163 | passing a new object to the attribute's accessor method. However, it |
164 | is not called when a value is provided by a C<default> or C<builder>. |
165 | |
166 | sub _set_parent_for_child { |
167 | my ( $self, $child ) = @_; |
168 | |
169 | confess "You cannot insert a tree which already has a parent" |
170 | if $child->has_parent; |
171 | |
172 | $child->parent($self); |
173 | } |
174 | |
175 | This trigger does two things. First, it ensures that the new child |
176 | node does not already have a parent. This is done for the sake of |
177 | simplifying the example. If we wanted to be more clever, we would |
178 | remove the child from its old parent tree and add it to the new one. |
179 | |
180 | If the child has no parent, we will add it to the current tree, and we |
181 | ensure that is has the correct value for its C<parent> attribute. |
9327b01c |
182 | |
f6f9ec6a |
183 | As with all the other recipes, B<BinaryTree> can be used just like any |
184 | other Perl 5 class. A more detailed example of its usage can be found |
c79239a2 |
185 | in F<t/000_recipes/moose_cookbook_basics_recipe3.t>. |
8597d950 |
186 | |
187 | =head1 CONCLUSION |
188 | |
f6f9ec6a |
189 | This recipe introduced several of Moose's advanced features. We hope |
190 | that this inspires you to think of other ways these features can be |
191 | used to simplify your code. |
e08c54f5 |
192 | |
8597d950 |
193 | =head1 FOOTNOTES |
194 | |
195 | =over 4 |
196 | |
197 | =item (1) |
198 | |
f6f9ec6a |
199 | Weak references are tricky things, and should be used sparingly and |
200 | appropriately (such as in the case of circular refs). If you are not |
201 | careful, attribute values could disappear "mysteriously" because |
202 | Perl's reference counting garbage collector has gone and removed the |
203 | item you are weak-referencing. |
8597d950 |
204 | |
205 | In short, don't use them unless you know what you are doing :) |
206 | |
207 | =item (2) |
208 | |
f6f9ec6a |
209 | You I<can> use the C<default> option without the C<lazy> option if you |
210 | like, as we showed in the second recipe. |
8597d950 |
211 | |
f6f9ec6a |
212 | Also, you can use C<builder> instead of C<default>. See |
360c547f |
213 | L<Moose::Cookbook::Basics::Recipe8> for details. |
ceb8945d |
214 | |
8597d950 |
215 | =back |
216 | |
8c3d5c88 |
217 | =head1 AUTHORS |
471c4f09 |
218 | |
219 | Stevan Little E<lt>stevan@iinteractive.comE<gt> |
220 | |
8c3d5c88 |
221 | Dave Rolsky E<lt>autarch@urth.orgE<gt> |
222 | |
471c4f09 |
223 | =head1 COPYRIGHT AND LICENSE |
224 | |
7e0492d3 |
225 | Copyright 2006-2010 by Infinity Interactive, Inc. |
471c4f09 |
226 | |
227 | L<http://www.iinteractive.com> |
228 | |
229 | This library is free software; you can redistribute it and/or modify |
230 | it under the same terms as Perl itself. |
231 | |
c79239a2 |
232 | =begin testing |
233 | |
234 | use Scalar::Util 'isweak'; |
235 | |
236 | my $root = BinaryTree->new(node => 'root'); |
237 | isa_ok($root, 'BinaryTree'); |
238 | |
239 | is($root->node, 'root', '... got the right node value'); |
240 | |
241 | ok(!$root->has_left, '... no left node yet'); |
242 | ok(!$root->has_right, '... no right node yet'); |
243 | |
244 | ok(!$root->has_parent, '... no parent for root node'); |
245 | |
246 | # make a left node |
247 | |
248 | my $left = $root->left; |
249 | isa_ok($left, 'BinaryTree'); |
250 | |
251 | is($root->left, $left, '... got the same node (and it is $left)'); |
252 | ok($root->has_left, '... we have a left node now'); |
253 | |
254 | ok($left->has_parent, '... lefts has a parent'); |
255 | is($left->parent, $root, '... lefts parent is the root'); |
256 | |
257 | ok(isweak($left->{parent}), '... parent is a weakened ref'); |
258 | |
259 | ok(!$left->has_left, '... $left no left node yet'); |
260 | ok(!$left->has_right, '... $left no right node yet'); |
261 | |
262 | is($left->node, undef, '... left has got no node value'); |
263 | |
264 | lives_ok { |
265 | $left->node('left') |
266 | } '... assign to lefts node'; |
267 | |
268 | is($left->node, 'left', '... left now has a node value'); |
269 | |
270 | # make a right node |
271 | |
272 | ok(!$root->has_right, '... still no right node yet'); |
273 | |
274 | is($root->right->node, undef, '... right has got no node value'); |
275 | |
276 | ok($root->has_right, '... now we have a right node'); |
277 | |
278 | my $right = $root->right; |
279 | isa_ok($right, 'BinaryTree'); |
280 | |
281 | lives_ok { |
282 | $right->node('right') |
283 | } '... assign to rights node'; |
284 | |
285 | is($right->node, 'right', '... left now has a node value'); |
286 | |
287 | is($root->right, $right, '... got the same node (and it is $right)'); |
288 | ok($root->has_right, '... we have a right node now'); |
289 | |
290 | ok($right->has_parent, '... rights has a parent'); |
291 | is($right->parent, $root, '... rights parent is the root'); |
292 | |
293 | ok(isweak($right->{parent}), '... parent is a weakened ref'); |
294 | |
295 | # make a left node of the left node |
296 | |
297 | my $left_left = $left->left; |
298 | isa_ok($left_left, 'BinaryTree'); |
299 | |
300 | ok($left_left->has_parent, '... left does have a parent'); |
301 | |
302 | is($left_left->parent, $left, '... got a parent node (and it is $left)'); |
303 | ok($left->has_left, '... we have a left node now'); |
304 | is($left->left, $left_left, '... got a left node (and it is $left_left)'); |
305 | |
306 | ok(isweak($left_left->{parent}), '... parent is a weakened ref'); |
307 | |
308 | # make a right node of the left node |
309 | |
310 | my $left_right = BinaryTree->new; |
311 | isa_ok($left_right, 'BinaryTree'); |
312 | |
313 | lives_ok { |
314 | $left->right($left_right) |
315 | } '... assign to rights node'; |
316 | |
317 | ok($left_right->has_parent, '... left does have a parent'); |
318 | |
319 | is($left_right->parent, $left, '... got a parent node (and it is $left)'); |
320 | ok($left->has_right, '... we have a left node now'); |
321 | is($left->right, $left_right, '... got a left node (and it is $left_left)'); |
322 | |
323 | ok(isweak($left_right->{parent}), '... parent is a weakened ref'); |
324 | |
325 | # and check the error |
326 | |
327 | dies_ok { |
328 | $left_right->right($left_left) |
329 | } '... cant assign a node which already has a parent'; |
330 | |
331 | =end testing |
332 | |
f7522f24 |
333 | =cut |