8 'Regexp::Common' => '0',
15 Moose::Cookbook::Basics::Recipe4 - Subtypes, and modeling a simple B<Company> class hierarchy
21 use Moose::Util::TypeConstraints;
24 use Regexp::Common 'zip';
26 my $STATES = Locale::US->new;
30 ( exists $STATES->{code2state}{ uc($_) }
31 || exists $STATES->{state2code}{ uc($_) } );
37 /^$RE{zip}{US}{-extended => 'allow'}$/;
40 has 'street' => ( is => 'rw', isa => 'Str' );
41 has 'city' => ( is => 'rw', isa => 'Str' );
42 has 'state' => ( is => 'rw', isa => 'USState' );
43 has 'zip_code' => ( is => 'rw', isa => 'USZipCode' );
47 use Moose::Util::TypeConstraints;
49 has 'name' => ( is => 'rw', isa => 'Str', required => 1 );
50 has 'address' => ( is => 'rw', isa => 'Address' );
51 has 'employees' => ( is => 'rw', isa => 'ArrayRef[Employee]' );
54 my ( $self, $params ) = @_;
55 foreach my $employee ( @{ $self->employees || [] } ) {
56 $employee->employer($self);
60 after 'employees' => sub {
61 my ( $self, $employees ) = @_;
62 foreach my $employee ( @{ $employees || [] } ) {
63 $employee->employer($self);
70 has 'first_name' => ( is => 'rw', isa => 'Str', required => 1 );
71 has 'last_name' => ( is => 'rw', isa => 'Str', required => 1 );
72 has 'middle_initial' => (
73 is => 'rw', isa => 'Str',
74 predicate => 'has_middle_initial'
76 has 'address' => ( is => 'rw', isa => 'Address' );
80 return $self->first_name
82 $self->has_middle_initial
83 ? ' ' . $self->middle_initial . '. '
93 has 'title' => ( is => 'rw', isa => 'Str', required => 1 );
94 has 'employer' => ( is => 'rw', isa => 'Company', weak_ref => 1 );
96 override 'full_name' => sub {
98 super() . ', ' . $self->title;
103 This recipe introduces the C<subtype> sugar function from
104 L<Moose::Util::TypeConstraints>. The C<subtype> function lets you
105 declaratively create type constraints without building an entire
108 In the recipe we also make use of L<Locale::US> and L<Regexp::Common>
109 to build constraints, showing how constraints can make use of existing
110 CPAN tools for data validation.
112 Finally, we introduce the C<required> attribute option.
114 In the C<Address> class we define two subtypes. The first uses the
115 L<Locale::US> module to check the validity of a state. It accepts
116 either a state abbreviation of full name.
118 A state will be passed in as a string, so we make our C<USState> type
119 a subtype of Moose's builtin C<Str> type. This is done using the C<as>
120 sugar. The actual constraint is defined using C<where>. This function
121 accepts a single subroutine reference. That subroutine will be called
122 with the value to be checked in C<$_> (1). It is expected to return a
123 true or false value indicating whether the value is valid for the
126 We can now use the C<USState> type just like Moose's builtin types:
128 has 'state' => ( is => 'rw', isa => 'USState' );
130 When the C<state> attribute is set, the value is checked against the
131 C<USState> constraint. If the value is not valid, an exception will be
134 The next C<subtype>, C<USZipCode>, uses
135 L<Regexp::Common>. L<Regexp::Common> includes a regex for validating
136 US zip codes. We use this constraint for the C<zip_code> attribute.
141 /^$RE{zip}{US}{-extended => 'allow'}$/;
144 Using a subtype instead of requiring a class for each type greatly
145 simplifies the code. We don't really need a class for these types, as
146 they're just strings, but we do want to ensure that they're valid.
148 The type constraints we created are reusable. Type constraints are
149 stored by name in a global registry. This means that we can refer to
150 them in other classes. Because the registry is global, we do recommend
151 that you use some sort of pseudo-namespacing in real applications,
152 like C<MyApp.Type.USState>.
154 These two subtypes allow us to define a simple C<Address> class.
156 Then we define our C<Company> class, which has an address. As we saw
157 in earlier recipes, Moose automatically creates a type constraint for
158 each our classes, so we can use that for the C<Company> class's
159 C<address> attribute:
161 has 'address' => ( is => 'rw', isa => 'Address' );
163 A company also needs a name:
165 has 'name' => ( is => 'rw', isa => 'Str', required => 1 );
167 This introduces a new attribute option, C<required>. If an attribute
168 is required, then it must be passed to the class's constructor, or an
169 exception will be thrown. It's important to understand that a
170 C<required> attribute can still be false or C<undef>, if its type
171 constraint allows that.
173 The next attribute, C<employees>, uses a I<parameterized> type
176 has 'employees' => ( is => 'rw', isa => 'ArrayRef[Employee]' );
178 This constraint says that C<employees> must be an array reference
179 where each element of the array is an C<Employee> object. It's worth
180 noting that an I<empty> array reference also satisfies this
183 Parameterizable type constraints (or "container types"), such as
184 C<ArrayRef[`a]>, can be made more specific with a type parameter. In
185 fact, we can arbitrarily nest these types, producing something like
186 C<HashRef[ArrayRef[Int]]>. However, you can also just use the type by
187 itself, so C<ArrayRef> is legal. (2)
189 If you jump down to the definition of the C<Employee> class, you will
190 see that it has an C<employer> attribute.
192 When we set the C<employees> for a C<Company> we want to make sure
193 that each of these employee objects refers back to the right
194 C<Company> in its C<employer> attribute.
196 To do that, we need to hook into object construction. Moose lets us do
197 this by writing a C<BUILD> method in our class. When your class
198 defined a C<BUILD> method, it will be called immediately after an
199 object construction, but before the object is returned to the caller
202 The C<Company> class uses the C<BUILD> method to ensure that each
203 employee of a company has the proper C<Company> object in its
204 C<employer> attribute:
207 my ( $self, $params ) = @_;
208 foreach my $employee ( @{ $self->employees || [] } ) {
209 $employee->employer($self);
213 The C<BUILD> method is executed after type constraints are checked, so it is
214 safe to assume that if C<< $self->employees >> has a value, it will be an
215 array reference, and that the elements of that array reference will be
218 We also want to make sure that whenever the C<employees> attribute for
219 a C<Company> is changed, we also update the C<employer> for each
222 To do this we can use an C<after> modifier:
224 after 'employees' => sub {
225 my ( $self, $employees ) = @_;
226 foreach my $employee ( @{ $employees || [] } ) {
227 $employee->employer($self);
231 Again, as with the C<BUILD> method, we know that the type constraint check has
232 already happened, so we know that if C<$employees> is defined it will contain
233 an array reference of C<Employee> objects..
235 The B<Person> class does not really demonstrate anything new. It has several
236 C<required> attributes. It also has a C<predicate> method, which we
237 first used in L<recipe 3|Moose::Cookbook::Basics::Recipe3>.
239 The only new feature in the C<Employee> class is the C<override>
242 override 'full_name' => sub {
244 super() . ', ' . $self->title;
247 This is just a sugary alternative to Perl's built in C<SUPER::>
248 feature. However, there is one difference. You cannot pass any
249 arguments to C<super>. Instead, Moose simply passes the same
250 parameters that were passed to the method.
252 A more detailed example of usage can be found in
253 F<t/000_recipes/moose_cookbook_basics_recipe4.t>.
257 This recipe was intentionally longer and more complex. It illustrates
258 how Moose classes can be used together with type constraints, as well
259 as the density of information that you can get out of a small amount
260 of typing when using Moose.
262 This recipe also introduced the C<subtype> function, the C<required>
263 attribute, and the C<override> method modifier.
265 We will revisit type constraints in future recipes, and cover type
274 The value being checked is also passed as the first argument to
275 the C<where> block, so it can be accessed as C<$_[0]>.
279 Note that C<ArrayRef[]> will not work. Moose will not parse this as a
280 container type, and instead you will have a new type named
281 "ArrayRef[]", which doesn't make any sense.
285 The C<BUILD> method is actually called by C<< Moose::Object->BUILDALL
286 >>, which is called by C<< Moose::Object->new >>. The C<BUILDALL>
287 method climbs the object inheritance graph and calls any C<BUILD>
288 methods it finds in the correct order.
294 Stevan Little E<lt>stevan@iinteractive.comE<gt>
296 Dave Rolsky E<lt>autarch@urth.orgE<gt>
298 =head1 COPYRIGHT AND LICENSE
300 Copyright 2006-2010 by Infinity Interactive, Inc.
302 L<http://www.iinteractive.com>
304 This library is free software; you can redistribute it and/or modify
305 it under the same terms as Perl itself.
312 sub get_employee_count { scalar @{(shift)->employees} }
315 use Scalar::Util 'isweak';
322 name => 'Infinity Interactive',
323 address => Address->new(
324 street => '565 Plandome Rd., Suite 307',
331 first_name => 'Jeremy',
333 title => 'President / Senior Consultant',
334 address => Address->new(
335 city => 'Manhasset', state => 'NY'
339 first_name => 'Tommy',
341 title => 'Vice President / Senior Developer',
343 Address->new( city => 'New York', state => 'NY' )
346 first_name => 'Stevan',
347 middle_initial => 'C',
348 last_name => 'Little',
349 title => 'Senior Developer',
351 Address->new( city => 'Madison', state => 'CT' )
358 '... created the entire company successfully'
361 isa_ok( $ii, 'Company' );
363 is( $ii->name, 'Infinity Interactive',
364 '... got the right name for the company' );
366 isa_ok( $ii->address, 'Address' );
367 is( $ii->address->street, '565 Plandome Rd., Suite 307',
368 '... got the right street address' );
369 is( $ii->address->city, 'Manhasset', '... got the right city' );
370 is( $ii->address->state, 'NY', '... got the right state' );
371 is( $ii->address->zip_code, 11030, '... got the zip code' );
373 is( $ii->get_employee_count, 3, '... got the right employee count' );
377 isa_ok( $ii->employees->[0], 'Employee' );
378 isa_ok( $ii->employees->[0], 'Person' );
380 is( $ii->employees->[0]->first_name, 'Jeremy',
381 '... got the right first name' );
382 is( $ii->employees->[0]->last_name, 'Shao', '... got the right last name' );
383 ok( !$ii->employees->[0]->has_middle_initial, '... no middle initial' );
384 is( $ii->employees->[0]->middle_initial, undef,
385 '... got the right middle initial value' );
386 is( $ii->employees->[0]->full_name,
387 'Jeremy Shao, President / Senior Consultant',
388 '... got the right full name' );
389 is( $ii->employees->[0]->title, 'President / Senior Consultant',
390 '... got the right title' );
391 is( $ii->employees->[0]->employer, $ii, '... got the right company' );
392 ok( isweak( $ii->employees->[0]->{employer} ),
393 '... the company is a weak-ref' );
395 isa_ok( $ii->employees->[0]->address, 'Address' );
396 is( $ii->employees->[0]->address->city, 'Manhasset',
397 '... got the right city' );
398 is( $ii->employees->[0]->address->state, 'NY', '... got the right state' );
402 isa_ok( $ii->employees->[1], 'Employee' );
403 isa_ok( $ii->employees->[1], 'Person' );
405 is( $ii->employees->[1]->first_name, 'Tommy',
406 '... got the right first name' );
407 is( $ii->employees->[1]->last_name, 'Lee', '... got the right last name' );
408 ok( !$ii->employees->[1]->has_middle_initial, '... no middle initial' );
409 is( $ii->employees->[1]->middle_initial, undef,
410 '... got the right middle initial value' );
411 is( $ii->employees->[1]->full_name,
412 'Tommy Lee, Vice President / Senior Developer',
413 '... got the right full name' );
414 is( $ii->employees->[1]->title, 'Vice President / Senior Developer',
415 '... got the right title' );
416 is( $ii->employees->[1]->employer, $ii, '... got the right company' );
417 ok( isweak( $ii->employees->[1]->{employer} ),
418 '... the company is a weak-ref' );
420 isa_ok( $ii->employees->[1]->address, 'Address' );
421 is( $ii->employees->[1]->address->city, 'New York',
422 '... got the right city' );
423 is( $ii->employees->[1]->address->state, 'NY', '... got the right state' );
427 isa_ok( $ii->employees->[2], 'Employee' );
428 isa_ok( $ii->employees->[2], 'Person' );
430 is( $ii->employees->[2]->first_name, 'Stevan',
431 '... got the right first name' );
432 is( $ii->employees->[2]->last_name, 'Little', '... got the right last name' );
433 ok( $ii->employees->[2]->has_middle_initial, '... got middle initial' );
434 is( $ii->employees->[2]->middle_initial, 'C',
435 '... got the right middle initial value' );
436 is( $ii->employees->[2]->full_name, 'Stevan C. Little, Senior Developer',
437 '... got the right full name' );
438 is( $ii->employees->[2]->title, 'Senior Developer',
439 '... got the right title' );
440 is( $ii->employees->[2]->employer, $ii, '... got the right company' );
441 ok( isweak( $ii->employees->[2]->{employer} ),
442 '... the company is a weak-ref' );
444 isa_ok( $ii->employees->[2]->address, 'Address' );
445 is( $ii->employees->[2]->address->city, 'Madison', '... got the right city' );
446 is( $ii->employees->[2]->address->state, 'CT', '... got the right state' );
451 = Company->new( name => 'Infinity Interactive International' );
452 isa_ok( $new_company, 'Company' );
454 my $ii_employees = $ii->employees;
455 foreach my $employee (@$ii_employees) {
456 is( $employee->employer, $ii, '... has the ii company' );
459 $new_company->employees($ii_employees);
461 foreach my $employee ( @{ $new_company->employees } ) {
462 is( $employee->employer, $new_company,
463 '... has the different company now' );
466 ## check some error conditions for the subtypes
470 Address->new( street => {} ),;
473 '... we die correctly with bad args'
478 Address->new( city => {} ),;
481 '... we die correctly with bad args'
486 Address->new( state => 'British Columbia' ),;
489 '... we die correctly with bad args'
494 Address->new( state => 'Connecticut' ),;
497 '... we live correctly with good args'
502 Address->new( zip_code => 'AF5J6$' ),;
505 '... we die correctly with bad args'
510 Address->new( zip_code => '06443' ),;
513 '... we live correctly with good args'
521 '... we die correctly without good args'
526 Company->new( name => 'Foo' ),;
529 '... we live correctly without good args'
534 Company->new( name => 'Foo', employees => [ Person->new ] ),;
537 '... we die correctly with good args'
542 Company->new( name => 'Foo', employees => [] ),;
545 '... we live correctly with good args'