Add a test file

diff --git a/t/200_examples/0071_Child_Parent_attr_inherit_imm.t b/t/200_examples/0071_Child_Parent_attr_inherit_imm.t
new file mode 100644 (file)
index 0000000..4a5a3bd
--- /dev/null
+++ b/t/200_examples/0071_Child_Parent_attr_inherit_imm.t
@@ -0,0 +1,137 @@
+#!/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__->meta->make_immutable();
+}
+{
+
+    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 }
+    );
+    __PACKAGE__->meta->make_immutable();
+}
+
+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
+        . ')' );