lib/Moose/Cookbook/Basics/HTTP_SubtypesAndCoercion.pod

   1 package Moose::Cookbook::Basics::HTTP_SubtypesAndCoercion;
   2
   3 # ABSTRACT: Demonstrates subtypes and coercion use HTTP-related classes (Request, Protocol, etc.)
   4
   5 __END__
   6
   7
   8 =pod
   9
  10 =begin testing-SETUP
  11
  12 use Test::Requires {
  13     'HTTP::Headers'  => '0',
  14     'Params::Coerce' => '0',
  15     'URI'            => '0',
  16 };
  17
  18 =end testing-SETUP
  19
  20 =head1 SYNOPSIS
  21
  22   package Request;
  23   use Moose;
  24   use Moose::Util::TypeConstraints;
  25
  26   use HTTP::Headers  ();
  27   use Params::Coerce ();
  28   use URI            ();
  29
  30   subtype 'My::Types::HTTP::Headers' => as class_type('HTTP::Headers');
  31
  32   coerce 'My::Types::HTTP::Headers'
  33       => from 'ArrayRef'
  34           => via { HTTP::Headers->new( @{$_} ) }
  35       => from 'HashRef'
  36           => via { HTTP::Headers->new( %{$_} ) };
  37
  38   subtype 'My::Types::URI' => as class_type('URI');
  39
  40   coerce 'My::Types::URI'
  41       => from 'Object'
  42           => via { $_->isa('URI')
  43                    ? $_
  44                    : Params::Coerce::coerce( 'URI', $_ ); }
  45       => from 'Str'
  46           => via { URI->new( $_, 'http' ) };
  47
  48   subtype 'Protocol'
  49       => as 'Str'
  50       => where { /^HTTP\/[0-9]\.[0-9]$/ };
  51
  52   has 'base' => ( is => 'rw', isa => 'My::Types::URI', coerce => 1 );
  53   has 'uri'  => ( is => 'rw', isa => 'My::Types::URI', coerce => 1 );
  54   has 'method'   => ( is => 'rw', isa => 'Str' );
  55   has 'protocol' => ( is => 'rw', isa => 'Protocol' );
  56   has 'headers'  => (
  57       is      => 'rw',
  58       isa     => 'My::Types::HTTP::Headers',
  59       coerce  => 1,
  60       default => sub { HTTP::Headers->new }
  61   );
  62
  63 =head1 DESCRIPTION
  64
  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 can also have unexpected consequences, so
  71 you have to explicitly ask for an attribute to be coerced. To do this,
  72 you must set the C<coerce> attribute option to a true value.
  73
  74 First, we create the subtype to which we will coerce the other types:
  75
  76   subtype 'My::Types::HTTP::Headers' => as class_type('HTTP::Headers');
  77
  78 We are creating a subtype rather than using C<HTTP::Headers> as a type
  79 directly. The reason we do this is that 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.
  84
  85 The C<class_type> sugar function is simply a shortcut for this:
  86
  87   subtype 'HTTP::Headers'
  88       => as 'Object'
  89       => where { $_->isa('HTTP::Headers') };
  90
  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:
  96
  97   has 'headers' => (
  98       is      => 'rw',
  99       isa     => 'My::Types::HTTP::Headers',
 100       default => sub { HTTP::Headers->new }
 101   );
 102
 103 This creates a simple attribute which defaults to an empty instance of
 104 L<HTTP::Headers>.
 105
 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 structures instead of an B<HTTP::Headers>
 110 instance, and just do the right thing. This is exactly what coercion
 111 is for:
 112
 113   coerce 'My::Types::HTTP::Headers'
 114       => from 'ArrayRef'
 115           => via { HTTP::Headers->new( @{$_} ) }
 116       => from 'HashRef'
 117           => via { HTTP::Headers->new( %{$_} ) };
 118
 119 The first argument to C<coerce> is the type I<to> which we are
 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:
 126
 127   has 'headers' => (
 128       is      => 'rw',
 129       isa     => 'My::Types::HTTP::Headers',
 130       coerce  => 1,
 131       default => sub { HTTP::Headers->new }
 132   );
 133
 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:
 137
 138   $foo->headers( HTTP::Headers->new( bar => 1, baz => 2 ) );
 139   $foo->headers( [ 'bar', 1, 'baz', 2 ] );
 140   $foo->headers( { bar => 1, baz => 2 } );
 141
 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
 144 type constraint checks. (1)
 145
 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>.
 148
 149 Once again, we need to declare a class type for our non-Moose L<URI>
 150 class:
 151
 152   subtype 'My::Types::URI' => as class_type('URI');
 153
 154 Then we define the coercion:
 155
 156   coerce 'My::Types::URI'
 157       => from 'Object'
 158           => via { $_->isa('URI')
 159                    ? $_
 160                    : Params::Coerce::coerce( 'URI', $_ ); }
 161       => from 'Str'
 162           => via { URI->new( $_, 'http' ) };
 163
 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.
 172
 173 The other coercion takes a string and converts it 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.
 176
 177 Finally, we need to make sure our attributes enable coercion.
 178
 179   has 'base' => ( is => 'rw', isa => 'My::Types::URI', coerce => 1 );
 180   has 'uri'  => ( is => 'rw', isa => 'My::Types::URI', coerce => 1 );
 181
 182 Re-using the coercion lets us enforce a consistent API across multiple
 183 attributes.
 184
 185 =head1 CONCLUSION
 186
 187 This recipe showed the use of coercions to create a more flexible and
 188 DWIM-y API. Like any powerful feature, 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
 196
 197 =over 4
 198
 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 a plain C<ArrayRef>
 205
 206 =back
 207
 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
 247     isnt(
 248         exception {
 249             $r->headers('Foo');
 250         },
 251         undef,
 252         '... dies when it gets bad params'
 253     );
 254 }
 255
 256 {
 257     is( $r->protocol, undef, '... got nothing by default' );
 258
 259     is(
 260         exception {
 261             $r->protocol('HTTP/1.0');
 262         },
 263         undef,
 264         '... set the protocol correctly'
 265     );
 266
 267     is( $r->protocol, 'HTTP/1.0', '... got nothing by default' );
 268
 269     isnt(
 270         exception {
 271             $r->protocol('http/1.0');
 272         },
 273         undef,
 274         '... the protocol died with bar params correctly'
 275     );
 276 }
 277
 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
 286 =end testing
 287
 288 =cut