1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
#!/usr/bin/perl
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;
|
