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.HTTP::Headers' => as class_type('HTTP::Headers');
  32
  33   coerce 'My.HTTP::Headers'
  34       => from 'ArrayRef'
  35           => via { HTTP::Headers->new( @{$_} ) }
  36       => from 'HashRef'
  37           => via { HTTP::Headers->new( %{$_} ) };
  38
  39   subtype 'My.URI' => as class_type('HTTP::Headers');
  40
  41   coerce 'My.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.URI', coerce => 1 );
  54   has 'uri'  => ( is => 'rw', isa => 'My.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.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.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.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.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.URI' => as class_type('HTTP::Headers');
 154
 155 Then we define the coercion:
 156
 157   coerce 'My.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.URI', coerce => 1 );
 181   has 'uri'  => ( is => 'rw', isa => 'My.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