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