Commit | Line | Data |
471c4f09 |
1 | |
2 | =pod |
3 | |
4 | =head1 NAME |
5 | |
3824830b |
6 | Moose::Cookbook::Recipe4 - Subtypes, and modeling a simple B<Company> class hierarchy |
471c4f09 |
7 | |
8 | =head1 SYNOPSIS |
9 | |
10 | package Address; |
11 | use strict; |
12 | use warnings; |
13 | use Moose; |
05d9eaf6 |
14 | use Moose::Util::TypeConstraints; |
471c4f09 |
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 { |
172e0738 |
24 | (exists $STATES->{code2state}{uc($_)} || |
25 | exists $STATES->{state2code}{uc($_)}) |
471c4f09 |
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; |
05d9eaf6 |
43 | use Moose::Util::TypeConstraints; |
471c4f09 |
44 | |
7c6cacb4 |
45 | has 'name' => (is => 'rw', isa => 'Str', required => 1); |
471c4f09 |
46 | has 'address' => (is => 'rw', isa => 'Address'); |
47 | has 'employees' => (is => 'rw', isa => subtype ArrayRef => where { |
ad5ed80c |
48 | (blessed($_) && $_->isa('Employee') || return) for @$_; 1 |
471c4f09 |
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 | |
ad5ed80c |
60 | after 'employees' => sub { |
61 | my ($self, $employees) = @_; |
62 | if (defined $employees) { |
63 | foreach my $employee (@{$employees}) { |
64 | $employee->company($self); |
65 | } |
66 | } |
67 | }; |
471c4f09 |
68 | |
69 | package Person; |
70 | use strict; |
71 | use warnings; |
72 | use Moose; |
73 | |
7c6cacb4 |
74 | has 'first_name' => (is => 'rw', isa => 'Str', required => 1); |
75 | has 'last_name' => (is => 'rw', isa => 'Str', required => 1); |
172e0738 |
76 | has 'middle_initial' => (is => 'rw', isa => 'Str', |
77 | predicate => 'has_middle_initial'); |
471c4f09 |
78 | has 'address' => (is => 'rw', isa => 'Address'); |
79 | |
80 | sub full_name { |
81 | my $self = shift; |
82 | return $self->first_name . |
172e0738 |
83 | ($self->has_middle_initial ? |
84 | ' ' . $self->middle_initial . '. ' |
85 | : |
86 | ' ') . |
471c4f09 |
87 | $self->last_name; |
88 | } |
89 | |
90 | package Employee; |
91 | use strict; |
92 | use warnings; |
93 | use Moose; |
94 | |
95 | extends 'Person'; |
96 | |
7c6cacb4 |
97 | has 'title' => (is => 'rw', isa => 'Str', required => 1); |
471c4f09 |
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 | }; |
7c6cacb4 |
104 | |
471c4f09 |
105 | =head1 DESCRIPTION |
106 | |
172e0738 |
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 | |
ad5ed80c |
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 | |
172e0738 |
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 | |
ad5ed80c |
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 | |
172e0738 |
294 | =back |
295 | |
471c4f09 |
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 |