From 0af93c1b4b4e26f88db7974ab6587de9880ef5a3 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Tue, 17 Jul 2012 20:52:59 -0500 Subject: add some better type constraints and coercions --- lib/Web/Response.pm | 9 +++++++-- lib/Web/Response/Types.pm | 38 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 45 insertions(+), 2 deletions(-) create mode 100644 lib/Web/Response/Types.pm diff --git a/lib/Web/Response.pm b/lib/Web/Response.pm index e7b96c9..970f322 100644 --- a/lib/Web/Response.pm +++ b/lib/Web/Response.pm @@ -3,17 +3,20 @@ use Moose; use HTTP::Headers; +use Web::Response::Types (); + has status => ( is => 'rw', - isa => 'Int', # XXX restrict to /^[1-5][0-9][0-9]$/ + isa => 'Web::Response::Types::HTTPStatus', lazy => 1, default => sub { confess "Status was not supplied" }, ); has headers => ( is => 'rw', - isa => 'HTTP::Headers', # XXX coerce from array/hashref + isa => 'Web::Response::Types::HTTP::Headers', lazy => 1, + coerce => 1, default => sub { HTTP::Headers->new }, handles => { header => 'header', @@ -26,7 +29,9 @@ has headers => ( has body => ( is => 'rw', + isa => 'Web::Response::Types::PSGIBody', lazy => 1, + coerce => 1, default => sub { [] }, ); diff --git a/lib/Web/Response/Types.pm b/lib/Web/Response/Types.pm new file mode 100644 index 0000000..297eab2 --- /dev/null +++ b/lib/Web/Response/Types.pm @@ -0,0 +1,38 @@ +package Web::Response::Types; +use strict; +use warnings; + +use Moose::Util::TypeConstraints; + +class_type('HTTP::Headers'); + +subtype 'Web::Response::Types::StringLike', + as 'Object', + where { + return unless overload::Method($_, '""'); + my $tc = find_type_constraint('Web::Response::Types::PSGIBodyObject'); + return !$tc->check($_); + }; + +duck_type 'Web::Response::Types::PSGIBodyObject' => ['getline', 'close']; + +subtype 'Web::Response::Types::PSGIBody', + as 'ArrayRef[Str]|FileHandle|Web::Response::Types::PSGIBodyObject'; + +subtype 'Web::Response::Types::HTTPStatus', + as 'Int', + where { /^[1-5][0-9][0-9]$/ }; + +subtype 'Web::Response::Types::HTTP::Headers', + as 'HTTP::Headers'; +coerce 'Web::Response::Types::HTTP::Headers', + from 'ArrayRef', + via { HTTP::Headers->new(@$_) }, + from 'HashRef', + via { HTTP::Headers->new(%$_) }; + +coerce 'Web::Response::Types::PSGIBody', + from 'Str|Web::Response::Types::StringLike', + via { [ $_ ] }; + +1; -- cgit v1.2.3-54-g00ecf