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