Moose::Cookbook::Recipe5 - coerce -

次は Recipe5 也。

ソース

package HTML::Location;

use URI;

sub __as_URI {
    my $self = shift;
    return URI->new( $self->uri );
}

package Request;

use Moose;
use Moose::Util::TypeConstraints;

use HTTP::Headers ();
use Params::Coerce ();
use URI ();

subtype 'Header' => as 'Object' => where { $_->isa('HTTP::Headers') };
coerce 'Header'
    => from 'ArrayRef'
    => via { HTTP::Headers->new( @{$_} ) }
    => from 'HashRef'
    => via { HTTP::Headers->new( %{$_} ) };

subtype 'Uri' => as 'Object' => where { $_->isa('URI') };
coerce 'Uri'
    => from 'Object'
    => via { $_->isa('URI') ? $_ : Params::Coerce::coerce('URI', $_) }
    => from 'Str'
    => via { URI->new($_, 'http') };

subtype 'Protocol' => as 'Str' => where { m|^HTTP/[0-9]\.[0-9]$| };

has 'base' => ( is => 'rw', isa => 'Uri', coerce => 1 );
has 'uri' => ( is => 'rw', isa => 'Uri', coerce => 1 );
has 'method' => ( is => 'rw', isa => 'Uri' );
has 'protocol' => ( is => 'rw', isa => 'Protocol' );
has 'headers' => ( is => 'rw', isa => 'Header', coerce => 1, default => sub { HTTP::Headers->new } );

package main;

use HTML::Location;
use HTTP::Headers;
use Test::More qw(no_plan);

my $request = Request->new;

ok($request, 'Create instance');

$request->headers(['Content-Type', 'text/plain']);

ok($request->headers->isa('HTTP::Headers'), 'HTTP::Headers object');
is($request->headers->header('Content-Type'), 'text/plain', 'property check');

$request->headers({ 'Accept' => 'application/xrds+xml' });

is($request->headers->isa('HTTP::Headers'), 1, 'HTTP::Headers object');
is($request->headers->header('Content-Type'), undef, 'property check');
is($request->headers->header('Accept'), 'application/xrds+xml', 'property check');

my $location = HTML::Location->new('/var/www/htdocs', 'http://d.hatena.ne.jp');

$request->uri($location);

ok($request->uri->isa('URI'), 'URI object');
is($request->uri->as_string, 'http://d.hatena.ne.jp/', 'String compare');

解説

coerce

Params::Coerce のメモ - Yet Another Hackadelic で Params::Coerce を紹介しましたが、まさにその機能を変換ルールとして適用出来るのが coerce です。

coerce 'Header'
    => from 'ArrayRef'
    => via { HTTP::Headers->new( @{$_} ) }
    => from 'HashRef'
    => via { HTTP::Headers->new( %{$_} ) };

ArrayRef なら配列にデリファレンス、HashRef ならハッシュにデリファレンスしてインスタンス化って強制ですね。

coerce 'Uri'
    => from 'Object'
    => via { $_->isa('URI') ? $_ : Params::Coerce::coerce('URI', $_) }
    => from 'Str'
    => via { URI->new($_, 'http') };

こっちはプリミティブじゃないオブジェクトの場合の coerce もある。ここは Params::Coerce の機能を使って URI オブジェクトじゃなく、何かのオブジェクトで、coerce する為のルールがあれば変換って事にしてる。

従って冒頭の方に、

package HTML::Location;

use URI;

sub __as_URI {
    my $self = shift;
    return URI->new( $self->uri );
}

としておくことによって Params::Coerce の機能で URI に変換出来る。
これは非常に素敵な機能ですね。特にリクエストデータは Apache 系とか HTTP::Request, CGI とか色々考えられるけど、その辺りを一つのオブジェクトに集約出来る、しかもかなりクールに書けるのがいい。