lib/Moose/Cookbook/Basics/Recipe4.pod

   1
   2 =pod
   3
   4 =begin testing-SETUP
   5
   6 BEGIN {
   7     eval 'use Regexp::Common; use Locale::US;';
   8     if ($@) {
   9         diag 'Regexp::Common & Locale::US required for this test';
  10         ok(1);
  11         exit 0;
  12     }
  13 }
  14
  15 =end testing-SETUP
  16
  17 =head1 NAME
  18
  19 Moose::Cookbook::Basics::Recipe4 - Subtypes, and modeling a simple B<Company> class hierarchy
  20
  21 =head1 SYNOPSIS
  22
  23   package Address;
  24   use Moose;
  25   use Moose::Util::TypeConstraints;
  26
  27   use Locale::US;
  28   use Regexp::Common 'zip';
  29
  30   my $STATES = Locale::US->new;
  31   subtype 'USState'
  32       => as Str
  33       => where {
  34              (    exists $STATES->{code2state}{ uc($_) }
  35                || exists $STATES->{state2code}{ uc($_) } );
  36          };
  37
  38   subtype 'USZipCode'
  39       => as Value
  40       => where {
  41              /^$RE{zip}{US}{-extended => 'allow'}$/;
  42          };
  43
  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' );
  48
  49   package Company;
  50   use Moose;
  51   use Moose::Util::TypeConstraints;
  52
  53   has 'name' => ( is => 'rw', isa => 'Str', required => 1 );
  54   has 'address'   => ( is => 'rw', isa => 'Address' );
  55   has 'employees' => ( is => 'rw', isa => 'ArrayRef[Employee]' );
  56
  57   sub BUILD {
  58       my ( $self, $params ) = @_;
  59       foreach my $employee ( @{ $self->employees || [] } ) {
  60           $employee->employer($self);
  61       }
  62   }
  63
  64   after 'employees' => sub {
  65       my ( $self, $employees ) = @_;
  66       foreach my $employee ( @{ $employees || [] } ) {
  67           $employee->employer($self);
  68       }
  69   };
  70
  71   package Person;
  72   use Moose;
  73
  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'
  79   );
  80   has 'address' => ( is => 'rw', isa => 'Address' );
  81
  82   sub full_name {
  83       my $self = shift;
  84       return $self->first_name
  85           . (
  86           $self->has_middle_initial
  87           ? ' ' . $self->middle_initial . '. '
  88           : ' '
  89           ) . $self->last_name;
  90   }
  91
  92   package Employee;
  93   use Moose;
  94
  95   extends 'Person';
  96
  97   has 'title'    => ( is => 'rw', isa => 'Str',     required => 1 );
  98   has 'employer' => ( is => 'rw', isa => 'Company', weak_ref => 1 );
  99
 100   override 'full_name' => sub {
 101       my $self = shift;
 102       super() . ', ' . $self->title;
 103   };
 104
 105 =head1 DESCRIPTION
 106
 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
 110 class.
 111
 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.
 115
 116 Finally, we introduce the C<required> attribute option.
 117
 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.
 121
 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
 128 type.
 129
 130 We can now use the C<USState> type just like Moose's builtin types:
 131
 132   has 'state'    => ( is => 'rw', isa => 'USState' );
 133
 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
 136 thrown.
 137
 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.
 141
 142   subtype 'USZipCode'
 143       => as Value
 144       => where {
 145              /^$RE{zip}{US}{-extended => 'allow'}$/;
 146          };
 147
 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.
 151
 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>.
 157
 158 These two subtypes allow us to define a simple C<Address> class.
 159
 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:
 164
 165   has 'address'   => ( is => 'rw', isa => 'Address' );
 166
 167 A company also needs a name:
 168
 169   has 'name' => ( is => 'rw', isa => 'Str', required => 1 );
 170
 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.
 176
 177 The next attribute, C<employees>, uses a I<parameterized> type
 178 constraint:
 179
 180   has 'employees' => ( is => 'rw', isa => 'ArrayRef[Employee]' );
 181
 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
 185 constraint.
 186
 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)
 192
 193 If you jump down to the definition of the C<Employee> class, you will
 194 see that it has an C<employer> attribute.
 195
 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.
 199
 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
 204 (3).
 205
 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:
 209
 210   sub BUILD {
 211       my ( $self, $params ) = @_;
 212       foreach my $employee ( @{ $self->employees || [] } ) {
 213           $employee->employer($self);
 214       }
 215   }
 216
 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
 220 C<Employee> objects.
 221
 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
 224 employee.
 225
 226 To do this we can use an C<after> modifier:
 227
 228   after 'employees' => sub {
 229       my ( $self, $employees ) = @_;
 230       foreach my $employee ( @{ $employees || [] } ) {
 231           $employee->employer($self);
 232       }
 233   };
 234
 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..
 238
 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>.
 242
 243 The only new feature in the C<Employee> class is the C<override>
 244 method modifier:
 245
 246   override 'full_name' => sub {
 247       my $self = shift;
 248       super() . ', ' . $self->title;
 249   };
 250
 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.
 255
 256 A more detailed example of usage can be found in
 257 F<t/000_recipes/moose_cookbook_basics_recipe4.t>.
 258
 259 =head1 CONCLUSION
 260
 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.
 265
 266 This recipe also introduced the C<subtype> function, the C<required>
 267 attribute, and the C<override> method modifier.
 268
 269 We will revisit type constraints in future recipes, and cover type
 270 coercion as well.
 271
 272 =head1 FOOTNOTES
 273
 274 =over 4
 275
 276 =item (1)
 277
 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]>.
 280
 281 =item (2)
 282
 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.
 286
 287 =item (3)
 288
 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.
 293
 294 =back
 295
 296 =head1 AUTHORS
 297
 298 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 299
 300 Dave Rolsky E<lt>autarch@urth.orgE<gt>
 301
 302 =head1 COPYRIGHT AND LICENSE
 303
 304 Copyright 2006-2010 by Infinity Interactive, Inc.
 305
 306 L<http://www.iinteractive.com>
 307
 308 This library is free software; you can redistribute it and/or modify
 309 it under the same terms as Perl itself.
 310
 311 =begin testing
 312
 313 {
 314     package Company;
 315
 316     sub get_employee_count { scalar @{(shift)->employees} }
 317 }
 318
 319 use Scalar::Util 'isweak';
 320
 321 my $ii;
 322 lives_ok {
 323     $ii = Company->new(
 324         {
 325             name    => 'Infinity Interactive',
 326             address => Address->new(
 327                 street   => '565 Plandome Rd., Suite 307',
 328                 city     => 'Manhasset',
 329                 state    => 'NY',
 330                 zip_code => '11030'
 331             ),
 332             employees => [
 333                 Employee->new(
 334                     first_name => 'Jeremy',
 335                     last_name  => 'Shao',
 336                     title      => 'President / Senior Consultant',
 337                     address =>
 338                         Address->new( city => 'Manhasset', state => 'NY' )
 339                 ),
 340                 Employee->new(
 341                     first_name => 'Tommy',
 342                     last_name  => 'Lee',
 343                     title      => 'Vice President / Senior Developer',
 344                     address =>
 345                         Address->new( city => 'New York', state => 'NY' )
 346                 ),
 347                 Employee->new(
 348                     first_name     => 'Stevan',
 349                     middle_initial => 'C',
 350                     last_name      => 'Little',
 351                     title          => 'Senior Developer',
 352                     address =>
 353                         Address->new( city => 'Madison', state => 'CT' )
 354                 ),
 355             ]
 356         }
 357     );
 358 }
 359 '... created the entire company successfully';
 360 isa_ok( $ii, 'Company' );
 361
 362 is( $ii->name, 'Infinity Interactive',
 363     '... got the right name for the company' );
 364
 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' );
 371
 372 is( $ii->get_employee_count, 3, '... got the right employee count' );
 373
 374 # employee #1
 375
 376 isa_ok( $ii->employees->[0], 'Employee' );
 377 isa_ok( $ii->employees->[0], 'Person' );
 378
 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' );
 393
 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' );
 398
 399 # employee #2
 400
 401 isa_ok( $ii->employees->[1], 'Employee' );
 402 isa_ok( $ii->employees->[1], 'Person' );
 403
 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' );
 418
 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' );
 423
 424 # employee #3
 425
 426 isa_ok( $ii->employees->[2], 'Employee' );
 427 isa_ok( $ii->employees->[2], 'Person' );
 428
 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' );
 442
 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' );
 446
 447 # create new company
 448
 449 my $new_company
 450     = Company->new( name => 'Infinity Interactive International' );
 451 isa_ok( $new_company, 'Company' );
 452
 453 my $ii_employees = $ii->employees;
 454 foreach my $employee (@$ii_employees) {
 455     is( $employee->employer, $ii, '... has the ii company' );
 456 }
 457
 458 $new_company->employees($ii_employees);
 459
 460 foreach my $employee ( @{ $new_company->employees } ) {
 461     is( $employee->employer, $new_company,
 462         '... has the different company now' );
 463 }
 464
 465 ## check some error conditions for the subtypes
 466
 467 dies_ok {
 468     Address->new( street => {} ),;
 469 }
 470 '... we die correctly with bad args';
 471
 472 dies_ok {
 473     Address->new( city => {} ),;
 474 }
 475 '... we die correctly with bad args';
 476
 477 dies_ok {
 478     Address->new( state => 'British Columbia' ),;
 479 }
 480 '... we die correctly with bad args';
 481
 482 lives_ok {
 483     Address->new( state => 'Connecticut' ),;
 484 }
 485 '... we live correctly with good args';
 486
 487 dies_ok {
 488     Address->new( zip_code => 'AF5J6$' ),;
 489 }
 490 '... we die correctly with bad args';
 491
 492 lives_ok {
 493     Address->new( zip_code => '06443' ),;
 494 }
 495 '... we live correctly with good args';
 496
 497 dies_ok {
 498     Company->new(),;
 499 }
 500 '... we die correctly without good args';
 501
 502 lives_ok {
 503     Company->new( name => 'Foo' ),;
 504 }
 505 '... we live correctly without good args';
 506
 507 dies_ok {
 508     Company->new( name => 'Foo', employees => [ Person->new ] ),;
 509 }
 510 '... we die correctly with good args';
 511
 512 lives_ok {
 513     Company->new( name => 'Foo', employees => [] ),;
 514 }
 515 '... we live correctly with good args';
 516
 517 =end testing
 518
 519 =cut