Add a .shipit file

[gitmo/Moose.git] / t / 200_examples / 007_Child_Parent_attr_inherit.t

#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 23;

=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 . ')');