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