lib/Moose/Cookbook/Basics/Recipe4.pod

   1
   2 =pod
   3
   4 =head1 NAME
   5
   6 Moose::Cookbook::Basics::Recipe4 - Subtypes, and modeling a simple B<Company> class hierarchy
   7
   8 =head1 SYNOPSIS
   9
  10   package Address;
  11   use Moose;
  12   use Moose::Util::TypeConstraints;
  13
  14   use Locale::US;
  15   use Regexp::Common 'zip';
  16
  17   my $STATES = Locale::US->new;
  18   subtype 'USState'
  19       => as Str
  20       => where {
  21              (    exists $STATES->{code2state}{ uc($_) }
  22                || exists $STATES->{state2code}{ uc($_) } );
  23          };
  24
  25   subtype 'USZipCode'
  26       => as Value
  27       => where {
  28              /^$RE{zip}{US}{-extended => 'allow'}$/;
  29          };
  30
  31   has 'street'   => ( is => 'rw', isa => 'Str' );
  32   has 'city'     => ( is => 'rw', isa => 'Str' );
  33   has 'state'    => ( is => 'rw', isa => 'USState' );
  34   has 'zip_code' => ( is => 'rw', isa => 'USZipCode' );
  35
  36   package Company;
  37   use Moose;
  38   use Moose::Util::TypeConstraints;
  39
  40   has 'name' => ( is => 'rw', isa => 'Str', required => 1 );
  41   has 'address'   => ( is => 'rw', isa => 'Address' );
  42   has 'employees' => ( is => 'rw', isa => 'ArrayRef[Employee]' );
  43
  44   sub BUILD {
  45       my ( $self, $params ) = @_;
  46       if ( $params->{employees} ) {
  47           foreach my $employee ( @{ $params->{employees} } ) {
  48               $employee->company($self);
  49           }
  50       }
  51   }
  52
  53   after 'employees' => sub {
  54       my ( $self, $employees ) = @_;
  55       if ( defined $employees ) {
  56           foreach my $employee ( @{$employees} ) {
  57               $employee->company($self);
  58           }
  59       }
  60   };
  61
  62   package Person;
  63   use Moose;
  64
  65   has 'first_name' => ( is => 'rw', isa => 'Str', required => 1 );
  66   has 'last_name'  => ( is => 'rw', isa => 'Str', required => 1 );
  67   has 'middle_initial' => (
  68       is        => 'rw', isa => 'Str',
  69       predicate => 'has_middle_initial'
  70   );
  71   has 'address' => ( is => 'rw', isa => 'Address' );
  72
  73   sub full_name {
  74       my $self = shift;
  75       return $self->first_name
  76           . (
  77           $self->has_middle_initial
  78           ? ' ' . $self->middle_initial . '. '
  79           : ' '
  80           ) . $self->last_name;
  81   }
  82
  83   package Employee;
  84   use Moose;
  85
  86   extends 'Person';
  87
  88   has 'title'   => ( is => 'rw', isa => 'Str',     required => 1 );
  89   has 'company' => ( is => 'rw', isa => 'Company', weak_ref => 1 );
  90
  91   override 'full_name' => sub {
  92       my $self = shift;
  93       super() . ', ' . $self->title;
  94   };
  95
  96 =head1 DESCRIPTION
  97
  98 In this recipe we introduce the C<subtype> keyword, and show
  99 how it can be useful for specifying type constraints
 100 without building an entire class to represent them. We
 101 will also show how this feature can be used to leverage the
 102 usefulness of CPAN modules. In addition to this, we will
 103 introduce another attribute option.
 104
 105 Let's first look at the C<subtype> feature. In the B<Address> class we have
 106 defined two subtypes. The first C<subtype> uses the L<Locale::US> module, which
 107 provides two hashes which can be used to perform existential checks for state
 108 names and their two letter state codes. It is a very simple and very useful
 109 module, and perfect for use in a C<subtype> constraint.
 110
 111   my $STATES = Locale::US->new;
 112   subtype 'USState'
 113       => as Str
 114       => where {
 115              (    exists $STATES->{code2state}{ uc($_) }
 116                || exists $STATES->{state2code}{ uc($_) } );
 117          };
 118
 119 Because we know that states will be passed to us as strings, we
 120 can make C<USState> a subtype of the built-in type constraint
 121 C<Str>. This will ensure that anything which is a C<USState> will
 122 also pass as a C<Str>. Next, we create a constraint specializer
 123 using the C<where> keyword. The value being checked against in
 124 the C<where> clause can be found in the C<$_> variable (1). Our
 125 constraint specializer will then check whether the given string
 126 is either a state name or a state code. If the string meets this
 127 criteria, then the constraint will pass, otherwise it will fail.
 128 We can now use this as we would any built-in constraint, like so:
 129
 130   has 'state'    => ( is => 'rw', isa => 'USState' );
 131
 132 The C<state> accessor will now check all values against the
 133 C<USState> constraint, thereby only allowing valid state names or
 134 state codes to be stored in the C<state> slot.
 135
 136 The next C<subtype> does pretty much the same thing using the L<Regexp::Common>
 137 module, and is used as the constraint for the C<zip_code> slot.
 138
 139   subtype 'USZipCode'
 140       => as Value
 141       => where {
 142              /^$RE{zip}{US}{-extended => 'allow'}$/;
 143          };
 144
 145 Using subtypes can save a lot of unnecessary abstraction by not requiring you to
 146 create many small classes for these relatively simple values. They also allow
 147 you to reuse the same constraints in a number of classes (thereby avoiding
 148 duplication), since all type constraints are stored in a global registry and
 149 always accessible to C<has>.
 150
 151 With these two subtypes and some attributes, we have defined
 152 as much as we need for a basic B<Address> class. Next, we define
 153 a basic B<Company> class, which itself has an address. As we saw in
 154 earlier recipes, we can use the C<Address> type constraint that
 155 Moose automatically created for us:
 156
 157   has 'address'   => ( is => 'rw', isa => 'Address' );
 158
 159 A company also needs a name, so we define that as well:
 160
 161   has 'name' => ( is => 'rw', isa => 'Str', required => 1 );
 162
 163 Here we introduce another attribute option, the C<required> option.
 164 This option tells Moose that C<name> is a required parameter in
 165 the B<Company> constructor, and that the C<name> accessor cannot
 166 accept an undefined value for the slot. The result is that C<name>
 167 will always have a value.
 168
 169 The next attribute option is not actually new, but a new variant
 170 of options we have already introduced:
 171
 172   has 'employees' => ( is => 'rw', isa => 'ArrayRef[Employee]' );
 173
 174 Here, we are passing a more complex string to the C<isa> option, we
 175 are passing a container type constraint. Container type constraints
 176 can either be C<ArrayRef> or C<HashRef> with a contained type given
 177 inside the square brackets. This basically checks that all the values
 178 in the ARRAY ref are instances of the B<Employee> class.
 179
 180 This will ensure that our employees will all be of the correct type. However,
 181 the B<Employee> object (which we will see in a moment) also maintains a
 182 reference to its associated B<Company>. In order to maintain this relationship
 183 (and preserve the referential integrity of our objects), we need to perform some
 184 processing of the employees over and above that of the type constraint check.
 185 This is accomplished in two places. First we need to be sure that any employees
 186 array passed to the constructor is properly initialized. For this we can use the
 187 C<BUILD> method (2):
 188
 189   sub BUILD {
 190       my ( $self, $params ) = @_;
 191       if ( $params->{employees} ) {
 192           foreach my $employee ( @{ $params->{employees} } ) {
 193               $employee->company($self);
 194           }
 195       }
 196   }
 197
 198 The C<BUILD> method will be executed after the initial type constraint
 199 check, so we can simply perform a basic existential check on the C<employees>
 200 parameter here, and assume that if it does exist, it is both an ARRAY ref
 201 and contains I<only> instances of B<Employee>.
 202
 203 The next aspect we need to address is the C<employees> read/write
 204 accessor (see the C<employees> attribute declaration above). This
 205 accessor will correctly check the type constraint, but we need to extend it
 206 with some additional processing. For this we use an C<after> method modifier,
 207 like so:
 208
 209   after 'employees' => sub {
 210       my ( $self, $employees ) = @_;
 211       if ( defined $employees ) {
 212           foreach my $employee ( @{$employees} ) {
 213               $employee->company($self);
 214           }
 215       }
 216   };
 217
 218 Again, as with the C<BUILD> method, we know that the type constraint
 219 check has already happened, so we can just check for definedness on the
 220 C<$employees> argument.
 221
 222 At this point, our B<Company> class is complete. Next comes our B<Person>
 223 class and its subclass, the previously mentioned B<Employee> class.
 224
 225 The B<Person> class should be obvious to you at this point. It has a few
 226 C<required> attributes, and the C<middle_initial> slot has an additional
 227 C<predicate> method (which we saw in the previous recipe with the
 228 B<BinaryTree> class).
 229
 230 Next, the B<Employee> class, which should also be pretty obvious at this
 231 point. It requires a C<title>, and maintains a weakened reference to a
 232 B<Company> instance. The only new item, which we have seen before in
 233 examples, but never in the recipe itself, is the C<override> method
 234 modifier:
 235
 236   override 'full_name' => sub {
 237       my $self = shift;
 238       super() . ', ' . $self->title;
 239   };
 240
 241 This just tells Moose that I am intentionally overriding the superclass
 242 C<full_name> method here, and adding the value of the C<title> slot at
 243 the end of the employee's full name.
 244
 245 And that's about it.
 246
 247 Once again, as with all the other recipes, you can go about using
 248 these classes like any other Perl 5 class. A more detailed example of
 249 usage can be found in F<t/000_recipes/004_recipe.t>.
 250
 251 =head1 CONCLUSION
 252
 253 This recipe was intentionally longer and more complex to illustrate both
 254 how easily Moose classes can interact (using class type constraints, etc.)
 255 and the sheer density of information and behaviors which Moose can pack
 256 into a relatively small amount of typing. Ponder for a moment how much
 257 more code a non-Moose plain old Perl 5 version of this recipe would have
 258 been (including all the type constraint checks, weak references, and so on).
 259
 260 And of course, this recipe also introduced the C<subtype> keyword, and
 261 its usefulness within the Moose toolkit. In the next recipe we will
 262 focus more on subtypes, and introduce the idea of type coercion as well.
 263
 264 =head1 FOOTNOTES
 265
 266 =over 4
 267
 268 =item (1)
 269
 270 The value being checked is also passed as the first argument to
 271 the C<where> block as well, so it can also be accessed as C<$_[0]>
 272 as well.
 273
 274 =item (2)
 275
 276 The C<BUILD> method is called by C<Moose::Object::BUILDALL>, which is
 277 called by C<Moose::Object::new>. C<BUILDALL> will climb the object
 278 inheritance graph and call the appropriate C<BUILD> methods in the
 279 correct order.
 280
 281 =back
 282
 283 =head1 AUTHOR
 284
 285 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 286
 287 =head1 COPYRIGHT AND LICENSE
 288
 289 Copyright 2006-2009 by Infinity Interactive, Inc.
 290
 291 L<http://www.iinteractive.com>
 292
 293 This library is free software; you can redistribute it and/or modify
 294 it under the same terms as Perl itself.
 295
 296 =cut