lib/Moose/Cookbook/Recipe4.pod

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