+package Moose::Cookbook::Basics::Recipe5;
+
+# ABSTRACT: More subtypes, coercion in a B<Request> class
+
+__END__
+
=pod
-=head1 NAME
+=begin testing-SETUP
-Moose::Cookbook::Basics::Recipe5 - More subtypes, coercion in a B<Request> class
+use Test::Requires {
+ 'HTTP::Headers' => '0',
+ 'Params::Coerce' => '0',
+ 'URI' => '0',
+};
+
+=end testing-SETUP
=head1 SYNOPSIS
use Params::Coerce ();
use URI ();
- class_type('HTTP::Headers');
+ subtype 'My::Types::HTTP::Headers' => as class_type('HTTP::Headers');
- coerce 'HTTP::Headers'
+ coerce 'My::Types::HTTP::Headers'
=> from 'ArrayRef'
=> via { HTTP::Headers->new( @{$_} ) }
=> from 'HashRef'
=> via { HTTP::Headers->new( %{$_} ) };
- class_type('URI');
+ subtype 'My::Types::URI' => as class_type('URI');
- coerce 'URI'
+ coerce 'My::Types::URI'
=> from 'Object'
=> via { $_->isa('URI')
? $_
=> as 'Str'
=> where { /^HTTP\/[0-9]\.[0-9]$/ };
- has 'base' => ( is => 'rw', isa => 'URI', coerce => 1 );
- has 'uri' => ( is => 'rw', isa => 'URI', coerce => 1 );
+ has 'base' => ( is => 'rw', isa => 'My::Types::URI', coerce => 1 );
+ has 'uri' => ( is => 'rw', isa => 'My::Types::URI', coerce => 1 );
has 'method' => ( is => 'rw', isa => 'Str' );
has 'protocol' => ( is => 'rw', isa => 'Protocol' );
has 'headers' => (
is => 'rw',
- isa => 'HTTP::Headers',
+ isa => 'My::Types::HTTP::Headers',
coerce => 1,
default => sub { HTTP::Headers->new }
);
constraints, and define a (one-way) transformation from one type to
another.
-This is very powerful, but it's also magical, so you have to
-explicitly ask for an attribute to be coerced. To do this, you must
-set the C<coerce> attribute parameter to a true value.
+This is very powerful, but it can also have unexpected consequences, so
+you have to explicitly ask for an attribute to be coerced. To do this,
+you must set the C<coerce> attribute option to a true value.
First, we create the subtype to which we will coerce the other types:
- class_type('HTTP::Headers');
+ subtype 'My::Types::HTTP::Headers' => as class_type('HTTP::Headers');
+
+We are creating a subtype rather than using C<HTTP::Headers> as a type
+directly. The reason we do this is that coercions are global, and a
+coercion defined for C<HTTP::Headers> in our C<Request> class would
+then be defined for I<all> Moose-using classes in the current Perl
+interpreter. It's a L<best practice|Moose::Manual::BestPractices> to
+avoid this sort of namespace pollution.
-The C<class_type> sugar function is simply a shortcut for something
-like this:
+The C<class_type> sugar function is simply a shortcut for this:
subtype 'HTTP::Headers'
=> as 'Object'
has 'headers' => (
is => 'rw',
- isa => 'HTTP::Headers',
+ isa => 'My::Types::HTTP::Headers',
default => sub { HTTP::Headers->new }
);
The constructor for L<HTTP::Headers> accepts a list of key-value pairs
representing the HTTP header fields. In Perl, such a list could be
stored in an ARRAY or HASH reference. We want our C<headers> attribute
-to accept those data structure instead of an B<HTTP::Headers>
+to accept those data structures instead of an B<HTTP::Headers>
instance, and just do the right thing. This is exactly what coercion
is for:
- coerce 'HTTP::Headers'
+ coerce 'My::Types::HTTP::Headers'
=> from 'ArrayRef'
=> via { HTTP::Headers->new( @{$_} ) }
=> from 'HashRef'
=> via { HTTP::Headers->new( %{$_} ) };
-The first argument to c<coerce> is the type I<to> which we are
+The first argument to C<coerce> is the type I<to> which we are
coercing. Then we give it a set of C<from>/C<via> clauses. The C<from>
function takes some other type name and C<via> takes a subroutine
reference which actually does the coercion.
has 'headers' => (
is => 'rw',
- isa => 'Header',
+ isa => 'My::Types::HTTP::Headers',
coerce => 1,
default => sub { HTTP::Headers->new }
);
Once again, we need to declare a class type for our non-Moose L<URI>
class:
- class_type('URI');
+ subtype 'My::Types::URI' => as class_type('URI');
Then we define the coercion:
- coerce 'URI'
+ coerce 'My::Types::URI'
=> from 'Object'
=> via { $_->isa('URI')
? $_
If L<Params::Coerce> didn't return a L<URI> object (for whatever
reason), Moose would throw a type constraint error.
-The other coercion takes a string and converts to a L<URI>. In this
+The other coercion takes a string and converts it to a L<URI>. In this
case, we are using the coercion to apply a default behavior, where a
string is assumed to be an C<http> URI.
Finally, we need to make sure our attributes enable coercion.
- has 'base' => ( is => 'rw', isa => 'URI', coerce => 1 );
- has 'uri' => ( is => 'rw', isa => 'URI', coerce => 1 );
+ has 'base' => ( is => 'rw', isa => 'My::Types::URI', coerce => 1 );
+ has 'uri' => ( is => 'rw', isa => 'My::Types::URI', coerce => 1 );
Re-using the coercion lets us enforce a consistent API across multiple
attributes.
=head1 CONCLUSION
This recipe showed the use of coercions to create a more flexible and
-DWIM-y API. Like any powerful magic, we recommend some
+DWIM-y API. Like any powerful feature, we recommend some
caution. Sometimes it's better to reject a value than just guess at
how to DWIM.
We also showed the use of the C<class_type> sugar function as a
-shortcut for defining a new subtype of C<Object>
+shortcut for defining a new subtype of C<Object>.
=head1 FOOTNOTES
This particular example could be safer. Really we only want to coerce
an array with an I<even> number of elements. We could create a new
C<EvenElementArrayRef> type, and then coerce from that type, as
-opposed to from a plain C<ArrayRef>
+opposed to a plain C<ArrayRef>
=back
-=head1 AUTHORS
+=begin testing
+
+my $r = Request->new;
+isa_ok( $r, 'Request' );
+
+{
+ my $header = $r->headers;
+ isa_ok( $header, 'HTTP::Headers' );
+
+ is( $r->headers->content_type, '',
+ '... got no content type in the header' );
+
+ $r->headers( { content_type => 'text/plain' } );
+
+ my $header2 = $r->headers;
+ isa_ok( $header2, 'HTTP::Headers' );
+ isnt( $header, $header2, '... created a new HTTP::Header object' );
+
+ is( $header2->content_type, 'text/plain',
+ '... got the right content type in the header' );
+
+ $r->headers( [ content_type => 'text/html' ] );
+
+ my $header3 = $r->headers;
+ isa_ok( $header3, 'HTTP::Headers' );
+ isnt( $header2, $header3, '... created a new HTTP::Header object' );
+
+ is( $header3->content_type, 'text/html',
+ '... got the right content type in the header' );
+
+ $r->headers( HTTP::Headers->new( content_type => 'application/pdf' ) );
+
+ my $header4 = $r->headers;
+ isa_ok( $header4, 'HTTP::Headers' );
+ isnt( $header3, $header4, '... created a new HTTP::Header object' );
+
+ is( $header4->content_type, 'application/pdf',
+ '... got the right content type in the header' );
+
+ isnt(
+ exception {
+ $r->headers('Foo');
+ },
+ undef,
+ '... dies when it gets bad params'
+ );
+}
+
+{
+ is( $r->protocol, undef, '... got nothing by default' );
-Stevan Little E<lt>stevan@iinteractive.comE<gt>
+ is(
+ exception {
+ $r->protocol('HTTP/1.0');
+ },
+ undef,
+ '... set the protocol correctly'
+ );
-Dave Rolsky E<lt>autarch@urth.orgE<gt>
+ is( $r->protocol, 'HTTP/1.0', '... got nothing by default' );
-=head1 COPYRIGHT AND LICENSE
+ isnt(
+ exception {
+ $r->protocol('http/1.0');
+ },
+ undef,
+ '... the protocol died with bar params correctly'
+ );
+}
-Copyright 2006-2009 by Infinity Interactive, Inc.
+{
+ $r->base('http://localhost/');
+ isa_ok( $r->base, 'URI' );
-L<http://www.iinteractive.com>
+ $r->uri('http://localhost/');
+ isa_ok( $r->uri, 'URI' );
+}
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
+=end testing
=cut
projects / gitmo/Moose.git / blobdiff