X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F200_examples%2F007_Child_Parent_attr_inherit.t;fp=t%2F200_examples%2F007_Child_Parent_attr_inherit.t;h=e41a5688d4e9339cb47be102328fc9a31c38915a;hb=7a50b45027c9f7baad76cfce7f78c822bd38f0a7;hp=0000000000000000000000000000000000000000;hpb=60b5c3be4d0b3bb705df1e8d977f2ce90db6668d;p=gitmo%2FMouse.git diff --git a/t/200_examples/007_Child_Parent_attr_inherit.t b/t/200_examples/007_Child_Parent_attr_inherit.t new file mode 100644 index 0000000..e41a568 --- /dev/null +++ b/t/200_examples/007_Child_Parent_attr_inherit.t @@ -0,0 +1,136 @@ +#!/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 Mouse; + + 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 Mouse; + + 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 + . ')' );