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 is(
 319     exception {
 320         $ii = Company->new(
 321             {
 322                 name    => 'Infinity Interactive',
 323                 address => Address->new(
 324                     street   => '565 Plandome Rd., Suite 307',
 325                     city     => 'Manhasset',
 326                     state    => 'NY',
 327                     zip_code => '11030'
 328                 ),
 329                 employees => [
 330                     Employee->new(
 331                         first_name => 'Jeremy',
 332                         last_name  => 'Shao',
 333                         title      => 'President / Senior Consultant',
 334                         address    => Address->new(
 335                             city => 'Manhasset', state => 'NY'
 336                         )
 337                     ),
 338                     Employee->new(
 339                         first_name => 'Tommy',
 340                         last_name  => 'Lee',
 341                         title      => 'Vice President / Senior Developer',
 342                         address =>
 343                             Address->new( city => 'New York', state => 'NY' )
 344                     ),
 345                     Employee->new(
 346                         first_name     => 'Stevan',
 347                         middle_initial => 'C',
 348                         last_name      => 'Little',
 349                         title          => 'Senior Developer',
 350                         address =>
 351                             Address->new( city => 'Madison', state => 'CT' )
 352                     ),
 353                 ]
 354             }
 355         );
 356     },
 357     undef,
 358     '... created the entire company successfully'
 359 );
 360
 361 isa_ok( $ii, 'Company' );
 362
 363 is( $ii->name, 'Infinity Interactive',
 364     '... got the right name for the company' );
 365
 366 isa_ok( $ii->address, 'Address' );
 367 is( $ii->address->street, '565 Plandome Rd., Suite 307',
 368     '... got the right street address' );
 369 is( $ii->address->city,     'Manhasset', '... got the right city' );
 370 is( $ii->address->state,    'NY',        '... got the right state' );
 371 is( $ii->address->zip_code, 11030,       '... got the zip code' );
 372
 373 is( $ii->get_employee_count, 3, '... got the right employee count' );
 374
 375 # employee #1
 376
 377 isa_ok( $ii->employees->[0], 'Employee' );
 378 isa_ok( $ii->employees->[0], 'Person' );
 379
 380 is( $ii->employees->[0]->first_name, 'Jeremy',
 381     '... got the right first name' );
 382 is( $ii->employees->[0]->last_name, 'Shao', '... got the right last name' );
 383 ok( !$ii->employees->[0]->has_middle_initial, '... no middle initial' );
 384 is( $ii->employees->[0]->middle_initial, undef,
 385     '... got the right middle initial value' );
 386 is( $ii->employees->[0]->full_name,
 387     'Jeremy Shao, President / Senior Consultant',
 388     '... got the right full name' );
 389 is( $ii->employees->[0]->title, 'President / Senior Consultant',
 390     '... got the right title' );
 391 is( $ii->employees->[0]->employer, $ii, '... got the right company' );
 392 ok( isweak( $ii->employees->[0]->{employer} ),
 393     '... the company is a weak-ref' );
 394
 395 isa_ok( $ii->employees->[0]->address, 'Address' );
 396 is( $ii->employees->[0]->address->city, 'Manhasset',
 397     '... got the right city' );
 398 is( $ii->employees->[0]->address->state, 'NY', '... got the right state' );
 399
 400 # employee #2
 401
 402 isa_ok( $ii->employees->[1], 'Employee' );
 403 isa_ok( $ii->employees->[1], 'Person' );
 404
 405 is( $ii->employees->[1]->first_name, 'Tommy',
 406     '... got the right first name' );
 407 is( $ii->employees->[1]->last_name, 'Lee', '... got the right last name' );
 408 ok( !$ii->employees->[1]->has_middle_initial, '... no middle initial' );
 409 is( $ii->employees->[1]->middle_initial, undef,
 410     '... got the right middle initial value' );
 411 is( $ii->employees->[1]->full_name,
 412     'Tommy Lee, Vice President / Senior Developer',
 413     '... got the right full name' );
 414 is( $ii->employees->[1]->title, 'Vice President / Senior Developer',
 415     '... got the right title' );
 416 is( $ii->employees->[1]->employer, $ii, '... got the right company' );
 417 ok( isweak( $ii->employees->[1]->{employer} ),
 418     '... the company is a weak-ref' );
 419
 420 isa_ok( $ii->employees->[1]->address, 'Address' );
 421 is( $ii->employees->[1]->address->city, 'New York',
 422     '... got the right city' );
 423 is( $ii->employees->[1]->address->state, 'NY', '... got the right state' );
 424
 425 # employee #3
 426
 427 isa_ok( $ii->employees->[2], 'Employee' );
 428 isa_ok( $ii->employees->[2], 'Person' );
 429
 430 is( $ii->employees->[2]->first_name, 'Stevan',
 431     '... got the right first name' );
 432 is( $ii->employees->[2]->last_name, 'Little', '... got the right last name' );
 433 ok( $ii->employees->[2]->has_middle_initial, '... got middle initial' );
 434 is( $ii->employees->[2]->middle_initial, 'C',
 435     '... got the right middle initial value' );
 436 is( $ii->employees->[2]->full_name, 'Stevan C. Little, Senior Developer',
 437     '... got the right full name' );
 438 is( $ii->employees->[2]->title, 'Senior Developer',
 439     '... got the right title' );
 440 is( $ii->employees->[2]->employer, $ii, '... got the right company' );
 441 ok( isweak( $ii->employees->[2]->{employer} ),
 442     '... the company is a weak-ref' );
 443
 444 isa_ok( $ii->employees->[2]->address, 'Address' );
 445 is( $ii->employees->[2]->address->city, 'Madison', '... got the right city' );
 446 is( $ii->employees->[2]->address->state, 'CT', '... got the right state' );
 447
 448 # create new company
 449
 450 my $new_company
 451     = Company->new( name => 'Infinity Interactive International' );
 452 isa_ok( $new_company, 'Company' );
 453
 454 my $ii_employees = $ii->employees;
 455 foreach my $employee (@$ii_employees) {
 456     is( $employee->employer, $ii, '... has the ii company' );
 457 }
 458
 459 $new_company->employees($ii_employees);
 460
 461 foreach my $employee ( @{ $new_company->employees } ) {
 462     is( $employee->employer, $new_company,
 463         '... has the different company now' );
 464 }
 465
 466 ## check some error conditions for the subtypes
 467
 468 isnt(
 469     exception {
 470         Address->new( street => {} ),;
 471     },
 472     undef,
 473     '... we die correctly with bad args'
 474 );
 475
 476 isnt(
 477     exception {
 478         Address->new( city => {} ),;
 479     },
 480     undef,
 481     '... we die correctly with bad args'
 482 );
 483
 484 isnt(
 485     exception {
 486         Address->new( state => 'British Columbia' ),;
 487     },
 488     undef,
 489     '... we die correctly with bad args'
 490 );
 491
 492 is(
 493     exception {
 494         Address->new( state => 'Connecticut' ),;
 495     },
 496     undef,
 497     '... we live correctly with good args'
 498 );
 499
 500 isnt(
 501     exception {
 502         Address->new( zip_code => 'AF5J6$' ),;
 503     },
 504     undef,
 505     '... we die correctly with bad args'
 506 );
 507
 508 is(
 509     exception {
 510         Address->new( zip_code => '06443' ),;
 511     },
 512     undef,
 513     '... we live correctly with good args'
 514 );
 515
 516 isnt(
 517     exception {
 518         Company->new(),;
 519     },
 520     undef,
 521     '... we die correctly without good args'
 522 );
 523
 524 is(
 525     exception {
 526         Company->new( name => 'Foo' ),;
 527     },
 528     undef,
 529     '... we live correctly without good args'
 530 );
 531
 532 isnt(
 533     exception {
 534         Company->new( name => 'Foo', employees => [ Person->new ] ),;
 535     },
 536     undef,
 537     '... we die correctly with good args'
 538 );
 539
 540 is(
 541     exception {
 542         Company->new( name => 'Foo', employees => [] ),;
 543     },
 544     undef,
 545     '... we live correctly with good args'
 546 );
 547
 548 =end testing
 549
 550 =cut