6 Moose::Cookbook::Basics::Recipe3 - A lazy B<BinaryTree> example
13 has 'node' => ( is => 'rw', isa => 'Any' );
18 predicate => 'has_parent',
25 predicate => 'has_left',
27 default => sub { BinaryTree->new( parent => $_[0] ) },
28 trigger => \&_set_parent_for_child
34 predicate => 'has_right',
36 default => sub { BinaryTree->new( parent => $_[0] ) },
37 trigger => \&_set_parent_for_child
40 sub _set_parent_for_child {
41 my ( $self, $child ) = @_;
43 confess "You cannot insert a tree which already has a parent"
44 if $child->has_parent;
46 $child->parent($self);
51 This recipe shows how various advanced attribute features can be used
52 to create complex and powerful behaviors. In particular, we introduce
53 a number of new attribute options, including C<predicate>, C<lazy>,
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>.
61 Let's take a look at the C<node> attribute:
63 has 'node' => ( is => 'rw', isa => 'Any' );
65 Moose generates a read-write accessor for this attribute. The type
66 constraint is C<Any>, which literally means it can contain anything.
68 We could have left out the C<isa> option, but in this case, we are
69 including it for the benefit of other programmers, not the computer.
71 Next, let's move on to the C<parent> attribute:
76 predicate => 'has_parent',
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
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>.
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.
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
104 predicate => 'has_left',
106 default => sub { BinaryTree->new( parent => $_[0] ) },
107 trigger => \&_set_parent_for_child
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
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.
124 As a workaround, we use an anonymous subroutine to generate a new
125 reference every time the default is called.
127 has 'foo' => ( is => 'rw', default => sub { [] } );
129 In fact, using a non-subroutine reference as a default is illegal in Moose.
132 has 'foo' => ( is => 'rw', default => [] );
134 This will blow up, so don't do it.
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
140 In our case, we're making a new C<BinaryTree> object in our default,
141 with the current tree as the parent.
143 Normally, when an object is instantiated, any defaults are evaluated
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>
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.
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.
159 We could write our own accessors, but then why use Moose at all?
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>.
166 sub _set_parent_for_child {
167 my ( $self, $child ) = @_;
169 confess "You cannot insert a tree which already has a parent"
170 if $child->has_parent;
172 $child->parent($self);
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.
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.
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
185 in F<t/000_recipes/moose_cookbook_basics_recipe3.t>.
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.
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.
205 In short, don't use them unless you know what you are doing :)
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.
212 Also, you can use C<builder> instead of C<default>. See
213 L<Moose::Cookbook::Basics::Recipe8> for details.
219 Stevan Little E<lt>stevan@iinteractive.comE<gt>
221 Dave Rolsky E<lt>autarch@urth.orgE<gt>
223 =head1 COPYRIGHT AND LICENSE
225 Copyright 2006-2010 by Infinity Interactive, Inc.
227 L<http://www.iinteractive.com>
229 This library is free software; you can redistribute it and/or modify
230 it under the same terms as Perl itself.
234 use Scalar::Util 'isweak';
236 my $root = BinaryTree->new(node => 'root');
237 isa_ok($root, 'BinaryTree');
239 is($root->node, 'root', '... got the right node value');
241 ok(!$root->has_left, '... no left node yet');
242 ok(!$root->has_right, '... no right node yet');
244 ok(!$root->has_parent, '... no parent for root node');
248 my $left = $root->left;
249 isa_ok($left, 'BinaryTree');
251 is($root->left, $left, '... got the same node (and it is $left)');
252 ok($root->has_left, '... we have a left node now');
254 ok($left->has_parent, '... lefts has a parent');
255 is($left->parent, $root, '... lefts parent is the root');
257 ok(isweak($left->{parent}), '... parent is a weakened ref');
259 ok(!$left->has_left, '... $left no left node yet');
260 ok(!$left->has_right, '... $left no right node yet');
262 is($left->node, undef, '... left has got no node value');
266 } '... assign to lefts node';
268 is($left->node, 'left', '... left now has a node value');
272 ok(!$root->has_right, '... still no right node yet');
274 is($root->right->node, undef, '... right has got no node value');
276 ok($root->has_right, '... now we have a right node');
278 my $right = $root->right;
279 isa_ok($right, 'BinaryTree');
282 $right->node('right')
283 } '... assign to rights node';
285 is($right->node, 'right', '... left now has a node value');
287 is($root->right, $right, '... got the same node (and it is $right)');
288 ok($root->has_right, '... we have a right node now');
290 ok($right->has_parent, '... rights has a parent');
291 is($right->parent, $root, '... rights parent is the root');
293 ok(isweak($right->{parent}), '... parent is a weakened ref');
295 # make a left node of the left node
297 my $left_left = $left->left;
298 isa_ok($left_left, 'BinaryTree');
300 ok($left_left->has_parent, '... left does have a parent');
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)');
306 ok(isweak($left_left->{parent}), '... parent is a weakened ref');
308 # make a right node of the left node
310 my $left_right = BinaryTree->new;
311 isa_ok($left_right, 'BinaryTree');
314 $left->right($left_right)
315 } '... assign to rights node';
317 ok($left_right->has_parent, '... left does have a parent');
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)');
323 ok(isweak($left_right->{parent}), '... parent is a weakened ref');
325 # and check the error
328 $left_right->right($left_left)
329 } '... cant assign a node which already has a parent';