1 package Moose::Cookbook::Basics::Recipe4;
3 # ABSTRACT: Subtypes, and modeling a simple B<Company> class hierarchy
14 'Regexp::Common' => '0',
23 use Moose::Util::TypeConstraints;
26 use Regexp::Common 'zip';
28 my $STATES = Locale::US->new;
32 ( exists $STATES->{code2state}{ uc($_) }
33 || exists $STATES->{state2code}{ uc($_) } );
39 /^$RE{zip}{US}{-extended => 'allow'}$/;
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' );
49 use Moose::Util::TypeConstraints;
51 has 'name' => ( is => 'rw', isa => 'Str', required => 1 );
52 has 'address' => ( is => 'rw', isa => 'Address' );
53 has 'employees' => ( is => 'rw', isa => 'ArrayRef[Employee]' );
56 my ( $self, $params ) = @_;
57 foreach my $employee ( @{ $self->employees || [] } ) {
58 $employee->employer($self);
62 after 'employees' => sub {
63 my ( $self, $employees ) = @_;
64 foreach my $employee ( @{ $employees || [] } ) {
65 $employee->employer($self);
72 has 'first_name' => ( is => 'rw', isa => 'Str', required => 1 );
73 has 'last_name' => ( is => 'rw', isa => 'Str', required => 1 );
74 has 'middle_initial' => (
75 is => 'rw', isa => 'Str',
76 predicate => 'has_middle_initial'
78 has 'address' => ( is => 'rw', isa => 'Address' );
82 return $self->first_name
84 $self->has_middle_initial
85 ? ' ' . $self->middle_initial . '. '
95 has 'title' => ( is => 'rw', isa => 'Str', required => 1 );
96 has 'employer' => ( is => 'rw', isa => 'Company', weak_ref => 1 );
98 override 'full_name' => sub {
100 super() . ', ' . $self->title;
105 This recipe introduces the C<subtype> sugar function from
106 L<Moose::Util::TypeConstraints>. The C<subtype> function lets you
107 declaratively create type constraints without building an entire
110 In the recipe we also make use of L<Locale::US> and L<Regexp::Common>
111 to build constraints, showing how constraints can make use of existing
112 CPAN tools for data validation.
114 Finally, we introduce the C<required> attribute option.
116 In the C<Address> class we define two subtypes. The first uses the
117 L<Locale::US> module to check the validity of a state. It accepts
118 either a state abbreviation of full name.
120 A state will be passed in as a string, so we make our C<USState> type
121 a subtype of Moose's builtin C<Str> type. This is done using the C<as>
122 sugar. The actual constraint is defined using C<where>. This function
123 accepts a single subroutine reference. That subroutine will be called
124 with the value to be checked in C<$_> (1). It is expected to return a
125 true or false value indicating whether the value is valid for the
128 We can now use the C<USState> type just like Moose's builtin types:
130 has 'state' => ( is => 'rw', isa => 'USState' );
132 When the C<state> attribute is set, the value is checked against the
133 C<USState> constraint. If the value is not valid, an exception will be
136 The next C<subtype>, C<USZipCode>, uses
137 L<Regexp::Common>. L<Regexp::Common> includes a regex for validating
138 US zip codes. We use this constraint for the C<zip_code> attribute.
143 /^$RE{zip}{US}{-extended => 'allow'}$/;
146 Using a subtype instead of requiring a class for each type greatly
147 simplifies the code. We don't really need a class for these types, as
148 they're just strings, but we do want to ensure that they're valid.
150 The type constraints we created are reusable. Type constraints are
151 stored by name in a global registry. This means that we can refer to
152 them in other classes. Because the registry is global, we do recommend
153 that you use some sort of pseudo-namespacing in real applications,
154 like C<MyApp.Type.USState>.
156 These two subtypes allow us to define a simple C<Address> class.
158 Then we define our C<Company> class, which has an address. As we saw
159 in earlier recipes, Moose automatically creates a type constraint for
160 each our classes, so we can use that for the C<Company> class's
161 C<address> attribute:
163 has 'address' => ( is => 'rw', isa => 'Address' );
165 A company also needs a name:
167 has 'name' => ( is => 'rw', isa => 'Str', required => 1 );
169 This introduces a new attribute option, C<required>. If an attribute
170 is required, then it must be passed to the class's constructor, or an
171 exception will be thrown. It's important to understand that a
172 C<required> attribute can still be false or C<undef>, if its type
173 constraint allows that.
175 The next attribute, C<employees>, uses a I<parameterized> type
178 has 'employees' => ( is => 'rw', isa => 'ArrayRef[Employee]' );
180 This constraint says that C<employees> must be an array reference
181 where each element of the array is an C<Employee> object. It's worth
182 noting that an I<empty> array reference also satisfies this
185 Parameterizable type constraints (or "container types"), such as
186 C<ArrayRef[`a]>, can be made more specific with a type parameter. In
187 fact, we can arbitrarily nest these types, producing something like
188 C<HashRef[ArrayRef[Int]]>. However, you can also just use the type by
189 itself, so C<ArrayRef> is legal. (2)
191 If you jump down to the definition of the C<Employee> class, you will
192 see that it has an C<employer> attribute.
194 When we set the C<employees> for a C<Company> we want to make sure
195 that each of these employee objects refers back to the right
196 C<Company> in its C<employer> attribute.
198 To do that, we need to hook into object construction. Moose lets us do
199 this by writing a C<BUILD> method in our class. When your class
200 defined a C<BUILD> method, it will be called immediately after an
201 object construction, but before the object is returned to the caller
204 The C<Company> class uses the C<BUILD> method to ensure that each
205 employee of a company has the proper C<Company> object in its
206 C<employer> attribute:
209 my ( $self, $params ) = @_;
210 foreach my $employee ( @{ $self->employees || [] } ) {
211 $employee->employer($self);
215 The C<BUILD> method is executed after type constraints are checked, so it is
216 safe to assume that if C<< $self->employees >> has a value, it will be an
217 array reference, and that the elements of that array reference will be
220 We also want to make sure that whenever the C<employees> attribute for
221 a C<Company> is changed, we also update the C<employer> for each
224 To do this we can use an C<after> modifier:
226 after 'employees' => sub {
227 my ( $self, $employees ) = @_;
228 foreach my $employee ( @{ $employees || [] } ) {
229 $employee->employer($self);
233 Again, as with the C<BUILD> method, we know that the type constraint check has
234 already happened, so we know that if C<$employees> is defined it will contain
235 an array reference of C<Employee> objects..
237 The B<Person> class does not really demonstrate anything new. It has several
238 C<required> attributes. It also has a C<predicate> method, which we
239 first used in L<recipe 3|Moose::Cookbook::Basics::Recipe3>.
241 The only new feature in the C<Employee> class is the C<override>
244 override 'full_name' => sub {
246 super() . ', ' . $self->title;
249 This is just a sugary alternative to Perl's built in C<SUPER::>
250 feature. However, there is one difference. You cannot pass any
251 arguments to C<super>. Instead, Moose simply passes the same
252 parameters that were passed to the method.
254 A more detailed example of usage can be found in
255 F<t/recipes/moose_cookbook_basics_recipe4.t>.
259 This recipe was intentionally longer and more complex. It illustrates
260 how Moose classes can be used together with type constraints, as well
261 as the density of information that you can get out of a small amount
262 of typing when using Moose.
264 This recipe also introduced the C<subtype> function, the C<required>
265 attribute, and the C<override> method modifier.
267 We will revisit type constraints in future recipes, and cover type
276 The value being checked is also passed as the first argument to
277 the C<where> block, so it can be accessed as C<$_[0]>.
281 Note that C<ArrayRef[]> will not work. Moose will not parse this as a
282 container type, and instead you will have a new type named
283 "ArrayRef[]", which doesn't make any sense.
287 The C<BUILD> method is actually called by C<< Moose::Object->new >>. It climbs
288 the object inheritance graph and calls any C<BUILD> methods it finds in the
298 sub get_employee_count { scalar @{(shift)->employees} }
301 use Scalar::Util 'isweak';
308 name => 'Infinity Interactive',
309 address => Address->new(
310 street => '565 Plandome Rd., Suite 307',
317 first_name => 'Jeremy',
319 title => 'President / Senior Consultant',
320 address => Address->new(
321 city => 'Manhasset', state => 'NY'
325 first_name => 'Tommy',
327 title => 'Vice President / Senior Developer',
329 Address->new( city => 'New York', state => 'NY' )
332 first_name => 'Stevan',
333 middle_initial => 'C',
334 last_name => 'Little',
335 title => 'Senior Developer',
337 Address->new( city => 'Madison', state => 'CT' )
344 '... created the entire company successfully'
347 isa_ok( $ii, 'Company' );
349 is( $ii->name, 'Infinity Interactive',
350 '... got the right name for the company' );
352 isa_ok( $ii->address, 'Address' );
353 is( $ii->address->street, '565 Plandome Rd., Suite 307',
354 '... got the right street address' );
355 is( $ii->address->city, 'Manhasset', '... got the right city' );
356 is( $ii->address->state, 'NY', '... got the right state' );
357 is( $ii->address->zip_code, 11030, '... got the zip code' );
359 is( $ii->get_employee_count, 3, '... got the right employee count' );
363 isa_ok( $ii->employees->[0], 'Employee' );
364 isa_ok( $ii->employees->[0], 'Person' );
366 is( $ii->employees->[0]->first_name, 'Jeremy',
367 '... got the right first name' );
368 is( $ii->employees->[0]->last_name, 'Shao', '... got the right last name' );
369 ok( !$ii->employees->[0]->has_middle_initial, '... no middle initial' );
370 is( $ii->employees->[0]->middle_initial, undef,
371 '... got the right middle initial value' );
372 is( $ii->employees->[0]->full_name,
373 'Jeremy Shao, President / Senior Consultant',
374 '... got the right full name' );
375 is( $ii->employees->[0]->title, 'President / Senior Consultant',
376 '... got the right title' );
377 is( $ii->employees->[0]->employer, $ii, '... got the right company' );
378 ok( isweak( $ii->employees->[0]->{employer} ),
379 '... the company is a weak-ref' );
381 isa_ok( $ii->employees->[0]->address, 'Address' );
382 is( $ii->employees->[0]->address->city, 'Manhasset',
383 '... got the right city' );
384 is( $ii->employees->[0]->address->state, 'NY', '... got the right state' );
388 isa_ok( $ii->employees->[1], 'Employee' );
389 isa_ok( $ii->employees->[1], 'Person' );
391 is( $ii->employees->[1]->first_name, 'Tommy',
392 '... got the right first name' );
393 is( $ii->employees->[1]->last_name, 'Lee', '... got the right last name' );
394 ok( !$ii->employees->[1]->has_middle_initial, '... no middle initial' );
395 is( $ii->employees->[1]->middle_initial, undef,
396 '... got the right middle initial value' );
397 is( $ii->employees->[1]->full_name,
398 'Tommy Lee, Vice President / Senior Developer',
399 '... got the right full name' );
400 is( $ii->employees->[1]->title, 'Vice President / Senior Developer',
401 '... got the right title' );
402 is( $ii->employees->[1]->employer, $ii, '... got the right company' );
403 ok( isweak( $ii->employees->[1]->{employer} ),
404 '... the company is a weak-ref' );
406 isa_ok( $ii->employees->[1]->address, 'Address' );
407 is( $ii->employees->[1]->address->city, 'New York',
408 '... got the right city' );
409 is( $ii->employees->[1]->address->state, 'NY', '... got the right state' );
413 isa_ok( $ii->employees->[2], 'Employee' );
414 isa_ok( $ii->employees->[2], 'Person' );
416 is( $ii->employees->[2]->first_name, 'Stevan',
417 '... got the right first name' );
418 is( $ii->employees->[2]->last_name, 'Little', '... got the right last name' );
419 ok( $ii->employees->[2]->has_middle_initial, '... got middle initial' );
420 is( $ii->employees->[2]->middle_initial, 'C',
421 '... got the right middle initial value' );
422 is( $ii->employees->[2]->full_name, 'Stevan C. Little, Senior Developer',
423 '... got the right full name' );
424 is( $ii->employees->[2]->title, 'Senior Developer',
425 '... got the right title' );
426 is( $ii->employees->[2]->employer, $ii, '... got the right company' );
427 ok( isweak( $ii->employees->[2]->{employer} ),
428 '... the company is a weak-ref' );
430 isa_ok( $ii->employees->[2]->address, 'Address' );
431 is( $ii->employees->[2]->address->city, 'Madison', '... got the right city' );
432 is( $ii->employees->[2]->address->state, 'CT', '... got the right state' );
437 = Company->new( name => 'Infinity Interactive International' );
438 isa_ok( $new_company, 'Company' );
440 my $ii_employees = $ii->employees;
441 foreach my $employee (@$ii_employees) {
442 is( $employee->employer, $ii, '... has the ii company' );
445 $new_company->employees($ii_employees);
447 foreach my $employee ( @{ $new_company->employees } ) {
448 is( $employee->employer, $new_company,
449 '... has the different company now' );
452 ## check some error conditions for the subtypes
456 Address->new( street => {} ),;
459 '... we die correctly with bad args'
464 Address->new( city => {} ),;
467 '... we die correctly with bad args'
472 Address->new( state => 'British Columbia' ),;
475 '... we die correctly with bad args'
480 Address->new( state => 'Connecticut' ),;
483 '... we live correctly with good args'
488 Address->new( zip_code => 'AF5J6$' ),;
491 '... we die correctly with bad args'
496 Address->new( zip_code => '06443' ),;
499 '... we live correctly with good args'
507 '... we die correctly without good args'
512 Company->new( name => 'Foo' ),;
515 '... we live correctly without good args'
520 Company->new( name => 'Foo', employees => [ Person->new ] ),;
523 '... we die correctly with good args'
528 Company->new( name => 'Foo', employees => [] ),;
531 '... we live correctly with good args'