t/200_examples/0071_Child_Parent_attr_inherit_imm.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 23;
   7
   8 =pod
   9
  10 Some examples of triggers and how they can
  11 be used to manage parent-child relationships.
  12
  13 =cut
  14
  15 {
  16
  17     package Parent;
  18     use Mouse;
  19
  20     has 'last_name' => (
  21         is      => 'rw',
  22         isa     => 'Str',
  23         trigger => sub {
  24             my $self = shift;
  25
  26             # if the parents last-name changes
  27             # then so do all the childrens
  28             foreach my $child ( @{ $self->children } ) {
  29                 $child->last_name( $self->last_name );
  30             }
  31         }
  32     );
  33
  34     has 'children' =>
  35         ( is => 'rw', isa => 'ArrayRef', default => sub { [] } );
  36     __PACKAGE__->meta->make_immutable();
  37 }
  38 {
  39
  40     package Child;
  41     use Mouse;
  42
  43     has 'parent' => (
  44         is       => 'rw',
  45         isa      => 'Parent',
  46         required => 1,
  47         trigger  => sub {
  48             my $self = shift;
  49
  50             # if the parent is changed,..
  51             # make sure we update
  52             $self->last_name( $self->parent->last_name );
  53         }
  54     );
  55
  56     has 'last_name' => (
  57         is      => 'rw',
  58         isa     => 'Str',
  59         lazy    => 1,
  60         default => sub { (shift)->parent->last_name }
  61     );
  62     __PACKAGE__->meta->make_immutable();
  63 }
  64
  65 my $parent = Parent->new( last_name => 'Smith' );
  66 isa_ok( $parent, 'Parent' );
  67
  68 is( $parent->last_name, 'Smith',
  69     '... the parent has the last name we expected' );
  70
  71 $parent->children( [ map { Child->new( parent => $parent ) } ( 0 .. 3 ) ] );
  72
  73 foreach my $child ( @{ $parent->children } ) {
  74     is( $child->last_name, $parent->last_name,
  75               '... parent and child have the same last name ('
  76             . $parent->last_name
  77             . ')' );
  78 }
  79
  80 $parent->last_name('Jones');
  81 is( $parent->last_name, 'Jones', '... the parent has the new last name' );
  82
  83 foreach my $child ( @{ $parent->children } ) {
  84     is( $child->last_name, $parent->last_name,
  85               '... parent and child have the same last name ('
  86             . $parent->last_name
  87             . ')' );
  88 }
  89
  90 # make a new parent
  91
  92 my $parent2 = Parent->new( last_name => 'Brown' );
  93 isa_ok( $parent2, 'Parent' );
  94
  95 # orphan the child
  96
  97 my $orphan = pop @{ $parent->children };
  98
  99 # and then the new parent adopts it
 100
 101 $orphan->parent($parent2);
 102
 103 foreach my $child ( @{ $parent->children } ) {
 104     is( $child->last_name, $parent->last_name,
 105               '... parent and child have the same last name ('
 106             . $parent->last_name
 107             . ')' );
 108 }
 109
 110 isnt( $orphan->last_name, $parent->last_name,
 111           '... the orphan child does not have the same last name anymore ('
 112         . $parent2->last_name
 113         . ')' );
 114 is( $orphan->last_name, $parent2->last_name,
 115           '... parent2 and orphan child have the same last name ('
 116         . $parent2->last_name
 117         . ')' );
 118
 119 # make sure that changes still will not propagate
 120
 121 $parent->last_name('Miller');
 122 is( $parent->last_name, 'Miller',
 123     '... the parent has the new last name (again)' );
 124
 125 foreach my $child ( @{ $parent->children } ) {
 126     is( $child->last_name, $parent->last_name,
 127               '... parent and child have the same last name ('
 128             . $parent->last_name
 129             . ')' );
 130 }
 131
 132 isnt( $orphan->last_name, $parent->last_name,
 133     '... the orphan child is not affected by changes in the parent anymore' );
 134 is( $orphan->last_name, $parent2->last_name,
 135           '... parent2 and orphan child have the same last name ('
 136         . $parent2->last_name
 137         . ')' );