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