Commit | Line | Data |
daa0fd7d |
1 | package Moose::Cookbook::Basics::Recipe4; |
2 | |
3 | # ABSTRACT: Subtypes, and modeling a simple B<Company> class hierarchy |
4 | |
5 | __END__ |
6 | |
471c4f09 |
7 | |
8 | =pod |
9 | |
5547fba7 |
10 | =begin testing-SETUP |
c79239a2 |
11 | |
0adca353 |
12 | use Test::Requires { |
13 | 'Locale::US' => '0', |
14 | 'Regexp::Common' => '0', |
15 | }; |
c79239a2 |
16 | |
5547fba7 |
17 | =end testing-SETUP |
c79239a2 |
18 | |
471c4f09 |
19 | =head1 SYNOPSIS |
36c99105 |
20 | |
471c4f09 |
21 | package Address; |
471c4f09 |
22 | use Moose; |
05d9eaf6 |
23 | use Moose::Util::TypeConstraints; |
36c99105 |
24 | |
471c4f09 |
25 | use Locale::US; |
26 | use Regexp::Common 'zip'; |
36c99105 |
27 | |
471c4f09 |
28 | my $STATES = Locale::US->new; |
0b3811a6 |
29 | subtype 'USState' |
471c4f09 |
30 | => as Str |
31 | => where { |
36c99105 |
32 | ( exists $STATES->{code2state}{ uc($_) } |
33 | || exists $STATES->{state2code}{ uc($_) } ); |
34 | }; |
35 | |
0b3811a6 |
36 | subtype 'USZipCode' |
471c4f09 |
37 | => as Value |
38 | => where { |
36c99105 |
39 | /^$RE{zip}{US}{-extended => 'allow'}$/; |
40 | }; |
41 | |
42 | has 'street' => ( is => 'rw', isa => 'Str' ); |
43 | has 'city' => ( is => 'rw', isa => 'Str' ); |
44 | has 'state' => ( is => 'rw', isa => 'USState' ); |
45 | has 'zip_code' => ( is => 'rw', isa => 'USZipCode' ); |
46 | |
f1917f58 |
47 | package Company; |
48 | use Moose; |
49 | use Moose::Util::TypeConstraints; |
36c99105 |
50 | |
51 | has 'name' => ( is => 'rw', isa => 'Str', required => 1 ); |
52 | has 'address' => ( is => 'rw', isa => 'Address' ); |
3b322dee |
53 | has 'employees' => ( |
54 | is => 'rw', |
45203625 |
55 | isa => 'ArrayRef[Employee]', |
3b322dee |
56 | default => sub { [] }, |
57 | ); |
36c99105 |
58 | |
f1917f58 |
59 | sub BUILD { |
36c99105 |
60 | my ( $self, $params ) = @_; |
3b322dee |
61 | foreach my $employee ( @{ $self->employees } ) { |
922a97e9 |
62 | $employee->employer($self); |
f1917f58 |
63 | } |
64 | } |
36c99105 |
65 | |
f1917f58 |
66 | after 'employees' => sub { |
36c99105 |
67 | my ( $self, $employees ) = @_; |
3b322dee |
68 | return unless $employees; |
69 | foreach my $employee ( @$employees ) { |
922a97e9 |
70 | $employee->employer($self); |
f1917f58 |
71 | } |
36c99105 |
72 | }; |
73 | |
471c4f09 |
74 | package Person; |
471c4f09 |
75 | use Moose; |
36c99105 |
76 | |
77 | has 'first_name' => ( is => 'rw', isa => 'Str', required => 1 ); |
78 | has 'last_name' => ( is => 'rw', isa => 'Str', required => 1 ); |
79 | has 'middle_initial' => ( |
80 | is => 'rw', isa => 'Str', |
81 | predicate => 'has_middle_initial' |
82 | ); |
83 | has 'address' => ( is => 'rw', isa => 'Address' ); |
84 | |
471c4f09 |
85 | sub full_name { |
86 | my $self = shift; |
36c99105 |
87 | return $self->first_name |
88 | . ( |
89 | $self->has_middle_initial |
90 | ? ' ' . $self->middle_initial . '. ' |
91 | : ' ' |
92 | ) . $self->last_name; |
471c4f09 |
93 | } |
36c99105 |
94 | |
471c4f09 |
95 | package Employee; |
36c99105 |
96 | use Moose; |
97 | |
471c4f09 |
98 | extends 'Person'; |
36c99105 |
99 | |
4a6b74bd |
100 | has 'title' => ( is => 'rw', isa => 'Str', required => 1 ); |
101 | has 'employer' => ( is => 'rw', isa => 'Company', weak_ref => 1 ); |
36c99105 |
102 | |
471c4f09 |
103 | override 'full_name' => sub { |
104 | my $self = shift; |
36c99105 |
105 | super() . ', ' . $self->title; |
471c4f09 |
106 | }; |
2f04a0fc |
107 | |
471c4f09 |
108 | =head1 DESCRIPTION |
109 | |
4a6b74bd |
110 | This recipe introduces the C<subtype> sugar function from |
111 | L<Moose::Util::TypeConstraints>. The C<subtype> function lets you |
112 | declaratively create type constraints without building an entire |
113 | class. |
172e0738 |
114 | |
4a6b74bd |
115 | In the recipe we also make use of L<Locale::US> and L<Regexp::Common> |
cad0dd79 |
116 | to build constraints, showing how constraints can make use of existing |
117 | CPAN tools for data validation. |
36c99105 |
118 | |
16fb3624 |
119 | Finally, we introduce the C<required> attribute option. |
4a6b74bd |
120 | |
21ec1978 |
121 | In the C<Address> class we define two subtypes. The first uses the |
19320607 |
122 | L<Locale::US> module to check the validity of a state. It accepts |
4a6b74bd |
123 | either a state abbreviation of full name. |
124 | |
125 | A state will be passed in as a string, so we make our C<USState> type |
126 | a subtype of Moose's builtin C<Str> type. This is done using the C<as> |
127 | sugar. The actual constraint is defined using C<where>. This function |
128 | accepts a single subroutine reference. That subroutine will be called |
129 | with the value to be checked in C<$_> (1). It is expected to return a |
130 | true or false value indicating whether the value is valid for the |
131 | type. |
172e0738 |
132 | |
4a6b74bd |
133 | We can now use the C<USState> type just like Moose's builtin types: |
172e0738 |
134 | |
36c99105 |
135 | has 'state' => ( is => 'rw', isa => 'USState' ); |
172e0738 |
136 | |
4a6b74bd |
137 | When the C<state> attribute is set, the value is checked against the |
138 | C<USState> constraint. If the value is not valid, an exception will be |
139 | thrown. |
172e0738 |
140 | |
4a6b74bd |
141 | The next C<subtype>, C<USZipCode>, uses |
142 | L<Regexp::Common>. L<Regexp::Common> includes a regex for validating |
143 | US zip codes. We use this constraint for the C<zip_code> attribute. |
172e0738 |
144 | |
0b3811a6 |
145 | subtype 'USZipCode' |
172e0738 |
146 | => as Value |
147 | => where { |
36c99105 |
148 | /^$RE{zip}{US}{-extended => 'allow'}$/; |
149 | }; |
172e0738 |
150 | |
4a6b74bd |
151 | Using a subtype instead of requiring a class for each type greatly |
152 | simplifies the code. We don't really need a class for these types, as |
153 | they're just strings, but we do want to ensure that they're valid. |
154 | |
155 | The type constraints we created are reusable. Type constraints are |
400e1596 |
156 | stored by name in a global registry, which means that we can refer to |
4a6b74bd |
157 | them in other classes. Because the registry is global, we do recommend |
400e1596 |
158 | that you use some sort of namespacing in real applications, |
159 | like C<MyApp::Type::USState> (just as you would do with class names). |
4a6b74bd |
160 | |
161 | These two subtypes allow us to define a simple C<Address> class. |
172e0738 |
162 | |
4a6b74bd |
163 | Then we define our C<Company> class, which has an address. As we saw |
164 | in earlier recipes, Moose automatically creates a type constraint for |
165 | each our classes, so we can use that for the C<Company> class's |
166 | C<address> attribute: |
172e0738 |
167 | |
36c99105 |
168 | has 'address' => ( is => 'rw', isa => 'Address' ); |
172e0738 |
169 | |
4a6b74bd |
170 | A company also needs a name: |
172e0738 |
171 | |
36c99105 |
172 | has 'name' => ( is => 'rw', isa => 'Str', required => 1 ); |
172e0738 |
173 | |
16fb3624 |
174 | This introduces a new attribute option, C<required>. If an attribute |
175 | is required, then it must be passed to the class's constructor, or an |
176 | exception will be thrown. It's important to understand that a |
177 | C<required> attribute can still be false or C<undef>, if its type |
178 | constraint allows that. |
f1917f58 |
179 | |
4a6b74bd |
180 | The next attribute, C<employees>, uses a I<parameterized> type |
181 | constraint: |
36c99105 |
182 | |
3b322dee |
183 | has 'employees' => ( |
184 | is => 'rw', |
185 | isa => 'ArrayRef[Employee]' |
186 | default => sub { [] }, |
187 | ); |
07cde929 |
188 | |
4a6b74bd |
189 | This constraint says that C<employees> must be an array reference |
190 | where each element of the array is an C<Employee> object. It's worth |
191 | noting that an I<empty> array reference also satisfies this |
3b322dee |
192 | constraint, such as the value given as the default here. |
4a6b74bd |
193 | |
cad0dd79 |
194 | Parameterizable type constraints (or "container types"), such as |
4a6b74bd |
195 | C<ArrayRef[`a]>, can be made more specific with a type parameter. In |
196 | fact, we can arbitrarily nest these types, producing something like |
197 | C<HashRef[ArrayRef[Int]]>. However, you can also just use the type by |
198 | itself, so C<ArrayRef> is legal. (2) |
199 | |
200 | If you jump down to the definition of the C<Employee> class, you will |
201 | see that it has an C<employer> attribute. |
202 | |
203 | When we set the C<employees> for a C<Company> we want to make sure |
204 | that each of these employee objects refers back to the right |
205 | C<Company> in its C<employer> attribute. |
206 | |
207 | To do that, we need to hook into object construction. Moose lets us do |
208 | this by writing a C<BUILD> method in our class. When your class |
ff2b7a57 |
209 | defines a C<BUILD> method, it will be called by the constructor |
210 | immediately after object construction, but before the object is returned |
211 | to the caller. Note that all C<BUILD> methods in your class hierarchy |
212 | will be called automatically; there is no need to (and you should not) |
213 | call the superclass C<BUILD> method. |
4a6b74bd |
214 | |
215 | The C<Company> class uses the C<BUILD> method to ensure that each |
216 | employee of a company has the proper C<Company> object in its |
217 | C<employer> attribute: |
36c99105 |
218 | |
ad5ed80c |
219 | sub BUILD { |
36c99105 |
220 | my ( $self, $params ) = @_; |
3b322dee |
221 | foreach my $employee ( @{ $self->employees } ) { |
922a97e9 |
222 | $employee->employer($self); |
ad5ed80c |
223 | } |
224 | } |
225 | |
922a97e9 |
226 | The C<BUILD> method is executed after type constraints are checked, so it is |
227 | safe to assume that if C<< $self->employees >> has a value, it will be an |
228 | array reference, and that the elements of that array reference will be |
229 | C<Employee> objects. |
4a6b74bd |
230 | |
231 | We also want to make sure that whenever the C<employees> attribute for |
232 | a C<Company> is changed, we also update the C<employer> for each |
233 | employee. |
ad5ed80c |
234 | |
4a6b74bd |
235 | To do this we can use an C<after> modifier: |
ad5ed80c |
236 | |
237 | after 'employees' => sub { |
36c99105 |
238 | my ( $self, $employees ) = @_; |
3b322dee |
239 | return unless $employees; |
240 | foreach my $employee ( @$employees ) { |
922a97e9 |
241 | $employee->employer($self); |
ad5ed80c |
242 | } |
243 | }; |
244 | |
922a97e9 |
245 | Again, as with the C<BUILD> method, we know that the type constraint check has |
246 | already happened, so we know that if C<$employees> is defined it will contain |
4c72fa40 |
247 | an array reference of C<Employee> objects. |
ad5ed80c |
248 | |
3b322dee |
249 | Note that C<employees> is a read/write accessor, so we must return early if |
250 | it's called as a reader. |
251 | |
fdba9686 |
252 | The B<Person> class does not really demonstrate anything new. It has several |
4a6b74bd |
253 | C<required> attributes. It also has a C<predicate> method, which we |
254 | first used in L<recipe 3|Moose::Cookbook::Basics::Recipe3>. |
f1917f58 |
255 | |
4a6b74bd |
256 | The only new feature in the C<Employee> class is the C<override> |
257 | method modifier: |
f1917f58 |
258 | |
259 | override 'full_name' => sub { |
260 | my $self = shift; |
36c99105 |
261 | super() . ', ' . $self->title; |
f1917f58 |
262 | }; |
263 | |
4a6b74bd |
264 | This is just a sugary alternative to Perl's built in C<SUPER::> |
265 | feature. However, there is one difference. You cannot pass any |
19320607 |
266 | arguments to C<super>. Instead, Moose simply passes the same |
4a6b74bd |
267 | parameters that were passed to the method. |
ad5ed80c |
268 | |
4a6b74bd |
269 | A more detailed example of usage can be found in |
2c739d1a |
270 | F<t/recipes/moose_cookbook_basics_recipe4.t>. |
ad5ed80c |
271 | |
272 | =head1 CONCLUSION |
273 | |
4a6b74bd |
274 | This recipe was intentionally longer and more complex. It illustrates |
275 | how Moose classes can be used together with type constraints, as well |
276 | as the density of information that you can get out of a small amount |
277 | of typing when using Moose. |
278 | |
279 | This recipe also introduced the C<subtype> function, the C<required> |
280 | attribute, and the C<override> method modifier. |
ad5ed80c |
281 | |
4a6b74bd |
282 | We will revisit type constraints in future recipes, and cover type |
283 | coercion as well. |
e08c54f5 |
284 | |
172e0738 |
285 | =head1 FOOTNOTES |
286 | |
287 | =over 4 |
288 | |
289 | =item (1) |
290 | |
6549b0d1 |
291 | The value being checked is also passed as the first argument to |
4a6b74bd |
292 | the C<where> block, so it can be accessed as C<$_[0]>. |
172e0738 |
293 | |
ad5ed80c |
294 | =item (2) |
295 | |
4a6b74bd |
296 | Note that C<ArrayRef[]> will not work. Moose will not parse this as a |
297 | container type, and instead you will have a new type named |
298 | "ArrayRef[]", which doesn't make any sense. |
ad5ed80c |
299 | |
172e0738 |
300 | =back |
301 | |
c79239a2 |
302 | =begin testing |
303 | |
304 | { |
305 | package Company; |
306 | |
307 | sub get_employee_count { scalar @{(shift)->employees} } |
308 | } |
309 | |
310 | use Scalar::Util 'isweak'; |
311 | |
312 | my $ii; |
b10dde3a |
313 | is( |
314 | exception { |
315 | $ii = Company->new( |
316 | { |
317 | name => 'Infinity Interactive', |
318 | address => Address->new( |
319 | street => '565 Plandome Rd., Suite 307', |
320 | city => 'Manhasset', |
321 | state => 'NY', |
322 | zip_code => '11030' |
c79239a2 |
323 | ), |
b10dde3a |
324 | employees => [ |
325 | Employee->new( |
326 | first_name => 'Jeremy', |
327 | last_name => 'Shao', |
328 | title => 'President / Senior Consultant', |
329 | address => Address->new( |
330 | city => 'Manhasset', state => 'NY' |
331 | ) |
332 | ), |
333 | Employee->new( |
334 | first_name => 'Tommy', |
335 | last_name => 'Lee', |
336 | title => 'Vice President / Senior Developer', |
337 | address => |
338 | Address->new( city => 'New York', state => 'NY' ) |
339 | ), |
340 | Employee->new( |
341 | first_name => 'Stevan', |
342 | middle_initial => 'C', |
343 | last_name => 'Little', |
344 | title => 'Senior Developer', |
345 | address => |
346 | Address->new( city => 'Madison', state => 'CT' ) |
347 | ), |
348 | ] |
349 | } |
350 | ); |
351 | }, |
352 | undef, |
353 | '... created the entire company successfully' |
354 | ); |
355 | |
c79239a2 |
356 | isa_ok( $ii, 'Company' ); |
357 | |
358 | is( $ii->name, 'Infinity Interactive', |
359 | '... got the right name for the company' ); |
360 | |
361 | isa_ok( $ii->address, 'Address' ); |
362 | is( $ii->address->street, '565 Plandome Rd., Suite 307', |
363 | '... got the right street address' ); |
364 | is( $ii->address->city, 'Manhasset', '... got the right city' ); |
365 | is( $ii->address->state, 'NY', '... got the right state' ); |
366 | is( $ii->address->zip_code, 11030, '... got the zip code' ); |
367 | |
368 | is( $ii->get_employee_count, 3, '... got the right employee count' ); |
369 | |
370 | # employee #1 |
371 | |
372 | isa_ok( $ii->employees->[0], 'Employee' ); |
373 | isa_ok( $ii->employees->[0], 'Person' ); |
374 | |
375 | is( $ii->employees->[0]->first_name, 'Jeremy', |
376 | '... got the right first name' ); |
377 | is( $ii->employees->[0]->last_name, 'Shao', '... got the right last name' ); |
378 | ok( !$ii->employees->[0]->has_middle_initial, '... no middle initial' ); |
379 | is( $ii->employees->[0]->middle_initial, undef, |
380 | '... got the right middle initial value' ); |
381 | is( $ii->employees->[0]->full_name, |
382 | 'Jeremy Shao, President / Senior Consultant', |
383 | '... got the right full name' ); |
384 | is( $ii->employees->[0]->title, 'President / Senior Consultant', |
385 | '... got the right title' ); |
386 | is( $ii->employees->[0]->employer, $ii, '... got the right company' ); |
387 | ok( isweak( $ii->employees->[0]->{employer} ), |
388 | '... the company is a weak-ref' ); |
389 | |
390 | isa_ok( $ii->employees->[0]->address, 'Address' ); |
391 | is( $ii->employees->[0]->address->city, 'Manhasset', |
392 | '... got the right city' ); |
393 | is( $ii->employees->[0]->address->state, 'NY', '... got the right state' ); |
394 | |
395 | # employee #2 |
396 | |
397 | isa_ok( $ii->employees->[1], 'Employee' ); |
398 | isa_ok( $ii->employees->[1], 'Person' ); |
399 | |
400 | is( $ii->employees->[1]->first_name, 'Tommy', |
401 | '... got the right first name' ); |
402 | is( $ii->employees->[1]->last_name, 'Lee', '... got the right last name' ); |
403 | ok( !$ii->employees->[1]->has_middle_initial, '... no middle initial' ); |
404 | is( $ii->employees->[1]->middle_initial, undef, |
405 | '... got the right middle initial value' ); |
406 | is( $ii->employees->[1]->full_name, |
407 | 'Tommy Lee, Vice President / Senior Developer', |
408 | '... got the right full name' ); |
409 | is( $ii->employees->[1]->title, 'Vice President / Senior Developer', |
410 | '... got the right title' ); |
411 | is( $ii->employees->[1]->employer, $ii, '... got the right company' ); |
412 | ok( isweak( $ii->employees->[1]->{employer} ), |
413 | '... the company is a weak-ref' ); |
414 | |
415 | isa_ok( $ii->employees->[1]->address, 'Address' ); |
416 | is( $ii->employees->[1]->address->city, 'New York', |
417 | '... got the right city' ); |
418 | is( $ii->employees->[1]->address->state, 'NY', '... got the right state' ); |
419 | |
420 | # employee #3 |
421 | |
422 | isa_ok( $ii->employees->[2], 'Employee' ); |
423 | isa_ok( $ii->employees->[2], 'Person' ); |
424 | |
425 | is( $ii->employees->[2]->first_name, 'Stevan', |
426 | '... got the right first name' ); |
427 | is( $ii->employees->[2]->last_name, 'Little', '... got the right last name' ); |
428 | ok( $ii->employees->[2]->has_middle_initial, '... got middle initial' ); |
429 | is( $ii->employees->[2]->middle_initial, 'C', |
430 | '... got the right middle initial value' ); |
431 | is( $ii->employees->[2]->full_name, 'Stevan C. Little, Senior Developer', |
432 | '... got the right full name' ); |
433 | is( $ii->employees->[2]->title, 'Senior Developer', |
434 | '... got the right title' ); |
435 | is( $ii->employees->[2]->employer, $ii, '... got the right company' ); |
436 | ok( isweak( $ii->employees->[2]->{employer} ), |
437 | '... the company is a weak-ref' ); |
438 | |
439 | isa_ok( $ii->employees->[2]->address, 'Address' ); |
440 | is( $ii->employees->[2]->address->city, 'Madison', '... got the right city' ); |
441 | is( $ii->employees->[2]->address->state, 'CT', '... got the right state' ); |
442 | |
443 | # create new company |
444 | |
445 | my $new_company |
446 | = Company->new( name => 'Infinity Interactive International' ); |
447 | isa_ok( $new_company, 'Company' ); |
448 | |
449 | my $ii_employees = $ii->employees; |
450 | foreach my $employee (@$ii_employees) { |
451 | is( $employee->employer, $ii, '... has the ii company' ); |
452 | } |
453 | |
454 | $new_company->employees($ii_employees); |
455 | |
456 | foreach my $employee ( @{ $new_company->employees } ) { |
457 | is( $employee->employer, $new_company, |
458 | '... has the different company now' ); |
459 | } |
460 | |
461 | ## check some error conditions for the subtypes |
462 | |
b10dde3a |
463 | isnt( |
464 | exception { |
465 | Address->new( street => {} ),; |
466 | }, |
467 | undef, |
468 | '... we die correctly with bad args' |
469 | ); |
470 | |
471 | isnt( |
472 | exception { |
473 | Address->new( city => {} ),; |
474 | }, |
475 | undef, |
476 | '... we die correctly with bad args' |
477 | ); |
478 | |
479 | isnt( |
480 | exception { |
481 | Address->new( state => 'British Columbia' ),; |
482 | }, |
483 | undef, |
484 | '... we die correctly with bad args' |
485 | ); |
486 | |
487 | is( |
488 | exception { |
489 | Address->new( state => 'Connecticut' ),; |
490 | }, |
491 | undef, |
492 | '... we live correctly with good args' |
493 | ); |
494 | |
495 | isnt( |
496 | exception { |
497 | Address->new( zip_code => 'AF5J6$' ),; |
498 | }, |
499 | undef, |
500 | '... we die correctly with bad args' |
501 | ); |
502 | |
503 | is( |
504 | exception { |
505 | Address->new( zip_code => '06443' ),; |
506 | }, |
507 | undef, |
508 | '... we live correctly with good args' |
509 | ); |
510 | |
511 | isnt( |
512 | exception { |
513 | Company->new(),; |
514 | }, |
515 | undef, |
516 | '... we die correctly without good args' |
517 | ); |
518 | |
519 | is( |
520 | exception { |
521 | Company->new( name => 'Foo' ),; |
522 | }, |
523 | undef, |
524 | '... we live correctly without good args' |
525 | ); |
526 | |
527 | isnt( |
528 | exception { |
529 | Company->new( name => 'Foo', employees => [ Person->new ] ),; |
530 | }, |
531 | undef, |
532 | '... we die correctly with good args' |
533 | ); |
534 | |
535 | is( |
536 | exception { |
537 | Company->new( name => 'Foo', employees => [] ),; |
538 | }, |
539 | undef, |
540 | '... we live correctly with good args' |
541 | ); |
c79239a2 |
542 | |
543 | =end testing |
544 | |
e08c54f5 |
545 | =cut |