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