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