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