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 Person;
  38   use Moose;
  39
  40   has 'first_name'     => (is => 'rw', isa => 'Str', required => 1);
  41   has 'last_name'      => (is => 'rw', isa => 'Str', required => 1);
  42   has 'middle_initial' => (is => 'rw', isa => 'Str',
  43                            predicate => 'has_middle_initial');
  44   has 'address'        => (is => 'rw', isa => 'Address');
  45
  46   sub full_name {
  47       my $self = shift;
  48       return $self->first_name .
  49             ($self->has_middle_initial ?
  50                 ' ' . $self->middle_initial . '. '
  51                 :
  52                 ' ') .
  53              $self->last_name;
  54   }
  55
  56   package Employee;
  57   use Moose;
  58
  59   extends 'Person';
  60
  61   has 'title'   => (is => 'rw', isa => 'Str', required => 1);
  62   has 'company' => (is => 'rw', isa => 'Company', weak_ref => 1);
  63
  64   override 'full_name' => sub {
  65       my $self = shift;
  66       super() . ', ' . $self->title
  67   };
  68
  69   package Company;
  70   use Moose;
  71
  72   has 'name'      => (is => 'rw', isa => 'Str', required => 1);
  73   has 'address'   => (is => 'rw', isa => 'Address');
  74   has 'employees' => (is => 'rw', isa => 'ArrayRef[Employee]');
  75
  76   sub BUILD {
  77       my ($self, $params) = @_;
  78       if ($params->{employees}) {
  79           foreach my $employee (@{$params->{employees}}) {
  80               $employee->company($self);
  81           }
  82       }
  83   }
  84
  85   after 'employees' => sub {
  86       my ($self, $employees) = @_;
  87       if (defined $employees) {
  88           foreach my $employee (@{$employees}) {
  89               $employee->company($self);
  90           }
  91       }
  92   };
  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 as much as we
 151 need for a basic B<Address> class. Next comes our B<Person> class and its
 152 subclass, the B<Employee> class.
 153
 154 The B<Person> class is pretty straightforward. We do introduce another attribute
 155 option, the C<required> option. This option tells Moose that the attribute is
 156 a required parameter in the constructor, and that the attribute's accessor cannot
 157 accept an undefined value for the slot. The result is that the attribute
 158 will always have a value.
 159
 160 In B<Person>, the C<first_name> and C<last_name> attributes are C<required>, and
 161 the C<middle_initial> slot has an additional C<predicate> method (which we saw
 162 in the previous recipe with the B<BinaryTree> class).
 163
 164 Next, the B<Employee> class. It requires a C<title>, and maintains a
 165 weakened reference to a B<Company> instance (which will be defined next).
 166 The only new item, which we have seen before in examples, but never in
 167 the recipe itself, is the C<override> method modifier:
 168
 169   override 'full_name' => sub {
 170       my $self = shift;
 171       super() . ', ' . $self->title
 172   };
 173
 174 This just tells Moose that I am intentionally overriding the superclass
 175 C<full_name> method here, and adding the value of the C<title> slot at
 176 the end of the employee's full name.
 177
 178 Next, we define a basic B<Company> class, which itself has an address.
 179 As we saw in earlier recipes, we can use the C<Address> type constraint that
 180 Moose automatically created for us:
 181
 182   has 'address' => (is => 'rw', isa => 'Address');
 183
 184 A company also needs a name, so we define that as well:
 185
 186   has 'name' => (is => 'rw', isa => 'Str', required => 1);
 187
 188 The next attribute option is not actually new, but a new variant
 189 of options we have already introduced:
 190
 191   has 'employees' => (is => 'rw', isa => 'ArrayRef[Employee]');
 192
 193 Here we are creating a container type constraint. Container type constraints
 194 can be either C<ArrayRef> or C<HashRef> and have a second type which specifies
 195 the kind of values they contain. In this case, we are telling Moose that
 196 we expect an C<ArrayRef> of C<Employee> objects. This will ensure that our
 197 employees will all be of the correct type.
 198
 199 It is important to note that container types B<must> be defined already,
 200 Moose will not create an anon-type for you as it will in other situations.
 201
 202 However, the B<Employee> object (which we will see in a moment) also maintains a
 203 reference to its associated B<Company>. In order to maintain this relationship
 204 (and preserve the referential integrity of our objects), we need to perform some
 205 processing of the employees over and above that of the type constraint check.
 206 This is accomplished in two places. First we need to be sure that any employees
 207 array passed to the constructor is properly initialized. For this we can use the
 208 C<BUILD> method (2):
 209
 210   sub BUILD {
 211       my ($self, $params) = @_;
 212       if ($params->{employees}) {
 213           foreach my $employee (@{$params->{employees}}) {
 214               $employee->company($self);
 215           }
 216       }
 217   }
 218
 219 The C<BUILD> method will be executed after the initial type constraint
 220 check, so we can simply perform a basic existential check on the C<employees>
 221 param here, and assume that if it does exist, it is both an ARRAY ref
 222 and contains I<only> instances of B<Employee>.
 223
 224 The next aspect we need to address is the C<employees> read/write
 225 accessor (see the C<employees> attribute declaration above). This
 226 accessor will correctly check the type constraint, but we need to extend it
 227 with some additional processing. For this we use an C<after> method modifier,
 228 like so:
 229
 230   after 'employees' => sub {
 231       my ($self, $employees) = @_;
 232       if (defined $employees) {
 233           foreach my $employee (@{$employees}) {
 234               $employee->company($self);
 235           }
 236       }
 237   };
 238
 239 Again, as with the C<BUILD> method, we know that the type constraint
 240 check has already happened, so we can just check for defined-ness on the
 241 C<$employees> argument.
 242
 243 At this point, our B<Company> class is complete.
 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/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, 2007 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