Commit | Line | Data |
471c4f09 |
1 | |
2 | =pod |
3 | |
4 | =head1 NAME |
5 | |
021b8139 |
6 | Moose::Cookbook::Basics::Recipe4 - Subtypes, and modeling a simple B<Company> class hierarchy |
471c4f09 |
7 | |
8 | =head1 SYNOPSIS |
36c99105 |
9 | |
471c4f09 |
10 | package Address; |
471c4f09 |
11 | use Moose; |
05d9eaf6 |
12 | use Moose::Util::TypeConstraints; |
36c99105 |
13 | |
471c4f09 |
14 | use Locale::US; |
15 | use Regexp::Common 'zip'; |
36c99105 |
16 | |
471c4f09 |
17 | my $STATES = Locale::US->new; |
0b3811a6 |
18 | subtype 'USState' |
471c4f09 |
19 | => as Str |
20 | => where { |
36c99105 |
21 | ( exists $STATES->{code2state}{ uc($_) } |
22 | || exists $STATES->{state2code}{ uc($_) } ); |
23 | }; |
24 | |
0b3811a6 |
25 | subtype 'USZipCode' |
471c4f09 |
26 | => as Value |
27 | => where { |
36c99105 |
28 | /^$RE{zip}{US}{-extended => 'allow'}$/; |
29 | }; |
30 | |
31 | has 'street' => ( is => 'rw', isa => 'Str' ); |
32 | has 'city' => ( is => 'rw', isa => 'Str' ); |
33 | has 'state' => ( is => 'rw', isa => 'USState' ); |
34 | has 'zip_code' => ( is => 'rw', isa => 'USZipCode' ); |
35 | |
f1917f58 |
36 | package Company; |
37 | use Moose; |
38 | use Moose::Util::TypeConstraints; |
36c99105 |
39 | |
40 | has 'name' => ( is => 'rw', isa => 'Str', required => 1 ); |
41 | has 'address' => ( is => 'rw', isa => 'Address' ); |
42 | has 'employees' => ( is => 'rw', isa => 'ArrayRef[Employee]' ); |
43 | |
f1917f58 |
44 | sub BUILD { |
36c99105 |
45 | my ( $self, $params ) = @_; |
46 | if ( $params->{employees} ) { |
47 | foreach my $employee ( @{ $params->{employees} } ) { |
f1917f58 |
48 | $employee->company($self); |
49 | } |
50 | } |
51 | } |
36c99105 |
52 | |
f1917f58 |
53 | after 'employees' => sub { |
36c99105 |
54 | my ( $self, $employees ) = @_; |
55 | if ( defined $employees ) { |
56 | foreach my $employee ( @{$employees} ) { |
f1917f58 |
57 | $employee->company($self); |
36c99105 |
58 | } |
f1917f58 |
59 | } |
36c99105 |
60 | }; |
61 | |
471c4f09 |
62 | package Person; |
471c4f09 |
63 | use Moose; |
36c99105 |
64 | |
65 | has 'first_name' => ( is => 'rw', isa => 'Str', required => 1 ); |
66 | has 'last_name' => ( is => 'rw', isa => 'Str', required => 1 ); |
67 | has 'middle_initial' => ( |
68 | is => 'rw', isa => 'Str', |
69 | predicate => 'has_middle_initial' |
70 | ); |
71 | has 'address' => ( is => 'rw', isa => 'Address' ); |
72 | |
471c4f09 |
73 | sub full_name { |
74 | my $self = shift; |
36c99105 |
75 | return $self->first_name |
76 | . ( |
77 | $self->has_middle_initial |
78 | ? ' ' . $self->middle_initial . '. ' |
79 | : ' ' |
80 | ) . $self->last_name; |
471c4f09 |
81 | } |
36c99105 |
82 | |
471c4f09 |
83 | package Employee; |
36c99105 |
84 | use Moose; |
85 | |
471c4f09 |
86 | extends 'Person'; |
36c99105 |
87 | |
88 | has 'title' => ( is => 'rw', isa => 'Str', required => 1 ); |
89 | has 'company' => ( is => 'rw', isa => 'Company', weak_ref => 1 ); |
90 | |
471c4f09 |
91 | override 'full_name' => sub { |
92 | my $self = shift; |
36c99105 |
93 | super() . ', ' . $self->title; |
471c4f09 |
94 | }; |
2f04a0fc |
95 | |
471c4f09 |
96 | =head1 DESCRIPTION |
97 | |
172e0738 |
98 | In this recipe we introduce the C<subtype> keyword, and show |
2f04a0fc |
99 | how it can be useful for specifying type constraints |
100 | without building an entire class to represent them. We |
172e0738 |
101 | will also show how this feature can be used to leverage the |
2f04a0fc |
102 | usefulness of CPAN modules. In addition to this, we will |
e08c54f5 |
103 | introduce another attribute option. |
172e0738 |
104 | |
2f04a0fc |
105 | Let's first look at the C<subtype> feature. In the B<Address> class we have |
106 | defined two subtypes. The first C<subtype> uses the L<Locale::US> module, which |
107 | provides two hashes which can be used to perform existential checks for state |
108 | names and their two letter state codes. It is a very simple and very useful |
109 | module, and perfect for use in a C<subtype> constraint. |
36c99105 |
110 | |
111 | my $STATES = Locale::US->new; |
0b3811a6 |
112 | subtype 'USState' |
172e0738 |
113 | => as Str |
114 | => where { |
36c99105 |
115 | ( exists $STATES->{code2state}{ uc($_) } |
116 | || exists $STATES->{state2code}{ uc($_) } ); |
117 | }; |
172e0738 |
118 | |
119 | Because we know that states will be passed to us as strings, we |
120 | can make C<USState> a subtype of the built-in type constraint |
2f04a0fc |
121 | C<Str>. This will ensure that anything which is a C<USState> will |
172e0738 |
122 | also pass as a C<Str>. Next, we create a constraint specializer |
123 | using the C<where> keyword. The value being checked against in |
124 | the C<where> clause can be found in the C<$_> variable (1). Our |
2f04a0fc |
125 | constraint specializer will then check whether the given string |
172e0738 |
126 | is either a state name or a state code. If the string meets this |
127 | criteria, then the constraint will pass, otherwise it will fail. |
128 | We can now use this as we would any built-in constraint, like so: |
129 | |
36c99105 |
130 | has 'state' => ( is => 'rw', isa => 'USState' ); |
172e0738 |
131 | |
132 | The C<state> accessor will now check all values against the |
133 | C<USState> constraint, thereby only allowing valid state names or |
134 | state codes to be stored in the C<state> slot. |
135 | |
2f04a0fc |
136 | The next C<subtype> does pretty much the same thing using the L<Regexp::Common> |
137 | module, and is used as the constraint for the C<zip_code> slot. |
172e0738 |
138 | |
0b3811a6 |
139 | subtype 'USZipCode' |
172e0738 |
140 | => as Value |
141 | => where { |
36c99105 |
142 | /^$RE{zip}{US}{-extended => 'allow'}$/; |
143 | }; |
172e0738 |
144 | |
2f04a0fc |
145 | Using subtypes can save a lot of unnecessary abstraction by not requiring you to |
146 | create many small classes for these relatively simple values. They also allow |
147 | you to reuse the same constraints in a number of classes (thereby avoiding |
148 | duplication), since all type constraints are stored in a global registry and |
149 | always accessible to C<has>. |
172e0738 |
150 | |
f1917f58 |
151 | With these two subtypes and some attributes, we have defined |
152 | as much as we need for a basic B<Address> class. Next, we define |
153 | a basic B<Company> class, which itself has an address. As we saw in |
154 | earlier recipes, we can use the C<Address> type constraint that |
2f04a0fc |
155 | Moose automatically created for us: |
172e0738 |
156 | |
36c99105 |
157 | has 'address' => ( is => 'rw', isa => 'Address' ); |
172e0738 |
158 | |
2f04a0fc |
159 | A company also needs a name, so we define that as well: |
172e0738 |
160 | |
36c99105 |
161 | has 'name' => ( is => 'rw', isa => 'Str', required => 1 ); |
172e0738 |
162 | |
f1917f58 |
163 | Here we introduce another attribute option, the C<required> option. |
164 | This option tells Moose that C<name> is a required parameter in |
165 | the B<Company> constructor, and that the C<name> accessor cannot |
166 | accept an undefined value for the slot. The result is that C<name> |
167 | will always have a value. |
168 | |
e08c54f5 |
169 | The next attribute option is not actually new, but a new variant |
2f04a0fc |
170 | of options we have already introduced: |
36c99105 |
171 | |
172 | has 'employees' => ( is => 'rw', isa => 'ArrayRef[Employee]' ); |
07cde929 |
173 | |
f1917f58 |
174 | Here, we are passing a more complex string to the C<isa> option, we |
175 | are passing a container type constraint. Container type constraints |
176 | can either be C<ArrayRef> or C<HashRef> with a contained type given |
177 | inside the square brackets. This basically checks that all the values |
178 | in the ARRAY ref are instances of the B<Employee> class. |
ad5ed80c |
179 | |
f1917f58 |
180 | This will ensure that our employees will all be of the correct type. However, |
181 | the B<Employee> object (which we will see in a moment) also maintains a |
2f04a0fc |
182 | reference to its associated B<Company>. In order to maintain this relationship |
183 | (and preserve the referential integrity of our objects), we need to perform some |
184 | processing of the employees over and above that of the type constraint check. |
185 | This is accomplished in two places. First we need to be sure that any employees |
186 | array passed to the constructor is properly initialized. For this we can use the |
187 | C<BUILD> method (2): |
36c99105 |
188 | |
ad5ed80c |
189 | sub BUILD { |
36c99105 |
190 | my ( $self, $params ) = @_; |
191 | if ( $params->{employees} ) { |
192 | foreach my $employee ( @{ $params->{employees} } ) { |
ad5ed80c |
193 | $employee->company($self); |
194 | } |
195 | } |
196 | } |
197 | |
2f04a0fc |
198 | The C<BUILD> method will be executed after the initial type constraint |
199 | check, so we can simply perform a basic existential check on the C<employees> |
ad5ed80c |
200 | param here, and assume that if it does exist, it is both an ARRAY ref |
2f04a0fc |
201 | and contains I<only> instances of B<Employee>. |
ad5ed80c |
202 | |
2f04a0fc |
203 | The next aspect we need to address is the C<employees> read/write |
ad5ed80c |
204 | accessor (see the C<employees> attribute declaration above). This |
2f04a0fc |
205 | accessor will correctly check the type constraint, but we need to extend it |
206 | with some additional processing. For this we use an C<after> method modifier, |
ad5ed80c |
207 | like so: |
208 | |
209 | after 'employees' => sub { |
36c99105 |
210 | my ( $self, $employees ) = @_; |
211 | if ( defined $employees ) { |
212 | foreach my $employee ( @{$employees} ) { |
ad5ed80c |
213 | $employee->company($self); |
36c99105 |
214 | } |
ad5ed80c |
215 | } |
216 | }; |
217 | |
218 | Again, as with the C<BUILD> method, we know that the type constraint |
219 | check has already happened, so we can just check for defined-ness on the |
220 | C<$employees> argument. |
221 | |
f1917f58 |
222 | At this point, our B<Company> class is complete. Next comes our B<Person> |
223 | class and its subclass, the previously mentioned B<Employee> class. |
224 | |
225 | The B<Person> class should be obvious to you at this point. It has a few |
226 | C<required> attributes, and the C<middle_initial> slot has an additional |
227 | C<predicate> method (which we saw in the previous recipe with the |
228 | B<BinaryTree> class). |
229 | |
230 | Next, the B<Employee> class, which should also be pretty obvious at this |
231 | point. It requires a C<title>, and maintains a weakened reference to a |
232 | B<Company> instance. The only new item, which we have seen before in |
233 | examples, but never in the recipe itself, is the C<override> method |
234 | modifier: |
235 | |
236 | override 'full_name' => sub { |
237 | my $self = shift; |
36c99105 |
238 | super() . ', ' . $self->title; |
f1917f58 |
239 | }; |
240 | |
241 | This just tells Moose that I am intentionally overriding the superclass |
242 | C<full_name> method here, and adding the value of the C<title> slot at |
243 | the end of the employee's full name. |
ad5ed80c |
244 | |
e08c54f5 |
245 | And that's about it. |
ad5ed80c |
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 |
aa670b9c |
249 | usage can be found in F<t/000_recipes/004_recipe.t>. |
ad5ed80c |
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.) |
2f04a0fc |
255 | and the sheer density of information and behaviors which Moose can pack |
ad5ed80c |
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 |
2f04a0fc |
258 | been (including all the type constraint checks, weak references, and so on). |
ad5ed80c |
259 | |
260 | And of course, this recipe also introduced the C<subtype> keyword, and |
e08c54f5 |
261 | its usefulness within the Moose toolkit. In the next recipe we will |
ad5ed80c |
262 | focus more on subtypes, and introduce the idea of type coercion as well. |
e08c54f5 |
263 | |
172e0738 |
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 | |
ad5ed80c |
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 |
4711f5f7 |
278 | inheritance graph and call the appropriate C<BUILD> methods in the |
ad5ed80c |
279 | correct order. |
280 | |
172e0738 |
281 | =back |
282 | |
471c4f09 |
283 | =head1 AUTHOR |
284 | |
285 | Stevan Little E<lt>stevan@iinteractive.comE<gt> |
286 | |
287 | =head1 COPYRIGHT AND LICENSE |
288 | |
2840a3b2 |
289 | Copyright 2006-2009 by Infinity Interactive, Inc. |
471c4f09 |
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 | |
e08c54f5 |
296 | =cut |