text: use strict;
  use warnings;
  
  use Test::More;
  
  =pod
  
  Some examples of triggers and how they can
  be used to manage parent-child relationships.
  
  =cut
  
  {
  
      package Parent;
      use Moose;
  
      has 'last_name' => (
          is      => 'rw',
          isa     => 'Str',
          trigger => sub {
              my $self = shift;
  
              # if the parents last-name changes
              # then so do all the childrens
              foreach my $child ( @{ $self->children } ) {
                  $child->last_name( $self->last_name );
              }
          }
      );
  
      has 'children' =>
          ( is => 'rw', isa => 'ArrayRef', default => sub { [] } );
  }
  {
  
      package Child;
      use Moose;
  
      has 'parent' => (
          is       => 'rw',
          isa      => 'Parent',
          required => 1,
          trigger  => sub {
              my $self = shift;
  
              # if the parent is changed,..
              # make sure we update
              $self->last_name( $self->parent->last_name );
          }
      );
  
      has 'last_name' => (
          is      => 'rw',
          isa     => 'Str',
          lazy    => 1,
          default => sub { (shift)->parent->last_name }
      );
  
  }
  
  my $parent = Parent->new( last_name => 'Smith' );
  isa_ok( $parent, 'Parent' );
  
  is( $parent->last_name, 'Smith',
      '... the parent has the last name we expected' );
  
  $parent->children( [ map { Child->new( parent => $parent ) } ( 0 .. 3 ) ] );
  
  foreach my $child ( @{ $parent->children } ) {
      is( $child->last_name, $parent->last_name,
                '... parent and child have the same last name ('
              . $parent->last_name
              . ')' );
  }
  
  $parent->last_name('Jones');
  is( $parent->last_name, 'Jones', '... the parent has the new last name' );
  
  foreach my $child ( @{ $parent->children } ) {
      is( $child->last_name, $parent->last_name,
                '... parent and child have the same last name ('
              . $parent->last_name
              . ')' );
  }
  
  # make a new parent
  
  my $parent2 = Parent->new( last_name => 'Brown' );
  isa_ok( $parent2, 'Parent' );
  
  # orphan the child
  
  my $orphan = pop @{ $parent->children };
  
  # and then the new parent adopts it
  
  $orphan->parent($parent2);
  
  foreach my $child ( @{ $parent->children } ) {
      is( $child->last_name, $parent->last_name,
                '... parent and child have the same last name ('
              . $parent->last_name
              . ')' );
  }
  
  isnt( $orphan->last_name, $parent->last_name,
            '... the orphan child does not have the same last name anymore ('
          . $parent2->last_name
          . ')' );
  is( $orphan->last_name, $parent2->last_name,
            '... parent2 and orphan child have the same last name ('
          . $parent2->last_name
          . ')' );
  
  # make sure that changes still will not propagate
  
  $parent->last_name('Miller');
  is( $parent->last_name, 'Miller',
      '... the parent has the new last name (again)' );
  
  foreach my $child ( @{ $parent->children } ) {
      is( $child->last_name, $parent->last_name,
                '... parent and child have the same last name ('
              . $parent->last_name
              . ')' );
  }
  
  isnt( $orphan->last_name, $parent->last_name,
      '... the orphan child is not affected by changes in the parent anymore' );
  is( $orphan->last_name, $parent2->last_name,
            '... parent2 and orphan child have the same last name ('
          . $parent2->last_name
          . ')' );
  
  done_testing;
  