1 package Moose::Cookbook::Basics::Recipe3;
3 # ABSTRACT: A lazy B<BinaryTree> example
15 has 'node' => ( is => 'rw', isa => 'Any' );
20 predicate => 'has_parent',
27 predicate => 'has_left',
29 default => sub { BinaryTree->new( parent => $_[0] ) },
30 trigger => \&_set_parent_for_child
36 predicate => 'has_right',
38 default => sub { BinaryTree->new( parent => $_[0] ) },
39 trigger => \&_set_parent_for_child
42 sub _set_parent_for_child {
43 my ( $self, $child ) = @_;
45 confess "You cannot insert a tree which already has a parent"
46 if $child->has_parent;
48 $child->parent($self);
53 This recipe shows how various advanced attribute features can be used
54 to create complex and powerful behaviors. In particular, we introduce
55 a number of new attribute options, including C<predicate>, C<lazy>,
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>.
63 Let's take a look at the C<node> attribute:
65 has 'node' => ( is => 'rw', isa => 'Any' );
67 Moose generates a read-write accessor for this attribute. The type
68 constraint is C<Any>, which literally means it can contain anything.
70 We could have left out the C<isa> option, but in this case, we are
71 including it for the benefit of other programmers, not the computer.
73 Next, let's move on to the C<parent> attribute:
78 predicate => 'has_parent',
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
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>.
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.
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
106 predicate => 'has_left',
108 default => sub { BinaryTree->new( parent => $_[0] ) },
109 trigger => \&_set_parent_for_child
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
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,
122 instead simply copying the reference. If you just specified a simple
123 reference for a default, Perl would create it once and it would be
124 shared by all objects with that attribute.
126 As a workaround, we use an anonymous subroutine to generate a new
127 reference every time the default is called.
129 has 'foo' => ( is => 'rw', default => sub { [] } );
131 In fact, using a non-subroutine reference as a default is illegal in Moose.
134 has 'foo' => ( is => 'rw', default => [] );
136 This will blow up, so don't do it.
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
142 In our case, we're making a new C<BinaryTree> object in our default,
143 with the current tree as the parent.
145 Normally, when an object is instantiated, any defaults are evaluated
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>
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.
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.
161 We could write our own accessors, but then why use Moose at all?
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>.
168 sub _set_parent_for_child {
169 my ( $self, $child ) = @_;
171 confess "You cannot insert a tree which already has a parent"
172 if $child->has_parent;
174 $child->parent($self);
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.
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.
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
187 in F<t/recipes/moose_cookbook_basics_recipe3.t>.
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.
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.
207 In short, don't use them unless you know what you are doing :)
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.
214 Also, you can use C<builder> instead of C<default>. See
215 L<Moose::Cookbook::Basics::Recipe8> for details.
221 use Scalar::Util 'isweak';
223 my $root = BinaryTree->new(node => 'root');
224 isa_ok($root, 'BinaryTree');
226 is($root->node, 'root', '... got the right node value');
228 ok(!$root->has_left, '... no left node yet');
229 ok(!$root->has_right, '... no right node yet');
231 ok(!$root->has_parent, '... no parent for root node');
235 my $left = $root->left;
236 isa_ok($left, 'BinaryTree');
238 is($root->left, $left, '... got the same node (and it is $left)');
239 ok($root->has_left, '... we have a left node now');
241 ok($left->has_parent, '... lefts has a parent');
242 is($left->parent, $root, '... lefts parent is the root');
244 ok(isweak($left->{parent}), '... parent is a weakened ref');
246 ok(!$left->has_left, '... $left no left node yet');
247 ok(!$left->has_right, '... $left no right node yet');
249 is($left->node, undef, '... left has got no node value');
256 '... assign to lefts node'
259 is($left->node, 'left', '... left now has a node value');
263 ok(!$root->has_right, '... still no right node yet');
265 is($root->right->node, undef, '... right has got no node value');
267 ok($root->has_right, '... now we have a right node');
269 my $right = $root->right;
270 isa_ok($right, 'BinaryTree');
274 $right->node('right');
277 '... assign to rights node'
280 is($right->node, 'right', '... left now has a node value');
282 is($root->right, $right, '... got the same node (and it is $right)');
283 ok($root->has_right, '... we have a right node now');
285 ok($right->has_parent, '... rights has a parent');
286 is($right->parent, $root, '... rights parent is the root');
288 ok(isweak($right->{parent}), '... parent is a weakened ref');
290 # make a left node of the left node
292 my $left_left = $left->left;
293 isa_ok($left_left, 'BinaryTree');
295 ok($left_left->has_parent, '... left does have a parent');
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)');
301 ok(isweak($left_left->{parent}), '... parent is a weakened ref');
303 # make a right node of the left node
305 my $left_right = BinaryTree->new;
306 isa_ok($left_right, 'BinaryTree');
310 $left->right($left_right);
313 '... assign to rights node'
316 ok($left_right->has_parent, '... left does have a parent');
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)');
322 ok(isweak($left_right->{parent}), '... parent is a weakened ref');
324 # and check the error
328 $left_right->right($left_left);
331 '... cannot assign a node which already has a parent'