Commit | Line | Data |
daa0fd7d |
1 | package Moose::Cookbook::Basics::Recipe5; |
2 | |
3 | # ABSTRACT: More subtypes, coercion in a B<Request> class |
4 | |
5 | __END__ |
6 | |
471c4f09 |
7 | |
8 | =pod |
9 | |
5547fba7 |
10 | =begin testing-SETUP |
c79239a2 |
11 | |
0adca353 |
12 | use Test::Requires { |
13 | 'HTTP::Headers' => '0', |
14 | 'Params::Coerce' => '0', |
15 | 'URI' => '0', |
16 | }; |
c79239a2 |
17 | |
5547fba7 |
18 | =end testing-SETUP |
c79239a2 |
19 | |
471c4f09 |
20 | =head1 SYNOPSIS |
21 | |
22 | package Request; |
471c4f09 |
23 | use Moose; |
05d9eaf6 |
24 | use Moose::Util::TypeConstraints; |
c765b254 |
25 | |
471c4f09 |
26 | use HTTP::Headers (); |
27 | use Params::Coerce (); |
28 | use URI (); |
c765b254 |
29 | |
66b58567 |
30 | subtype 'My::Types::HTTP::Headers' => as class_type('HTTP::Headers'); |
c765b254 |
31 | |
66b58567 |
32 | coerce 'My::Types::HTTP::Headers' |
50ec5055 |
33 | => from 'ArrayRef' |
c765b254 |
34 | => via { HTTP::Headers->new( @{$_} ) } |
50ec5055 |
35 | => from 'HashRef' |
c765b254 |
36 | => via { HTTP::Headers->new( %{$_} ) }; |
37 | |
66b58567 |
38 | subtype 'My::Types::URI' => as class_type('URI'); |
c765b254 |
39 | |
66b58567 |
40 | coerce 'My::Types::URI' |
50ec5055 |
41 | => from 'Object' |
c765b254 |
42 | => via { $_->isa('URI') |
43 | ? $_ |
44 | : Params::Coerce::coerce( 'URI', $_ ); } |
50ec5055 |
45 | => from 'Str' |
471c4f09 |
46 | => via { URI->new( $_, 'http' ) }; |
c765b254 |
47 | |
50ec5055 |
48 | subtype 'Protocol' |
c765b254 |
49 | => as 'Str' |
471c4f09 |
50 | => where { /^HTTP\/[0-9]\.[0-9]$/ }; |
c765b254 |
51 | |
66b58567 |
52 | has 'base' => ( is => 'rw', isa => 'My::Types::URI', coerce => 1 ); |
53 | has 'uri' => ( is => 'rw', isa => 'My::Types::URI', coerce => 1 ); |
c765b254 |
54 | has 'method' => ( is => 'rw', isa => 'Str' ); |
55 | has 'protocol' => ( is => 'rw', isa => 'Protocol' ); |
471c4f09 |
56 | has 'headers' => ( |
57 | is => 'rw', |
66b58567 |
58 | isa => 'My::Types::HTTP::Headers', |
471c4f09 |
59 | coerce => 1, |
c765b254 |
60 | default => sub { HTTP::Headers->new } |
471c4f09 |
61 | ); |
62 | |
63 | =head1 DESCRIPTION |
64 | |
f07dc78e |
65 | This recipe introduces type coercions, which are defined with the |
66 | C<coerce> sugar function. Coercions are attached to existing type |
67 | constraints, and define a (one-way) transformation from one type to |
68 | another. |
69 | |
70 | This is very powerful, but it's also magical, so you have to |
71 | explicitly ask for an attribute to be coerced. To do this, you must |
16fb3624 |
72 | set the C<coerce> attribute option to a true value. |
9deed647 |
73 | |
f07dc78e |
74 | First, we create the subtype to which we will coerce the other types: |
50ec5055 |
75 | |
66b58567 |
76 | subtype 'My::Types::HTTP::Headers' => as class_type('HTTP::Headers'); |
3a4bb3ec |
77 | |
78 | We are creating a subtype rather than using C<HTTP::Headers> as a type |
79 | directly. The reason we do this is coercions are global, and a |
80 | coercion defined for C<HTTP::Headers> in our C<Request> class would |
81 | then be defined for I<all> Moose-using classes in the current Perl |
82 | interpreter. It's a L<best practice|Moose::Manual::BestPractices> to |
83 | avoid this sort of namespace pollution. |
50ec5055 |
84 | |
3a4bb3ec |
85 | The C<class_type> sugar function is simply a shortcut for this: |
f07dc78e |
86 | |
87 | subtype 'HTTP::Headers' |
50ec5055 |
88 | => as 'Object' |
89 | => where { $_->isa('HTTP::Headers') }; |
6aa9f385 |
90 | |
f07dc78e |
91 | Internally, Moose creates a type constraint for each Moose-using |
92 | class, but for non-Moose classes, the type must be declared |
93 | explicitly. |
94 | |
95 | We could go ahead and use this new type directly: |
50ec5055 |
96 | |
c765b254 |
97 | has 'headers' => ( |
50ec5055 |
98 | is => 'rw', |
f07dc78e |
99 | isa => 'HTTP::Headers', |
c765b254 |
100 | default => sub { HTTP::Headers->new } |
50ec5055 |
101 | ); |
102 | |
f07dc78e |
103 | This creates a simple attribute which defaults to an empty instance of |
104 | L<HTTP::Headers>. |
50ec5055 |
105 | |
f07dc78e |
106 | The constructor for L<HTTP::Headers> accepts a list of key-value pairs |
107 | representing the HTTP header fields. In Perl, such a list could be |
108 | stored in an ARRAY or HASH reference. We want our C<headers> attribute |
109 | to accept those data structure instead of an B<HTTP::Headers> |
110 | instance, and just do the right thing. This is exactly what coercion |
111 | is for: |
50ec5055 |
112 | |
66b58567 |
113 | coerce 'My::Types::HTTP::Headers' |
50ec5055 |
114 | => from 'ArrayRef' |
c765b254 |
115 | => via { HTTP::Headers->new( @{$_} ) } |
50ec5055 |
116 | => from 'HashRef' |
c765b254 |
117 | => via { HTTP::Headers->new( %{$_} ) }; |
50ec5055 |
118 | |
e39d2b6b |
119 | The first argument to C<coerce> is the type I<to> which we are |
f07dc78e |
120 | coercing. Then we give it a set of C<from>/C<via> clauses. The C<from> |
121 | function takes some other type name and C<via> takes a subroutine |
122 | reference which actually does the coercion. |
123 | |
124 | However, defining the coercion doesn't do anything until we tell Moose |
125 | we want a particular attribute to be coerced: |
50ec5055 |
126 | |
c765b254 |
127 | has 'headers' => ( |
50ec5055 |
128 | is => 'rw', |
66b58567 |
129 | isa => 'My::Types::HTTP::Headers', |
50ec5055 |
130 | coerce => 1, |
c765b254 |
131 | default => sub { HTTP::Headers->new } |
50ec5055 |
132 | ); |
133 | |
f07dc78e |
134 | Now, if we use an C<ArrayRef> or C<HashRef> to populate C<headers>, it |
135 | will be coerced into a new L<HTTP::Headers> instance. With the |
136 | coercion in place, the following lines of code are all equivalent: |
50ec5055 |
137 | |
c765b254 |
138 | $foo->headers( HTTP::Headers->new( bar => 1, baz => 2 ) ); |
139 | $foo->headers( [ 'bar', 1, 'baz', 2 ] ); |
140 | $foo->headers( { bar => 1, baz => 2 } ); |
50ec5055 |
141 | |
c765b254 |
142 | As you can see, careful use of coercions can produce a very open |
143 | interface for your class, while still retaining the "safety" of your |
f07dc78e |
144 | type constraint checks. (1) |
50ec5055 |
145 | |
f07dc78e |
146 | Our next coercion shows how we can leverage existing CPAN modules to |
147 | help implement coercions. In this case we use L<Params::Coerce>. |
50ec5055 |
148 | |
f07dc78e |
149 | Once again, we need to declare a class type for our non-Moose L<URI> |
c765b254 |
150 | class: |
50ec5055 |
151 | |
66b58567 |
152 | subtype 'My::Types::URI' => as class_type('URI'); |
50ec5055 |
153 | |
f07dc78e |
154 | Then we define the coercion: |
50ec5055 |
155 | |
66b58567 |
156 | coerce 'My::Types::URI' |
50ec5055 |
157 | => from 'Object' |
c765b254 |
158 | => via { $_->isa('URI') |
159 | ? $_ |
160 | : Params::Coerce::coerce( 'URI', $_ ); } |
50ec5055 |
161 | => from 'Str' |
162 | => via { URI->new( $_, 'http' ) }; |
163 | |
f07dc78e |
164 | The first coercion takes any object and makes it a C<URI> object. The |
165 | coercion system isn't that smart, and does not check if the object is |
166 | already a L<URI>, so we check for that ourselves. If it's not a L<URI> |
167 | already, we let L<Params::Coerce> do its magic, and we just use its |
168 | return value. |
169 | |
170 | If L<Params::Coerce> didn't return a L<URI> object (for whatever |
171 | reason), Moose would throw a type constraint error. |
c765b254 |
172 | |
f07dc78e |
173 | The other coercion takes a string and converts to a L<URI>. In this |
174 | case, we are using the coercion to apply a default behavior, where a |
175 | string is assumed to be an C<http> URI. |
c765b254 |
176 | |
f07dc78e |
177 | Finally, we need to make sure our attributes enable coercion. |
c765b254 |
178 | |
66b58567 |
179 | has 'base' => ( is => 'rw', isa => 'My::Types::URI', coerce => 1 ); |
180 | has 'uri' => ( is => 'rw', isa => 'My::Types::URI', coerce => 1 ); |
c765b254 |
181 | |
f07dc78e |
182 | Re-using the coercion lets us enforce a consistent API across multiple |
183 | attributes. |
50ec5055 |
184 | |
185 | =head1 CONCLUSION |
12710e29 |
186 | |
f07dc78e |
187 | This recipe showed the use of coercions to create a more flexible and |
188 | DWIM-y API. Like any powerful magic, we recommend some |
189 | caution. Sometimes it's better to reject a value than just guess at |
190 | how to DWIM. |
191 | |
192 | We also showed the use of the C<class_type> sugar function as a |
193 | shortcut for defining a new subtype of C<Object> |
194 | |
195 | =head1 FOOTNOTES |
50ec5055 |
196 | |
f07dc78e |
197 | =over 4 |
3824830b |
198 | |
f07dc78e |
199 | =item (1) |
200 | |
201 | This particular example could be safer. Really we only want to coerce |
202 | an array with an I<even> number of elements. We could create a new |
203 | C<EvenElementArrayRef> type, and then coerce from that type, as |
204 | opposed to from a plain C<ArrayRef> |
205 | |
206 | =back |
207 | |
c79239a2 |
208 | =begin testing |
209 | |
210 | my $r = Request->new; |
211 | isa_ok( $r, 'Request' ); |
212 | |
213 | { |
214 | my $header = $r->headers; |
215 | isa_ok( $header, 'HTTP::Headers' ); |
216 | |
217 | is( $r->headers->content_type, '', |
218 | '... got no content type in the header' ); |
219 | |
220 | $r->headers( { content_type => 'text/plain' } ); |
221 | |
222 | my $header2 = $r->headers; |
223 | isa_ok( $header2, 'HTTP::Headers' ); |
224 | isnt( $header, $header2, '... created a new HTTP::Header object' ); |
225 | |
226 | is( $header2->content_type, 'text/plain', |
227 | '... got the right content type in the header' ); |
228 | |
229 | $r->headers( [ content_type => 'text/html' ] ); |
230 | |
231 | my $header3 = $r->headers; |
232 | isa_ok( $header3, 'HTTP::Headers' ); |
233 | isnt( $header2, $header3, '... created a new HTTP::Header object' ); |
234 | |
235 | is( $header3->content_type, 'text/html', |
236 | '... got the right content type in the header' ); |
237 | |
238 | $r->headers( HTTP::Headers->new( content_type => 'application/pdf' ) ); |
239 | |
240 | my $header4 = $r->headers; |
241 | isa_ok( $header4, 'HTTP::Headers' ); |
242 | isnt( $header3, $header4, '... created a new HTTP::Header object' ); |
243 | |
244 | is( $header4->content_type, 'application/pdf', |
245 | '... got the right content type in the header' ); |
246 | |
b10dde3a |
247 | isnt( |
248 | exception { |
249 | $r->headers('Foo'); |
250 | }, |
251 | undef, |
252 | '... dies when it gets bad params' |
253 | ); |
c79239a2 |
254 | } |
255 | |
256 | { |
257 | is( $r->protocol, undef, '... got nothing by default' ); |
258 | |
b10dde3a |
259 | is( |
260 | exception { |
261 | $r->protocol('HTTP/1.0'); |
262 | }, |
263 | undef, |
264 | '... set the protocol correctly' |
265 | ); |
266 | |
c79239a2 |
267 | is( $r->protocol, 'HTTP/1.0', '... got nothing by default' ); |
268 | |
b10dde3a |
269 | isnt( |
270 | exception { |
271 | $r->protocol('http/1.0'); |
272 | }, |
273 | undef, |
274 | '... the protocol died with bar params correctly' |
275 | ); |
c79239a2 |
276 | } |
277 | |
bd538e29 |
278 | { |
279 | $r->base('http://localhost/'); |
280 | isa_ok( $r->base, 'URI' ); |
281 | |
282 | $r->uri('http://localhost/'); |
283 | isa_ok( $r->uri, 'URI' ); |
284 | } |
285 | |
c79239a2 |
286 | =end testing |
287 | |
f891e7b7 |
288 | =cut |