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 literally means it can contain anything.
  67
  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.
  70
  71 Next, let's move on to the C<parent> attribute:
  72
  73   has 'parent' => (
  74       is        => 'rw',
  75       isa       => 'BinaryTree',
  76       predicate => 'has_parent',
  77       weak_ref  => 1,
  78   );
  79
  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.
  85
  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>.
  89
  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.
  96
  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>:
 100
 101   has 'left' => (
 102       is        => 'rw',
 103       isa       => 'BinaryTree',
 104       predicate => 'has_left',
 105       lazy      => 1,
 106       default   => sub { BinaryTree->new( parent => $_[0] ) },
 107       trigger   => \&_set_parent_for_child
 108   );
 109
 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)
 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.
 123
 124 As a workaround, we use an anonymous subroutine to generate a new
 125 reference every time the default is called.
 126
 127   has 'foo' => ( is => 'rw', default => sub { [] } );
 128
 129 In fact, using a non-subroutine reference as a default is illegal in Moose.
 130
 131   # will fail
 132   has 'foo' => ( is => 'rw', default => [] );
 133
 134 This will blow up, so don't do it.
 135
 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
 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>
 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.
 158
 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>.
 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.
 182
 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>.
 186
 187 =head1 CONCLUSION
 188
 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.
 192
 193 =head1 FOOTNOTES
 194
 195 =over 4
 196
 197 =item (1)
 198
 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.
 204
 205 In short, don't use them unless you know what you are doing :)
 206
 207 =item (2)
 208
 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.
 211
 212 Also, you can use C<builder> instead of C<default>. See
 213 L<Moose::Cookbook::Basics::Recipe8> for details.
 214
 215 =back
 216
 217 =head1 AUTHORS
 218
 219 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 220
 221 Dave Rolsky E<lt>autarch@urth.orgE<gt>
 222
 223 =head1 COPYRIGHT AND LICENSE
 224
 225 Copyright 2006-2009 by Infinity Interactive, Inc.
 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
 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
 333 =cut