lib/Moose/Cookbook/Basics/Recipe4.pod

   1
   2 =pod
   3
   4 =begin testing-SETUP
   5
   6 use Test::Requires {
   7     'Locale::US'     => '0',
   8     'Regexp::Common' => '0',
   9 };
  10
  11 =end testing-SETUP
  12
  13 =head1 NAME
  14
  15 Moose::Cookbook::Basics::Recipe4 - Subtypes, and modeling a simple B<Company> class hierarchy
  16
  17 =head1 SYNOPSIS
  18
  19   package Address;
  20   use Moose;
  21   use Moose::Util::TypeConstraints;
  22
  23   use Locale::US;
  24   use Regexp::Common 'zip';
  25
  26   my $STATES = Locale::US->new;
  27   subtype 'USState'
  28       => as Str
  29       => where {
  30              (    exists $STATES->{code2state}{ uc($_) }
  31                || exists $STATES->{state2code}{ uc($_) } );
  32          };
  33
  34   subtype 'USZipCode'
  35       => as Value
  36       => where {
  37              /^$RE{zip}{US}{-extended => 'allow'}$/;
  38          };
  39
  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' );
  44
  45   package Company;
  46   use Moose;
  47   use Moose::Util::TypeConstraints;
  48
  49   has 'name' => ( is => 'rw', isa => 'Str', required => 1 );
  50   has 'address'   => ( is => 'rw', isa => 'Address' );
  51   has 'employees' => ( is => 'rw', isa => 'ArrayRef[Employee]' );
  52
  53   sub BUILD {
  54       my ( $self, $params ) = @_;
  55       foreach my $employee ( @{ $self->employees || [] } ) {
  56           $employee->employer($self);
  57       }
  58   }
  59
  60   after 'employees' => sub {
  61       my ( $self, $employees ) = @_;
  62       foreach my $employee ( @{ $employees || [] } ) {
  63           $employee->employer($self);
  64       }
  65   };
  66
  67   package Person;
  68   use Moose;
  69
  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'
  75   );
  76   has 'address' => ( is => 'rw', isa => 'Address' );
  77
  78   sub full_name {
  79       my $self = shift;
  80       return $self->first_name
  81           . (
  82           $self->has_middle_initial
  83           ? ' ' . $self->middle_initial . '. '
  84           : ' '
  85           ) . $self->last_name;
  86   }
  87
  88   package Employee;
  89   use Moose;
  90
  91   extends 'Person';
  92
  93   has 'title'    => ( is => 'rw', isa => 'Str',     required => 1 );
  94   has 'employer' => ( is => 'rw', isa => 'Company', weak_ref => 1 );
  95
  96   override 'full_name' => sub {
  97       my $self = shift;
  98       super() . ', ' . $self->title;
  99   };
 100
 101 =head1 DESCRIPTION
 102
 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
 106 class.
 107
 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.
 111
 112 Finally, we introduce the C<required> attribute option.
 113
 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.
 117
 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
 124 type.
 125
 126 We can now use the C<USState> type just like Moose's builtin types:
 127
 128   has 'state'    => ( is => 'rw', isa => 'USState' );
 129
 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
 132 thrown.
 133
 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.
 137
 138   subtype 'USZipCode'
 139       => as Value
 140       => where {
 141              /^$RE{zip}{US}{-extended => 'allow'}$/;
 142          };
 143
 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.
 147
 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>.
 153
 154 These two subtypes allow us to define a simple C<Address> class.
 155
 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:
 160
 161   has 'address'   => ( is => 'rw', isa => 'Address' );
 162
 163 A company also needs a name:
 164
 165   has 'name' => ( is => 'rw', isa => 'Str', required => 1 );
 166
 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.
 172
 173 The next attribute, C<employees>, uses a I<parameterized> type
 174 constraint:
 175
 176   has 'employees' => ( is => 'rw', isa => 'ArrayRef[Employee]' );
 177
 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
 181 constraint.
 182
 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)
 188
 189 If you jump down to the definition of the C<Employee> class, you will
 190 see that it has an C<employer> attribute.
 191
 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.
 195
 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
 200 (3).
 201
 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:
 205
 206   sub BUILD {
 207       my ( $self, $params ) = @_;
 208       foreach my $employee ( @{ $self->employees || [] } ) {
 209           $employee->employer($self);
 210       }
 211   }
 212
 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
 216 C<Employee> objects.
 217
 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
 220 employee.
 221
 222 To do this we can use an C<after> modifier:
 223
 224   after 'employees' => sub {
 225       my ( $self, $employees ) = @_;
 226       foreach my $employee ( @{ $employees || [] } ) {
 227           $employee->employer($self);
 228       }
 229   };
 230
 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..
 234
 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>.
 238
 239 The only new feature in the C<Employee> class is the C<override>
 240 method modifier:
 241
 242   override 'full_name' => sub {
 243       my $self = shift;
 244       super() . ', ' . $self->title;
 245   };
 246
 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.
 251
 252 A more detailed example of usage can be found in
 253 F<t/000_recipes/moose_cookbook_basics_recipe4.t>.
 254
 255 =head1 CONCLUSION
 256
 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.
 261
 262 This recipe also introduced the C<subtype> function, the C<required>
 263 attribute, and the C<override> method modifier.
 264
 265 We will revisit type constraints in future recipes, and cover type
 266 coercion as well.
 267
 268 =head1 FOOTNOTES
 269
 270 =over 4
 271
 272 =item (1)
 273
 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]>.
 276
 277 =item (2)
 278
 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.
 282
 283 =item (3)
 284
 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.
 289
 290 =back
 291
 292 =head1 AUTHORS
 293
 294 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 295
 296 Dave Rolsky E<lt>autarch@urth.orgE<gt>
 297
 298 =head1 COPYRIGHT AND LICENSE
 299
 300 Copyright 2006-2010 by Infinity Interactive, Inc.
 301
 302 L<http://www.iinteractive.com>
 303
 304 This library is free software; you can redistribute it and/or modify
 305 it under the same terms as Perl itself.
 306
 307 =begin testing
 308
 309 {
 310     package Company;
 311
 312     sub get_employee_count { scalar @{(shift)->employees} }
 313 }
 314
 315 use Scalar::Util 'isweak';
 316
 317 my $ii;
 318 lives_ok {
 319     $ii = Company->new(
 320         {
 321             name    => 'Infinity Interactive',
 322             address => Address->new(
 323                 street   => '565 Plandome Rd., Suite 307',
 324                 city     => 'Manhasset',
 325                 state    => 'NY',
 326                 zip_code => '11030'
 327             ),
 328             employees => [
 329                 Employee->new(
 330                     first_name => 'Jeremy',
 331                     last_name  => 'Shao',
 332                     title      => 'President / Senior Consultant',
 333                     address =>
 334                         Address->new( city => 'Manhasset', state => 'NY' )
 335                 ),
 336                 Employee->new(
 337                     first_name => 'Tommy',
 338                     last_name  => 'Lee',
 339                     title      => 'Vice President / Senior Developer',
 340                     address =>
 341                         Address->new( city => 'New York', state => 'NY' )
 342                 ),
 343                 Employee->new(
 344                     first_name     => 'Stevan',
 345                     middle_initial => 'C',
 346                     last_name      => 'Little',
 347                     title          => 'Senior Developer',
 348                     address =>
 349                         Address->new( city => 'Madison', state => 'CT' )
 350                 ),
 351             ]
 352         }
 353     );
 354 }
 355 '... created the entire company successfully';
 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
 463 dies_ok {
 464     Address->new( street => {} ),;
 465 }
 466 '... we die correctly with bad args';
 467
 468 dies_ok {
 469     Address->new( city => {} ),;
 470 }
 471 '... we die correctly with bad args';
 472
 473 dies_ok {
 474     Address->new( state => 'British Columbia' ),;
 475 }
 476 '... we die correctly with bad args';
 477
 478 lives_ok {
 479     Address->new( state => 'Connecticut' ),;
 480 }
 481 '... we live correctly with good args';
 482
 483 dies_ok {
 484     Address->new( zip_code => 'AF5J6$' ),;
 485 }
 486 '... we die correctly with bad args';
 487
 488 lives_ok {
 489     Address->new( zip_code => '06443' ),;
 490 }
 491 '... we live correctly with good args';
 492
 493 dies_ok {
 494     Company->new(),;
 495 }
 496 '... we die correctly without good args';
 497
 498 lives_ok {
 499     Company->new( name => 'Foo' ),;
 500 }
 501 '... we live correctly without good args';
 502
 503 dies_ok {
 504     Company->new( name => 'Foo', employees => [ Person->new ] ),;
 505 }
 506 '... we die correctly with good args';
 507
 508 lives_ok {
 509     Company->new( name => 'Foo', employees => [] ),;
 510 }
 511 '... we live correctly with good args';
 512
 513 =end testing
 514
 515 =cut