lib/Moose/Cookbook/Basics/Recipe3.pod

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