7 eval 'use Regexp::Common; use Locale::US;';
9 diag 'Regexp::Common & Locale::US required for this test';
19 Moose::Cookbook::Basics::Recipe4 - Subtypes, and modeling a simple B<Company> class hierarchy
25 use Moose::Util::TypeConstraints;
28 use Regexp::Common 'zip';
30 my $STATES = Locale::US->new;
34 ( exists $STATES->{code2state}{ uc($_) }
35 || exists $STATES->{state2code}{ uc($_) } );
41 /^$RE{zip}{US}{-extended => 'allow'}$/;
44 has 'street' => ( is => 'rw', isa => 'Str' );
45 has 'city' => ( is => 'rw', isa => 'Str' );
46 has 'state' => ( is => 'rw', isa => 'USState' );
47 has 'zip_code' => ( is => 'rw', isa => 'USZipCode' );
51 use Moose::Util::TypeConstraints;
53 has 'name' => ( is => 'rw', isa => 'Str', required => 1 );
54 has 'address' => ( is => 'rw', isa => 'Address' );
55 has 'employees' => ( is => 'rw', isa => 'ArrayRef[Employee]' );
58 my ( $self, $params ) = @_;
59 foreach my $employee ( @{ $self->employees || [] } ) {
60 $employee->employer($self);
64 after 'employees' => sub {
65 my ( $self, $employees ) = @_;
66 foreach my $employee ( @{ $employees || [] } ) {
67 $employee->employer($self);
74 has 'first_name' => ( is => 'rw', isa => 'Str', required => 1 );
75 has 'last_name' => ( is => 'rw', isa => 'Str', required => 1 );
76 has 'middle_initial' => (
77 is => 'rw', isa => 'Str',
78 predicate => 'has_middle_initial'
80 has 'address' => ( is => 'rw', isa => 'Address' );
84 return $self->first_name
86 $self->has_middle_initial
87 ? ' ' . $self->middle_initial . '. '
97 has 'title' => ( is => 'rw', isa => 'Str', required => 1 );
98 has 'employer' => ( is => 'rw', isa => 'Company', weak_ref => 1 );
100 override 'full_name' => sub {
102 super() . ', ' . $self->title;
107 This recipe introduces the C<subtype> sugar function from
108 L<Moose::Util::TypeConstraints>. The C<subtype> function lets you
109 declaratively create type constraints without building an entire
112 In the recipe we also make use of L<Locale::US> and L<Regexp::Common>
113 to build constraints, showing how constraints can make use of existing
114 CPAN tools for data validation.
116 Finally, we introduce the C<required> attribute option.
118 In the C<Address> class we define two subtypes. The first uses the
119 L<Locale::US> module to check the validity of a state. It accepts
120 either a state abbreviation of full name.
122 A state will be passed in as a string, so we make our C<USState> type
123 a subtype of Moose's builtin C<Str> type. This is done using the C<as>
124 sugar. The actual constraint is defined using C<where>. This function
125 accepts a single subroutine reference. That subroutine will be called
126 with the value to be checked in C<$_> (1). It is expected to return a
127 true or false value indicating whether the value is valid for the
130 We can now use the C<USState> type just like Moose's builtin types:
132 has 'state' => ( is => 'rw', isa => 'USState' );
134 When the C<state> attribute is set, the value is checked against the
135 C<USState> constraint. If the value is not valid, an exception will be
138 The next C<subtype>, C<USZipCode>, uses
139 L<Regexp::Common>. L<Regexp::Common> includes a regex for validating
140 US zip codes. We use this constraint for the C<zip_code> attribute.
145 /^$RE{zip}{US}{-extended => 'allow'}$/;
148 Using a subtype instead of requiring a class for each type greatly
149 simplifies the code. We don't really need a class for these types, as
150 they're just strings, but we do want to ensure that they're valid.
152 The type constraints we created are reusable. Type constraints are
153 stored by name in a global registry. This means that we can refer to
154 them in other classes. Because the registry is global, we do recommend
155 that you use some sort of pseudo-namespacing in real applications,
156 like C<MyApp.Type.USState>.
158 These two subtypes allow us to define a simple C<Address> class.
160 Then we define our C<Company> class, which has an address. As we saw
161 in earlier recipes, Moose automatically creates a type constraint for
162 each our classes, so we can use that for the C<Company> class's
163 C<address> attribute:
165 has 'address' => ( is => 'rw', isa => 'Address' );
167 A company also needs a name:
169 has 'name' => ( is => 'rw', isa => 'Str', required => 1 );
171 This introduces a new attribute option, C<required>. If an attribute
172 is required, then it must be passed to the class's constructor, or an
173 exception will be thrown. It's important to understand that a
174 C<required> attribute can still be false or C<undef>, if its type
175 constraint allows that.
177 The next attribute, C<employees>, uses a I<parameterized> type
180 has 'employees' => ( is => 'rw', isa => 'ArrayRef[Employee]' );
182 This constraint says that C<employees> must be an array reference
183 where each element of the array is an C<Employee> object. It's worth
184 noting that an I<empty> array reference also satisfies this
187 Parameterizable type constraints (or "container types"), such as
188 C<ArrayRef[`a]>, can be made more specific with a type parameter. In
189 fact, we can arbitrarily nest these types, producing something like
190 C<HashRef[ArrayRef[Int]]>. However, you can also just use the type by
191 itself, so C<ArrayRef> is legal. (2)
193 If you jump down to the definition of the C<Employee> class, you will
194 see that it has an C<employer> attribute.
196 When we set the C<employees> for a C<Company> we want to make sure
197 that each of these employee objects refers back to the right
198 C<Company> in its C<employer> attribute.
200 To do that, we need to hook into object construction. Moose lets us do
201 this by writing a C<BUILD> method in our class. When your class
202 defined a C<BUILD> method, it will be called immediately after an
203 object construction, but before the object is returned to the caller
206 The C<Company> class uses the C<BUILD> method to ensure that each
207 employee of a company has the proper C<Company> object in its
208 C<employer> attribute:
211 my ( $self, $params ) = @_;
212 foreach my $employee ( @{ $self->employees || [] } ) {
213 $employee->employer($self);
217 The C<BUILD> method is executed after type constraints are checked, so it is
218 safe to assume that if C<< $self->employees >> has a value, it will be an
219 array reference, and that the elements of that array reference will be
222 We also want to make sure that whenever the C<employees> attribute for
223 a C<Company> is changed, we also update the C<employer> for each
226 To do this we can use an C<after> modifier:
228 after 'employees' => sub {
229 my ( $self, $employees ) = @_;
230 foreach my $employee ( @{ $employees || [] } ) {
231 $employee->employer($self);
235 Again, as with the C<BUILD> method, we know that the type constraint check has
236 already happened, so we know that if C<$employees> is defined it will contain
237 an array reference of C<Employee> objects..
239 The B<Person> class does not really demonstrate anything new. It has several
240 C<required> attributes. It also has a C<predicate> method, which we
241 first used in L<recipe 3|Moose::Cookbook::Basics::Recipe3>.
243 The only new feature in the C<Employee> class is the C<override>
246 override 'full_name' => sub {
248 super() . ', ' . $self->title;
251 This is just a sugary alternative to Perl's built in C<SUPER::>
252 feature. However, there is one difference. You cannot pass any
253 arguments to C<super>. Instead, Moose simply passes the same
254 parameters that were passed to the method.
256 A more detailed example of usage can be found in
257 F<t/000_recipes/moose_cookbook_basics_recipe4.t>.
261 This recipe was intentionally longer and more complex. It illustrates
262 how Moose classes can be used together with type constraints, as well
263 as the density of information that you can get out of a small amount
264 of typing when using Moose.
266 This recipe also introduced the C<subtype> function, the C<required>
267 attribute, and the C<override> method modifier.
269 We will revisit type constraints in future recipes, and cover type
278 The value being checked is also passed as the first argument to
279 the C<where> block, so it can be accessed as C<$_[0]>.
283 Note that C<ArrayRef[]> will not work. Moose will not parse this as a
284 container type, and instead you will have a new type named
285 "ArrayRef[]", which doesn't make any sense.
289 The C<BUILD> method is actually called by C<< Moose::Object->BUILDALL
290 >>, which is called by C<< Moose::Object->new >>. The C<BUILDALL>
291 method climbs the object inheritance graph and calls any C<BUILD>
292 methods it finds in the correct order.
298 Stevan Little E<lt>stevan@iinteractive.comE<gt>
300 Dave Rolsky E<lt>autarch@urth.orgE<gt>
302 =head1 COPYRIGHT AND LICENSE
304 Copyright 2006-2010 by Infinity Interactive, Inc.
306 L<http://www.iinteractive.com>
308 This library is free software; you can redistribute it and/or modify
309 it under the same terms as Perl itself.
316 sub get_employee_count { scalar @{(shift)->employees} }
319 use Scalar::Util 'isweak';
325 name => 'Infinity Interactive',
326 address => Address->new(
327 street => '565 Plandome Rd., Suite 307',
334 first_name => 'Jeremy',
336 title => 'President / Senior Consultant',
338 Address->new( city => 'Manhasset', state => 'NY' )
341 first_name => 'Tommy',
343 title => 'Vice President / Senior Developer',
345 Address->new( city => 'New York', state => 'NY' )
348 first_name => 'Stevan',
349 middle_initial => 'C',
350 last_name => 'Little',
351 title => 'Senior Developer',
353 Address->new( city => 'Madison', state => 'CT' )
359 '... created the entire company successfully';
360 isa_ok( $ii, 'Company' );
362 is( $ii->name, 'Infinity Interactive',
363 '... got the right name for the company' );
365 isa_ok( $ii->address, 'Address' );
366 is( $ii->address->street, '565 Plandome Rd., Suite 307',
367 '... got the right street address' );
368 is( $ii->address->city, 'Manhasset', '... got the right city' );
369 is( $ii->address->state, 'NY', '... got the right state' );
370 is( $ii->address->zip_code, 11030, '... got the zip code' );
372 is( $ii->get_employee_count, 3, '... got the right employee count' );
376 isa_ok( $ii->employees->[0], 'Employee' );
377 isa_ok( $ii->employees->[0], 'Person' );
379 is( $ii->employees->[0]->first_name, 'Jeremy',
380 '... got the right first name' );
381 is( $ii->employees->[0]->last_name, 'Shao', '... got the right last name' );
382 ok( !$ii->employees->[0]->has_middle_initial, '... no middle initial' );
383 is( $ii->employees->[0]->middle_initial, undef,
384 '... got the right middle initial value' );
385 is( $ii->employees->[0]->full_name,
386 'Jeremy Shao, President / Senior Consultant',
387 '... got the right full name' );
388 is( $ii->employees->[0]->title, 'President / Senior Consultant',
389 '... got the right title' );
390 is( $ii->employees->[0]->employer, $ii, '... got the right company' );
391 ok( isweak( $ii->employees->[0]->{employer} ),
392 '... the company is a weak-ref' );
394 isa_ok( $ii->employees->[0]->address, 'Address' );
395 is( $ii->employees->[0]->address->city, 'Manhasset',
396 '... got the right city' );
397 is( $ii->employees->[0]->address->state, 'NY', '... got the right state' );
401 isa_ok( $ii->employees->[1], 'Employee' );
402 isa_ok( $ii->employees->[1], 'Person' );
404 is( $ii->employees->[1]->first_name, 'Tommy',
405 '... got the right first name' );
406 is( $ii->employees->[1]->last_name, 'Lee', '... got the right last name' );
407 ok( !$ii->employees->[1]->has_middle_initial, '... no middle initial' );
408 is( $ii->employees->[1]->middle_initial, undef,
409 '... got the right middle initial value' );
410 is( $ii->employees->[1]->full_name,
411 'Tommy Lee, Vice President / Senior Developer',
412 '... got the right full name' );
413 is( $ii->employees->[1]->title, 'Vice President / Senior Developer',
414 '... got the right title' );
415 is( $ii->employees->[1]->employer, $ii, '... got the right company' );
416 ok( isweak( $ii->employees->[1]->{employer} ),
417 '... the company is a weak-ref' );
419 isa_ok( $ii->employees->[1]->address, 'Address' );
420 is( $ii->employees->[1]->address->city, 'New York',
421 '... got the right city' );
422 is( $ii->employees->[1]->address->state, 'NY', '... got the right state' );
426 isa_ok( $ii->employees->[2], 'Employee' );
427 isa_ok( $ii->employees->[2], 'Person' );
429 is( $ii->employees->[2]->first_name, 'Stevan',
430 '... got the right first name' );
431 is( $ii->employees->[2]->last_name, 'Little', '... got the right last name' );
432 ok( $ii->employees->[2]->has_middle_initial, '... got middle initial' );
433 is( $ii->employees->[2]->middle_initial, 'C',
434 '... got the right middle initial value' );
435 is( $ii->employees->[2]->full_name, 'Stevan C. Little, Senior Developer',
436 '... got the right full name' );
437 is( $ii->employees->[2]->title, 'Senior Developer',
438 '... got the right title' );
439 is( $ii->employees->[2]->employer, $ii, '... got the right company' );
440 ok( isweak( $ii->employees->[2]->{employer} ),
441 '... the company is a weak-ref' );
443 isa_ok( $ii->employees->[2]->address, 'Address' );
444 is( $ii->employees->[2]->address->city, 'Madison', '... got the right city' );
445 is( $ii->employees->[2]->address->state, 'CT', '... got the right state' );
450 = Company->new( name => 'Infinity Interactive International' );
451 isa_ok( $new_company, 'Company' );
453 my $ii_employees = $ii->employees;
454 foreach my $employee (@$ii_employees) {
455 is( $employee->employer, $ii, '... has the ii company' );
458 $new_company->employees($ii_employees);
460 foreach my $employee ( @{ $new_company->employees } ) {
461 is( $employee->employer, $new_company,
462 '... has the different company now' );
465 ## check some error conditions for the subtypes
468 Address->new( street => {} ),;
470 '... we die correctly with bad args';
473 Address->new( city => {} ),;
475 '... we die correctly with bad args';
478 Address->new( state => 'British Columbia' ),;
480 '... we die correctly with bad args';
483 Address->new( state => 'Connecticut' ),;
485 '... we live correctly with good args';
488 Address->new( zip_code => 'AF5J6$' ),;
490 '... we die correctly with bad args';
493 Address->new( zip_code => '06443' ),;
495 '... we live correctly with good args';
500 '... we die correctly without good args';
503 Company->new( name => 'Foo' ),;
505 '... we live correctly without good args';
508 Company->new( name => 'Foo', employees => [ Person->new ] ),;
510 '... we die correctly with good args';
513 Company->new( name => 'Foo', employees => [] ),;
515 '... we live correctly with good args';