lib/Moose/Cookbook/Basics/Recipe4.pod

   1 package Moose::Cookbook::Basics::Recipe4;
   2
   3 # ABSTRACT: Subtypes, and modeling a simple B<Company> class hierarchy
   4
   5 __END__
   6
   7
   8 =pod
   9
  10 =begin testing-SETUP
  11
  12 use Test::Requires {
  13     'Locale::US'     => '0',
  14     'Regexp::Common' => '0',
  15 };
  16
  17 =end testing-SETUP
  18
  19 =head1 SYNOPSIS
  20
  21   package Address;
  22   use Moose;
  23   use Moose::Util::TypeConstraints;
  24
  25   use Locale::US;
  26   use Regexp::Common 'zip';
  27
  28   my $STATES = Locale::US->new;
  29   subtype 'USState'
  30       => as Str
  31       => where {
  32              (    exists $STATES->{code2state}{ uc($_) }
  33                || exists $STATES->{state2code}{ uc($_) } );
  34          };
  35
  36   subtype 'USZipCode'
  37       => as Value
  38       => where {
  39              /^$RE{zip}{US}{-extended => 'allow'}$/;
  40          };
  41
  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' );
  46
  47   package Company;
  48   use Moose;
  49   use Moose::Util::TypeConstraints;
  50
  51   has 'name' => ( is => 'rw', isa => 'Str', required => 1 );
  52   has 'address'   => ( is => 'rw', isa => 'Address' );
  53   has 'employees' => ( is => 'rw', isa => 'ArrayRef[Employee]' );
  54
  55   sub BUILD {
  56       my ( $self, $params ) = @_;
  57       foreach my $employee ( @{ $self->employees || [] } ) {
  58           $employee->employer($self);
  59       }
  60   }
  61
  62   after 'employees' => sub {
  63       my ( $self, $employees ) = @_;
  64       foreach my $employee ( @{ $employees || [] } ) {
  65           $employee->employer($self);
  66       }
  67   };
  68
  69   package Person;
  70   use Moose;
  71
  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'
  77   );
  78   has 'address' => ( is => 'rw', isa => 'Address' );
  79
  80   sub full_name {
  81       my $self = shift;
  82       return $self->first_name
  83           . (
  84           $self->has_middle_initial
  85           ? ' ' . $self->middle_initial . '. '
  86           : ' '
  87           ) . $self->last_name;
  88   }
  89
  90   package Employee;
  91   use Moose;
  92
  93   extends 'Person';
  94
  95   has 'title'    => ( is => 'rw', isa => 'Str',     required => 1 );
  96   has 'employer' => ( is => 'rw', isa => 'Company', weak_ref => 1 );
  97
  98   override 'full_name' => sub {
  99       my $self = shift;
 100       super() . ', ' . $self->title;
 101   };
 102
 103 =head1 DESCRIPTION
 104
 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
 108 class.
 109
 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.
 113
 114 Finally, we introduce the C<required> attribute option.
 115
 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.
 119
 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
 126 type.
 127
 128 We can now use the C<USState> type just like Moose's builtin types:
 129
 130   has 'state'    => ( is => 'rw', isa => 'USState' );
 131
 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
 134 thrown.
 135
 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.
 139
 140   subtype 'USZipCode'
 141       => as Value
 142       => where {
 143              /^$RE{zip}{US}{-extended => 'allow'}$/;
 144          };
 145
 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.
 149
 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>.
 155
 156 These two subtypes allow us to define a simple C<Address> class.
 157
 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:
 162
 163   has 'address'   => ( is => 'rw', isa => 'Address' );
 164
 165 A company also needs a name:
 166
 167   has 'name' => ( is => 'rw', isa => 'Str', required => 1 );
 168
 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.
 174
 175 The next attribute, C<employees>, uses a I<parameterized> type
 176 constraint:
 177
 178   has 'employees' => ( is => 'rw', isa => 'ArrayRef[Employee]' );
 179
 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
 183 constraint.
 184
 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)
 190
 191 If you jump down to the definition of the C<Employee> class, you will
 192 see that it has an C<employer> attribute.
 193
 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.
 197
 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
 202 (3).
 203
 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:
 207
 208   sub BUILD {
 209       my ( $self, $params ) = @_;
 210       foreach my $employee ( @{ $self->employees || [] } ) {
 211           $employee->employer($self);
 212       }
 213   }
 214
 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
 218 C<Employee> objects.
 219
 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
 222 employee.
 223
 224 To do this we can use an C<after> modifier:
 225
 226   after 'employees' => sub {
 227       my ( $self, $employees ) = @_;
 228       foreach my $employee ( @{ $employees || [] } ) {
 229           $employee->employer($self);
 230       }
 231   };
 232
 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..
 236
 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>.
 240
 241 The only new feature in the C<Employee> class is the C<override>
 242 method modifier:
 243
 244   override 'full_name' => sub {
 245       my $self = shift;
 246       super() . ', ' . $self->title;
 247   };
 248
 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.
 253
 254 A more detailed example of usage can be found in
 255 F<t/recipes/moose_cookbook_basics_recipe4.t>.
 256
 257 =head1 CONCLUSION
 258
 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.
 263
 264 This recipe also introduced the C<subtype> function, the C<required>
 265 attribute, and the C<override> method modifier.
 266
 267 We will revisit type constraints in future recipes, and cover type
 268 coercion as well.
 269
 270 =head1 FOOTNOTES
 271
 272 =over 4
 273
 274 =item (1)
 275
 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]>.
 278
 279 =item (2)
 280
 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.
 284
 285 =item (3)
 286
 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
 289 correct order.
 290
 291 =back
 292
 293 =begin testing
 294
 295 {
 296     package Company;
 297
 298     sub get_employee_count { scalar @{(shift)->employees} }
 299 }
 300
 301 use Scalar::Util 'isweak';
 302
 303 my $ii;
 304 is(
 305     exception {
 306         $ii = Company->new(
 307             {
 308                 name    => 'Infinity Interactive',
 309                 address => Address->new(
 310                     street   => '565 Plandome Rd., Suite 307',
 311                     city     => 'Manhasset',
 312                     state    => 'NY',
 313                     zip_code => '11030'
 314                 ),
 315                 employees => [
 316                     Employee->new(
 317                         first_name => 'Jeremy',
 318                         last_name  => 'Shao',
 319                         title      => 'President / Senior Consultant',
 320                         address    => Address->new(
 321                             city => 'Manhasset', state => 'NY'
 322                         )
 323                     ),
 324                     Employee->new(
 325                         first_name => 'Tommy',
 326                         last_name  => 'Lee',
 327                         title      => 'Vice President / Senior Developer',
 328                         address =>
 329                             Address->new( city => 'New York', state => 'NY' )
 330                     ),
 331                     Employee->new(
 332                         first_name     => 'Stevan',
 333                         middle_initial => 'C',
 334                         last_name      => 'Little',
 335                         title          => 'Senior Developer',
 336                         address =>
 337                             Address->new( city => 'Madison', state => 'CT' )
 338                     ),
 339                 ]
 340             }
 341         );
 342     },
 343     undef,
 344     '... created the entire company successfully'
 345 );
 346
 347 isa_ok( $ii, 'Company' );
 348
 349 is( $ii->name, 'Infinity Interactive',
 350     '... got the right name for the company' );
 351
 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' );
 358
 359 is( $ii->get_employee_count, 3, '... got the right employee count' );
 360
 361 # employee #1
 362
 363 isa_ok( $ii->employees->[0], 'Employee' );
 364 isa_ok( $ii->employees->[0], 'Person' );
 365
 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' );
 380
 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' );
 385
 386 # employee #2
 387
 388 isa_ok( $ii->employees->[1], 'Employee' );
 389 isa_ok( $ii->employees->[1], 'Person' );
 390
 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' );
 405
 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' );
 410
 411 # employee #3
 412
 413 isa_ok( $ii->employees->[2], 'Employee' );
 414 isa_ok( $ii->employees->[2], 'Person' );
 415
 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' );
 429
 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' );
 433
 434 # create new company
 435
 436 my $new_company
 437     = Company->new( name => 'Infinity Interactive International' );
 438 isa_ok( $new_company, 'Company' );
 439
 440 my $ii_employees = $ii->employees;
 441 foreach my $employee (@$ii_employees) {
 442     is( $employee->employer, $ii, '... has the ii company' );
 443 }
 444
 445 $new_company->employees($ii_employees);
 446
 447 foreach my $employee ( @{ $new_company->employees } ) {
 448     is( $employee->employer, $new_company,
 449         '... has the different company now' );
 450 }
 451
 452 ## check some error conditions for the subtypes
 453
 454 isnt(
 455     exception {
 456         Address->new( street => {} ),;
 457     },
 458     undef,
 459     '... we die correctly with bad args'
 460 );
 461
 462 isnt(
 463     exception {
 464         Address->new( city => {} ),;
 465     },
 466     undef,
 467     '... we die correctly with bad args'
 468 );
 469
 470 isnt(
 471     exception {
 472         Address->new( state => 'British Columbia' ),;
 473     },
 474     undef,
 475     '... we die correctly with bad args'
 476 );
 477
 478 is(
 479     exception {
 480         Address->new( state => 'Connecticut' ),;
 481     },
 482     undef,
 483     '... we live correctly with good args'
 484 );
 485
 486 isnt(
 487     exception {
 488         Address->new( zip_code => 'AF5J6$' ),;
 489     },
 490     undef,
 491     '... we die correctly with bad args'
 492 );
 493
 494 is(
 495     exception {
 496         Address->new( zip_code => '06443' ),;
 497     },
 498     undef,
 499     '... we live correctly with good args'
 500 );
 501
 502 isnt(
 503     exception {
 504         Company->new(),;
 505     },
 506     undef,
 507     '... we die correctly without good args'
 508 );
 509
 510 is(
 511     exception {
 512         Company->new( name => 'Foo' ),;
 513     },
 514     undef,
 515     '... we live correctly without good args'
 516 );
 517
 518 isnt(
 519     exception {
 520         Company->new( name => 'Foo', employees => [ Person->new ] ),;
 521     },
 522     undef,
 523     '... we die correctly with good args'
 524 );
 525
 526 is(
 527     exception {
 528         Company->new( name => 'Foo', employees => [] ),;
 529     },
 530     undef,
 531     '... we live correctly with good args'
 532 );
 533
 534 =end testing
 535
 536 =cut