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