X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FCookbook%2FBasics%2FRecipe5.pod;h=46acef4325318c71e9d6c247e638000c9b56198e;hb=01062d8a9c752c413210277e06128d4c87224e81;hp=dd4120c6bc01b9a463c7a1a7502f69b59835924e;hpb=5547fba771baa52a04ec8dcb3673032ed4c1c0cc;p=gitmo%2FMoose.git diff --git a/lib/Moose/Cookbook/Basics/Recipe5.pod b/lib/Moose/Cookbook/Basics/Recipe5.pod index dd4120c..46acef4 100644 --- a/lib/Moose/Cookbook/Basics/Recipe5.pod +++ b/lib/Moose/Cookbook/Basics/Recipe5.pod @@ -1,23 +1,22 @@ +package Moose::Cookbook::Basics::Recipe5; + +# ABSTRACT: More subtypes, coercion in a B class + +__END__ + =pod =begin testing-SETUP -BEGIN { - eval 'use HTTP::Headers; use Params::Coerce; use URI;'; - if ($@) { - diag 'HTTP::Headers, Params::Coerce & URI required for this test'; - ok(1); - exit 0; - } -} +use Test::Requires { + 'HTTP::Headers' => '0', + 'Params::Coerce' => '0', + 'URI' => '0', +}; =end testing-SETUP -=head1 NAME - -Moose::Cookbook::Basics::Recipe5 - More subtypes, coercion in a B class - =head1 SYNOPSIS package Request; @@ -28,17 +27,17 @@ Moose::Cookbook::Basics::Recipe5 - More subtypes, coercion in a B class use Params::Coerce (); use URI (); - subtype 'My.HTTP::Headers' => as class_type('HTTP::Headers'); + subtype 'My::Types::HTTP::Headers' => as class_type('HTTP::Headers'); - coerce 'My.HTTP::Headers' + coerce 'My::Types::HTTP::Headers' => from 'ArrayRef' => via { HTTP::Headers->new( @{$_} ) } => from 'HashRef' => via { HTTP::Headers->new( %{$_} ) }; - subtype 'My.URI' => as class_type('HTTP::Headers'); + subtype 'My::Types::URI' => as class_type('URI'); - coerce 'My.URI' + coerce 'My::Types::URI' => from 'Object' => via { $_->isa('URI') ? $_ @@ -50,13 +49,13 @@ Moose::Cookbook::Basics::Recipe5 - More subtypes, coercion in a B class => as 'Str' => where { /^HTTP\/[0-9]\.[0-9]$/ }; - has 'base' => ( is => 'rw', isa => 'My.URI', coerce => 1 ); - has 'uri' => ( is => 'rw', isa => 'My.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 => 'My.HTTP::Headers', + isa => 'My::Types::HTTP::Headers', coerce => 1, default => sub { HTTP::Headers->new } ); @@ -68,16 +67,16 @@ C sugar function. Coercions are attached to existing type 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 attribute option 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 attribute option to a true value. First, we create the subtype to which we will coerce the other types: - subtype 'My.HTTP::Headers' => as class_type('HTTP::Headers'); + subtype 'My::Types::HTTP::Headers' => as class_type('HTTP::Headers'); We are creating a subtype rather than using C as a type -directly. The reason we do this is coercions are global, and a +directly. The reason we do this is that coercions are global, and a coercion defined for C in our C class would then be defined for I Moose-using classes in the current Perl interpreter. It's a L to @@ -97,7 +96,7 @@ We could go ahead and use this new type directly: has 'headers' => ( is => 'rw', - isa => 'HTTP::Headers', + isa => 'My::Types::HTTP::Headers', default => sub { HTTP::Headers->new } ); @@ -107,17 +106,17 @@ L. The constructor for L 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 attribute -to accept those data structure instead of an B +to accept those data structures instead of an B instance, and just do the right thing. This is exactly what coercion is for: - coerce 'My.HTTP::Headers' + coerce 'My::Types::HTTP::Headers' => from 'ArrayRef' => via { HTTP::Headers->new( @{$_} ) } => from 'HashRef' => via { HTTP::Headers->new( %{$_} ) }; -The first argument to c is the type I which we are +The first argument to C is the type I which we are coercing. Then we give it a set of C/C clauses. The C function takes some other type name and C takes a subroutine reference which actually does the coercion. @@ -127,7 +126,7 @@ we want a particular attribute to be coerced: has 'headers' => ( is => 'rw', - isa => 'My.HTTP::Headers', + isa => 'My::Types::HTTP::Headers', coerce => 1, default => sub { HTTP::Headers->new } ); @@ -150,11 +149,11 @@ help implement coercions. In this case we use L. Once again, we need to declare a class type for our non-Moose L class: - subtype 'My.URI' => as class_type('HTTP::Headers'); + subtype 'My::Types::URI' => as class_type('URI'); Then we define the coercion: - coerce 'My.URI' + coerce 'My::Types::URI' => from 'Object' => via { $_->isa('URI') ? $_ @@ -171,14 +170,14 @@ return value. If L didn't return a L object (for whatever reason), Moose would throw a type constraint error. -The other coercion takes a string and converts to a L. In this +The other coercion takes a string and converts it to a L. In this case, we are using the coercion to apply a default behavior, where a string is assumed to be an C URI. Finally, we need to make sure our attributes enable coercion. - has 'base' => ( is => 'rw', isa => 'My.URI', coerce => 1 ); - has 'uri' => ( is => 'rw', isa => 'My.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. @@ -186,12 +185,12 @@ 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 sugar function as a -shortcut for defining a new subtype of C +shortcut for defining a new subtype of C. =head1 FOOTNOTES @@ -202,25 +201,10 @@ shortcut for defining a new subtype of C This particular example could be safer. Really we only want to coerce an array with an I number of elements. We could create a new C type, and then coerce from that type, as -opposed to from a plain C +opposed to a plain C =back -=head1 AUTHORS - -Stevan Little Estevan@iinteractive.comE - -Dave Rolsky Eautarch@urth.orgE - -=head1 COPYRIGHT AND LICENSE - -Copyright 2006-2009 by Infinity Interactive, Inc. - -L - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - =begin testing my $r = Request->new; @@ -260,25 +244,43 @@ isa_ok( $r, 'Request' ); is( $header4->content_type, 'application/pdf', '... got the right content type in the header' ); - dies_ok { - $r->headers('Foo'); - } - '... dies when it gets bad params'; + isnt( + exception { + $r->headers('Foo'); + }, + undef, + '... dies when it gets bad params' + ); } { is( $r->protocol, undef, '... got nothing by default' ); - lives_ok { - $r->protocol('HTTP/1.0'); - } - '... set the protocol correctly'; + is( + exception { + $r->protocol('HTTP/1.0'); + }, + undef, + '... set the protocol correctly' + ); + is( $r->protocol, 'HTTP/1.0', '... got nothing by default' ); - dies_ok { - $r->protocol('http/1.0'); - } - '... the protocol died with bar params correctly'; + isnt( + exception { + $r->protocol('http/1.0'); + }, + undef, + '... the protocol died with bar params correctly' + ); +} + +{ + $r->base('http://localhost/'); + isa_ok( $r->base, 'URI' ); + + $r->uri('http://localhost/'); + isa_ok( $r->uri, 'URI' ); } =end testing