lib/Moose/Cookbook/Recipe4.pod

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