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 if ( @{ $self->employees || [] } ) {
60 foreach my $employee ( @{ $self->employees } ) {
61 $employee->employer($self);
66 after 'employees' => sub {
67 my ( $self, $employees ) = @_;
69 foreach my $employee ( @{$employees} ) {
70 $employee->employer($self);
78 has 'first_name' => ( is => 'rw', isa => 'Str', required => 1 );
79 has 'last_name' => ( is => 'rw', isa => 'Str', required => 1 );
80 has 'middle_initial' => (
81 is => 'rw', isa => 'Str',
82 predicate => 'has_middle_initial'
84 has 'address' => ( is => 'rw', isa => 'Address' );
88 return $self->first_name
90 $self->has_middle_initial
91 ? ' ' . $self->middle_initial . '. '
101 has 'title' => ( is => 'rw', isa => 'Str', required => 1 );
102 has 'employer' => ( is => 'rw', isa => 'Company', weak_ref => 1 );
104 override 'full_name' => sub {
106 super() . ', ' . $self->title;
111 This recipe introduces the C<subtype> sugar function from
112 L<Moose::Util::TypeConstraints>. The C<subtype> function lets you
113 declaratively create type constraints without building an entire
116 In the recipe we also make use of L<Locale::US> and L<Regexp::Common>
117 to build constraints, showing how constraints can make use of existing
118 CPAN tools for data validation.
120 Finally, we introduce the C<required> attribute option.
122 The the C<Address> class we define two subtypes. The first uses the
123 L<Locale::US> module to check the validity of a state. It accepts
124 either a state abbreviation of full name.
126 A state will be passed in as a string, so we make our C<USState> type
127 a subtype of Moose's builtin C<Str> type. This is done using the C<as>
128 sugar. The actual constraint is defined using C<where>. This function
129 accepts a single subroutine reference. That subroutine will be called
130 with the value to be checked in C<$_> (1). It is expected to return a
131 true or false value indicating whether the value is valid for the
134 We can now use the C<USState> type just like Moose's builtin types:
136 has 'state' => ( is => 'rw', isa => 'USState' );
138 When the C<state> attribute is set, the value is checked against the
139 C<USState> constraint. If the value is not valid, an exception will be
142 The next C<subtype>, C<USZipCode>, uses
143 L<Regexp::Common>. L<Regexp::Common> includes a regex for validating
144 US zip codes. We use this constraint for the C<zip_code> attribute.
149 /^$RE{zip}{US}{-extended => 'allow'}$/;
152 Using a subtype instead of requiring a class for each type greatly
153 simplifies the code. We don't really need a class for these types, as
154 they're just strings, but we do want to ensure that they're valid.
156 The type constraints we created are reusable. Type constraints are
157 stored by name in a global registry. This means that we can refer to
158 them in other classes. Because the registry is global, we do recommend
159 that you use some sort of pseudo-namespacing in real applications,
160 like C<MyApp.Type.USState>.
162 These two subtypes allow us to define a simple C<Address> class.
164 Then we define our C<Company> class, which has an address. As we saw
165 in earlier recipes, Moose automatically creates a type constraint for
166 each our classes, so we can use that for the C<Company> class's
167 C<address> attribute:
169 has 'address' => ( is => 'rw', isa => 'Address' );
171 A company also needs a name:
173 has 'name' => ( is => 'rw', isa => 'Str', required => 1 );
175 This introduces a new attribute option, C<required>. If an attribute
176 is required, then it must be passed to the class's constructor, or an
177 exception will be thrown. It's important to understand that a
178 C<required> attribute can still be false or C<undef>, if its type
179 constraint allows that.
181 The next attribute, C<employees>, uses a I<parameterized> type
184 has 'employees' => ( is => 'rw', isa => 'ArrayRef[Employee]' );
186 This constraint says that C<employees> must be an array reference
187 where each element of the array is an C<Employee> object. It's worth
188 noting that an I<empty> array reference also satisfies this
191 Parameterizable type constraints (or "container types"), such as
192 C<ArrayRef[`a]>, can be made more specific with a type parameter. In
193 fact, we can arbitrarily nest these types, producing something like
194 C<HashRef[ArrayRef[Int]]>. However, you can also just use the type by
195 itself, so C<ArrayRef> is legal. (2)
197 If you jump down to the definition of the C<Employee> class, you will
198 see that it has an C<employer> attribute.
200 When we set the C<employees> for a C<Company> we want to make sure
201 that each of these employee objects refers back to the right
202 C<Company> in its C<employer> attribute.
204 To do that, we need to hook into object construction. Moose lets us do
205 this by writing a C<BUILD> method in our class. When your class
206 defined a C<BUILD> method, it will be called immediately after an
207 object construction, but before the object is returned to the caller
210 The C<Company> class uses the C<BUILD> method to ensure that each
211 employee of a company has the proper C<Company> object in its
212 C<employer> attribute:
215 my ( $self, $params ) = @_;
216 if ( $self->employees ) {
217 foreach my $employee ( @{ $self->employees } ) {
218 $employee->employer($self);
223 The C<BUILD> method is executed after type constraints are checked, so
224 it is safe to assume that C<< $self->employees >> will return an array
225 reference, and that the elements of that array will be C<Employee>
228 We also want to make sure that whenever the C<employees> attribute for
229 a C<Company> is changed, we also update the C<employer> for each
232 To do this we can use an C<after> modifier:
234 after 'employees' => sub {
235 my ( $self, $employees ) = @_;
237 foreach my $employee ( @{$employees} ) {
238 $employee->employer($self);
243 Again, as with the C<BUILD> method, we know that the type constraint
244 check has already happened, so we can just check for definedness on the
245 C<$employees> argument.
247 The B<Person> class does have demonstrate anything new. It has several
248 C<required> attributes. It also has a C<predicate> method, which we
249 first used in L<recipe 3|Moose::Cookbook::Basics::Recipe3>.
251 The only new feature in the C<Employee> class is the C<override>
254 override 'full_name' => sub {
256 super() . ', ' . $self->title;
259 This is just a sugary alternative to Perl's built in C<SUPER::>
260 feature. However, there is one difference. You cannot pass any
261 arguments to C<super>. Instead, Moose simply passes the same
262 parameters that were passed to the method.
264 A more detailed example of usage can be found in
265 F<t/000_recipes/moose_cookbook_basics_recipe4.t>.
269 This recipe was intentionally longer and more complex. It illustrates
270 how Moose classes can be used together with type constraints, as well
271 as the density of information that you can get out of a small amount
272 of typing when using Moose.
274 This recipe also introduced the C<subtype> function, the C<required>
275 attribute, and the C<override> method modifier.
277 We will revisit type constraints in future recipes, and cover type
286 The value being checked is also passed as the first argument to
287 the C<where> block, so it can be accessed as C<$_[0]>.
291 Note that C<ArrayRef[]> will not work. Moose will not parse this as a
292 container type, and instead you will have a new type named
293 "ArrayRef[]", which doesn't make any sense.
297 The C<BUILD> method is actually called by C<< Moose::Object->BUILDALL
298 >>, which is called by C<< Moose::Object->new >>. The C<BUILDALL>
299 method climbs the object inheritance graph and calls any C<BUILD>
300 methods it finds in the correct order.
306 Stevan Little E<lt>stevan@iinteractive.comE<gt>
308 Dave Rolsky E<lt>autarch@urth.orgE<gt>
310 =head1 COPYRIGHT AND LICENSE
312 Copyright 2006-2009 by Infinity Interactive, Inc.
314 L<http://www.iinteractive.com>
316 This library is free software; you can redistribute it and/or modify
317 it under the same terms as Perl itself.
324 sub get_employee_count { scalar @{(shift)->employees} }
327 use Scalar::Util 'isweak';
333 name => 'Infinity Interactive',
334 address => Address->new(
335 street => '565 Plandome Rd., Suite 307',
342 first_name => 'Jeremy',
344 title => 'President / Senior Consultant',
346 Address->new( city => 'Manhasset', state => 'NY' )
349 first_name => 'Tommy',
351 title => 'Vice President / Senior Developer',
353 Address->new( city => 'New York', state => 'NY' )
356 first_name => 'Stevan',
357 middle_initial => 'C',
358 last_name => 'Little',
359 title => 'Senior Developer',
361 Address->new( city => 'Madison', state => 'CT' )
367 '... created the entire company successfully';
368 isa_ok( $ii, 'Company' );
370 is( $ii->name, 'Infinity Interactive',
371 '... got the right name for the company' );
373 isa_ok( $ii->address, 'Address' );
374 is( $ii->address->street, '565 Plandome Rd., Suite 307',
375 '... got the right street address' );
376 is( $ii->address->city, 'Manhasset', '... got the right city' );
377 is( $ii->address->state, 'NY', '... got the right state' );
378 is( $ii->address->zip_code, 11030, '... got the zip code' );
380 is( $ii->get_employee_count, 3, '... got the right employee count' );
384 isa_ok( $ii->employees->[0], 'Employee' );
385 isa_ok( $ii->employees->[0], 'Person' );
387 is( $ii->employees->[0]->first_name, 'Jeremy',
388 '... got the right first name' );
389 is( $ii->employees->[0]->last_name, 'Shao', '... got the right last name' );
390 ok( !$ii->employees->[0]->has_middle_initial, '... no middle initial' );
391 is( $ii->employees->[0]->middle_initial, undef,
392 '... got the right middle initial value' );
393 is( $ii->employees->[0]->full_name,
394 'Jeremy Shao, President / Senior Consultant',
395 '... got the right full name' );
396 is( $ii->employees->[0]->title, 'President / Senior Consultant',
397 '... got the right title' );
398 is( $ii->employees->[0]->employer, $ii, '... got the right company' );
399 ok( isweak( $ii->employees->[0]->{employer} ),
400 '... the company is a weak-ref' );
402 isa_ok( $ii->employees->[0]->address, 'Address' );
403 is( $ii->employees->[0]->address->city, 'Manhasset',
404 '... got the right city' );
405 is( $ii->employees->[0]->address->state, 'NY', '... got the right state' );
409 isa_ok( $ii->employees->[1], 'Employee' );
410 isa_ok( $ii->employees->[1], 'Person' );
412 is( $ii->employees->[1]->first_name, 'Tommy',
413 '... got the right first name' );
414 is( $ii->employees->[1]->last_name, 'Lee', '... got the right last name' );
415 ok( !$ii->employees->[1]->has_middle_initial, '... no middle initial' );
416 is( $ii->employees->[1]->middle_initial, undef,
417 '... got the right middle initial value' );
418 is( $ii->employees->[1]->full_name,
419 'Tommy Lee, Vice President / Senior Developer',
420 '... got the right full name' );
421 is( $ii->employees->[1]->title, 'Vice President / Senior Developer',
422 '... got the right title' );
423 is( $ii->employees->[1]->employer, $ii, '... got the right company' );
424 ok( isweak( $ii->employees->[1]->{employer} ),
425 '... the company is a weak-ref' );
427 isa_ok( $ii->employees->[1]->address, 'Address' );
428 is( $ii->employees->[1]->address->city, 'New York',
429 '... got the right city' );
430 is( $ii->employees->[1]->address->state, 'NY', '... got the right state' );
434 isa_ok( $ii->employees->[2], 'Employee' );
435 isa_ok( $ii->employees->[2], 'Person' );
437 is( $ii->employees->[2]->first_name, 'Stevan',
438 '... got the right first name' );
439 is( $ii->employees->[2]->last_name, 'Little', '... got the right last name' );
440 ok( $ii->employees->[2]->has_middle_initial, '... got middle initial' );
441 is( $ii->employees->[2]->middle_initial, 'C',
442 '... got the right middle initial value' );
443 is( $ii->employees->[2]->full_name, 'Stevan C. Little, Senior Developer',
444 '... got the right full name' );
445 is( $ii->employees->[2]->title, 'Senior Developer',
446 '... got the right title' );
447 is( $ii->employees->[2]->employer, $ii, '... got the right company' );
448 ok( isweak( $ii->employees->[2]->{employer} ),
449 '... the company is a weak-ref' );
451 isa_ok( $ii->employees->[2]->address, 'Address' );
452 is( $ii->employees->[2]->address->city, 'Madison', '... got the right city' );
453 is( $ii->employees->[2]->address->state, 'CT', '... got the right state' );
458 = Company->new( name => 'Infinity Interactive International' );
459 isa_ok( $new_company, 'Company' );
461 my $ii_employees = $ii->employees;
462 foreach my $employee (@$ii_employees) {
463 is( $employee->employer, $ii, '... has the ii company' );
466 $new_company->employees($ii_employees);
468 foreach my $employee ( @{ $new_company->employees } ) {
469 is( $employee->employer, $new_company,
470 '... has the different company now' );
473 ## check some error conditions for the subtypes
476 Address->new( street => {} ),;
478 '... we die correctly with bad args';
481 Address->new( city => {} ),;
483 '... we die correctly with bad args';
486 Address->new( state => 'British Columbia' ),;
488 '... we die correctly with bad args';
491 Address->new( state => 'Connecticut' ),;
493 '... we live correctly with good args';
496 Address->new( zip_code => 'AF5J6$' ),;
498 '... we die correctly with bad args';
501 Address->new( zip_code => '06443' ),;
503 '... we live correctly with good args';
508 '... we die correctly without good args';
511 Company->new( name => 'Foo' ),;
513 '... we live correctly without good args';
516 Company->new( name => 'Foo', employees => [ Person->new ] ),;
518 '... we die correctly with good args';
521 Company->new( name => 'Foo', employees => [] ),;
523 '... we live correctly with good args';