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