Commit | Line | Data |
5569c072 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
51c5e0fb |
6 | use Test::More; |
7 | |
8 | BEGIN { |
9 | eval "use Regexp::Common; use Locale::US;"; |
10 | plan skip_all => "Regexp::Common & Locale::US required for this test" if $@; |
ad5ed80c |
11 | plan tests => 81; |
51c5e0fb |
12 | } |
13 | |
5569c072 |
14 | use Test::Exception; |
51c5e0fb |
15 | use Scalar::Util 'isweak'; |
16 | |
5569c072 |
17 | BEGIN { |
18 | use_ok('Moose'); |
19 | } |
20 | |
21 | { |
22 | package Address; |
5569c072 |
23 | use Moose; |
05d9eaf6 |
24 | use Moose::Util::TypeConstraints; |
5569c072 |
25 | |
26 | use Locale::US; |
27 | use Regexp::Common 'zip'; |
28 | |
29 | my $STATES = Locale::US->new; |
30 | |
31 | subtype USState |
32 | => as Str |
33 | => where { |
34 | (exists $STATES->{code2state}{uc($_)} || exists $STATES->{state2code}{uc($_)}) |
35 | }; |
36 | |
37 | subtype USZipCode |
38 | => as Value |
39 | => where { |
40 | /^$RE{zip}{US}{-extended => 'allow'}$/ |
41 | }; |
42 | |
182134e8 |
43 | has 'street' => (is => 'rw', isa => 'Str'); |
44 | has 'city' => (is => 'rw', isa => 'Str'); |
45 | has 'state' => (is => 'rw', isa => 'USState'); |
46 | has 'zip_code' => (is => 'rw', isa => 'USZipCode'); |
5569c072 |
47 | |
5cf3dbcf |
48 | __PACKAGE__->meta->make_immutable(debug => 0); |
49 | }{ |
50 | |
5569c072 |
51 | package Company; |
5569c072 |
52 | use Moose; |
05d9eaf6 |
53 | use Moose::Util::TypeConstraints; |
5569c072 |
54 | |
7c6cacb4 |
55 | has 'name' => (is => 'rw', isa => 'Str', required => 1); |
5569c072 |
56 | has 'address' => (is => 'rw', isa => 'Address'); |
57 | has 'employees' => (is => 'rw', isa => subtype ArrayRef => where { |
ad5ed80c |
58 | (blessed($_) && $_->isa('Employee') || return) for @$_; 1 |
5569c072 |
59 | }); |
60 | |
61 | sub BUILD { |
d7f17ebb |
62 | my ($self, $params) = @_; |
63 | if ($params->{employees}) { |
64 | foreach my $employee (@{$params->{employees}}) { |
5569c072 |
65 | $employee->company($self); |
66 | } |
67 | } |
68 | } |
69 | |
70 | sub get_employee_count { scalar @{(shift)->employees} } |
71 | |
ad5ed80c |
72 | after 'employees' => sub { |
73 | my ($self, $employees) = @_; |
74 | # if employees is defined, it |
75 | # has already been type checked |
76 | if (defined $employees) { |
77 | # make sure each gets the |
78 | # weak ref to the company |
79 | foreach my $employee (@{$employees}) { |
80 | $employee->company($self); |
81 | } |
82 | } |
83 | }; |
84 | |
5cf3dbcf |
85 | __PACKAGE__->meta->make_immutable(debug => 0); |
86 | }{ |
87 | |
5569c072 |
88 | package Person; |
5569c072 |
89 | use Moose; |
90 | |
7c6cacb4 |
91 | has 'first_name' => (is => 'rw', isa => 'Str', required => 1); |
92 | has 'last_name' => (is => 'rw', isa => 'Str', required => 1); |
182134e8 |
93 | has 'middle_initial' => (is => 'rw', isa => 'Str', predicate => 'has_middle_initial'); |
5569c072 |
94 | has 'address' => (is => 'rw', isa => 'Address'); |
95 | |
96 | sub full_name { |
97 | my $self = shift; |
98 | return $self->first_name . |
99 | ($self->has_middle_initial ? ' ' . $self->middle_initial . '. ' : ' ') . |
100 | $self->last_name; |
101 | } |
5cf3dbcf |
102 | |
103 | __PACKAGE__->meta->make_immutable(debug => 0); |
104 | }{ |
5569c072 |
105 | |
106 | package Employee; |
5569c072 |
107 | use Moose; |
108 | |
109 | extends 'Person'; |
110 | |
7c6cacb4 |
111 | has 'title' => (is => 'rw', isa => 'Str', required => 1); |
5569c072 |
112 | has 'company' => (is => 'rw', isa => 'Company', weak_ref => 1); |
b6fe348f |
113 | |
114 | override 'full_name' => sub { |
115 | my $self = shift; |
116 | super() . ', ' . $self->title |
117 | }; |
5cf3dbcf |
118 | |
119 | __PACKAGE__->meta->make_immutable(debug => 0); |
5569c072 |
120 | } |
121 | |
122 | my $ii; |
123 | lives_ok { |
05d9eaf6 |
124 | $ii = Company->new({ |
5569c072 |
125 | name => 'Infinity Interactive', |
126 | address => Address->new( |
127 | street => '565 Plandome Rd., Suite 307', |
128 | city => 'Manhasset', |
129 | state => 'NY', |
130 | zip_code => '11030' |
131 | ), |
132 | employees => [ |
133 | Employee->new( |
134 | first_name => 'Jeremy', |
135 | last_name => 'Shao', |
136 | title => 'President / Senior Consultant', |
137 | address => Address->new(city => 'Manhasset', state => 'NY') |
138 | ), |
139 | Employee->new( |
140 | first_name => 'Tommy', |
141 | last_name => 'Lee', |
142 | title => 'Vice President / Senior Developer', |
143 | address => Address->new(city => 'New York', state => 'NY') |
144 | ), |
145 | Employee->new( |
146 | first_name => 'Stevan', |
147 | middle_initial => 'C', |
148 | last_name => 'Little', |
149 | title => 'Senior Developer', |
150 | address => Address->new(city => 'Madison', state => 'CT') |
151 | ), |
152 | Employee->new( |
153 | first_name => 'Rob', |
154 | last_name => 'Kinyon', |
155 | title => 'Developer', |
156 | address => Address->new(city => 'Marysville', state => 'OH') |
157 | ), |
158 | ] |
05d9eaf6 |
159 | }); |
5569c072 |
160 | } '... created the entire company successfully'; |
161 | isa_ok($ii, 'Company'); |
162 | |
163 | is($ii->name, 'Infinity Interactive', '... got the right name for the company'); |
164 | |
165 | isa_ok($ii->address, 'Address'); |
166 | is($ii->address->street, '565 Plandome Rd., Suite 307', '... got the right street address'); |
167 | is($ii->address->city, 'Manhasset', '... got the right city'); |
168 | is($ii->address->state, 'NY', '... got the right state'); |
169 | is($ii->address->zip_code, 11030, '... got the zip code'); |
170 | |
171 | is($ii->get_employee_count, 4, '... got the right employee count'); |
172 | |
173 | # employee #1 |
174 | |
175 | isa_ok($ii->employees->[0], 'Employee'); |
176 | isa_ok($ii->employees->[0], 'Person'); |
177 | |
178 | is($ii->employees->[0]->first_name, 'Jeremy', '... got the right first name'); |
179 | is($ii->employees->[0]->last_name, 'Shao', '... got the right last name'); |
180 | ok(!$ii->employees->[0]->has_middle_initial, '... no middle initial'); |
181 | is($ii->employees->[0]->middle_initial, undef, '... got the right middle initial value'); |
b6fe348f |
182 | is($ii->employees->[0]->full_name, 'Jeremy Shao, President / Senior Consultant', '... got the right full name'); |
5569c072 |
183 | is($ii->employees->[0]->title, 'President / Senior Consultant', '... got the right title'); |
184 | is($ii->employees->[0]->company, $ii, '... got the right company'); |
51c5e0fb |
185 | ok(isweak($ii->employees->[0]->{company}), '... the company is a weak-ref'); |
5569c072 |
186 | |
187 | isa_ok($ii->employees->[0]->address, 'Address'); |
188 | is($ii->employees->[0]->address->city, 'Manhasset', '... got the right city'); |
189 | is($ii->employees->[0]->address->state, 'NY', '... got the right state'); |
190 | |
191 | # employee #2 |
192 | |
193 | isa_ok($ii->employees->[1], 'Employee'); |
194 | isa_ok($ii->employees->[1], 'Person'); |
195 | |
196 | is($ii->employees->[1]->first_name, 'Tommy', '... got the right first name'); |
197 | is($ii->employees->[1]->last_name, 'Lee', '... got the right last name'); |
198 | ok(!$ii->employees->[1]->has_middle_initial, '... no middle initial'); |
199 | is($ii->employees->[1]->middle_initial, undef, '... got the right middle initial value'); |
b6fe348f |
200 | is($ii->employees->[1]->full_name, 'Tommy Lee, Vice President / Senior Developer', '... got the right full name'); |
5569c072 |
201 | is($ii->employees->[1]->title, 'Vice President / Senior Developer', '... got the right title'); |
202 | is($ii->employees->[1]->company, $ii, '... got the right company'); |
51c5e0fb |
203 | ok(isweak($ii->employees->[1]->{company}), '... the company is a weak-ref'); |
5569c072 |
204 | |
205 | isa_ok($ii->employees->[1]->address, 'Address'); |
206 | is($ii->employees->[1]->address->city, 'New York', '... got the right city'); |
207 | is($ii->employees->[1]->address->state, 'NY', '... got the right state'); |
208 | |
209 | # employee #3 |
210 | |
211 | isa_ok($ii->employees->[2], 'Employee'); |
212 | isa_ok($ii->employees->[2], 'Person'); |
213 | |
214 | is($ii->employees->[2]->first_name, 'Stevan', '... got the right first name'); |
215 | is($ii->employees->[2]->last_name, 'Little', '... got the right last name'); |
216 | ok($ii->employees->[2]->has_middle_initial, '... got middle initial'); |
217 | is($ii->employees->[2]->middle_initial, 'C', '... got the right middle initial value'); |
b6fe348f |
218 | is($ii->employees->[2]->full_name, 'Stevan C. Little, Senior Developer', '... got the right full name'); |
5569c072 |
219 | is($ii->employees->[2]->title, 'Senior Developer', '... got the right title'); |
220 | is($ii->employees->[2]->company, $ii, '... got the right company'); |
51c5e0fb |
221 | ok(isweak($ii->employees->[2]->{company}), '... the company is a weak-ref'); |
5569c072 |
222 | |
223 | isa_ok($ii->employees->[2]->address, 'Address'); |
224 | is($ii->employees->[2]->address->city, 'Madison', '... got the right city'); |
225 | is($ii->employees->[2]->address->state, 'CT', '... got the right state'); |
226 | |
227 | # employee #4 |
228 | |
229 | isa_ok($ii->employees->[3], 'Employee'); |
230 | isa_ok($ii->employees->[3], 'Person'); |
231 | |
232 | is($ii->employees->[3]->first_name, 'Rob', '... got the right first name'); |
233 | is($ii->employees->[3]->last_name, 'Kinyon', '... got the right last name'); |
234 | ok(!$ii->employees->[3]->has_middle_initial, '... got middle initial'); |
235 | is($ii->employees->[3]->middle_initial, undef, '... got the right middle initial value'); |
b6fe348f |
236 | is($ii->employees->[3]->full_name, 'Rob Kinyon, Developer', '... got the right full name'); |
5569c072 |
237 | is($ii->employees->[3]->title, 'Developer', '... got the right title'); |
238 | is($ii->employees->[3]->company, $ii, '... got the right company'); |
51c5e0fb |
239 | ok(isweak($ii->employees->[3]->{company}), '... the company is a weak-ref'); |
5569c072 |
240 | |
241 | isa_ok($ii->employees->[3]->address, 'Address'); |
242 | is($ii->employees->[3]->address->city, 'Marysville', '... got the right city'); |
243 | is($ii->employees->[3]->address->state, 'OH', '... got the right state'); |
244 | |
ad5ed80c |
245 | # create new company |
246 | |
247 | my $new_company = Company->new(name => 'Infinity Interactive International'); |
248 | isa_ok($new_company, 'Company'); |
249 | |
250 | my $ii_employees = $ii->employees; |
251 | foreach my $employee (@$ii_employees) { |
252 | is($employee->company, $ii, '... has the ii company'); |
253 | } |
254 | |
255 | $new_company->employees($ii_employees); |
256 | |
257 | foreach my $employee (@{$new_company->employees}) { |
258 | is($employee->company, $new_company, '... has the different company now'); |
259 | } |
260 | |
5569c072 |
261 | ## check some error conditions for the subtypes |
262 | |
263 | dies_ok { |
51c5e0fb |
264 | Address->new(street => {}), |
265 | } '... we die correctly with bad args'; |
266 | |
267 | dies_ok { |
268 | Address->new(city => {}), |
269 | } '... we die correctly with bad args'; |
270 | |
271 | dies_ok { |
5569c072 |
272 | Address->new(state => 'British Columbia'), |
273 | } '... we die correctly with bad args'; |
274 | |
275 | lives_ok { |
276 | Address->new(state => 'Connecticut'), |
277 | } '... we live correctly with good args'; |
278 | |
279 | dies_ok { |
280 | Address->new(zip_code => 'AF5J6$'), |
281 | } '... we die correctly with bad args'; |
282 | |
283 | lives_ok { |
284 | Address->new(zip_code => '06443'), |
285 | } '... we live correctly with good args'; |
286 | |
287 | dies_ok { |
7c6cacb4 |
288 | Company->new(), |
289 | } '... we die correctly without good args'; |
290 | |
291 | lives_ok { |
292 | Company->new(name => 'Foo'), |
293 | } '... we live correctly without good args'; |
294 | |
295 | dies_ok { |
296 | Company->new(name => 'Foo', employees => [ Person->new ]), |
5569c072 |
297 | } '... we die correctly with good args'; |
298 | |
299 | lives_ok { |
7c6cacb4 |
300 | Company->new(name => 'Foo', employees => []), |
5569c072 |
301 | } '... we live correctly with good args'; |
302 | |