9 eval "use HTTP::Headers; use Params::Coerce; use URI;";
10 plan skip_all => "HTTP::Headers & Params::Coerce & URI required for this test" if $@;
19 use Moose::Util::TypeConstraints;
22 use Params::Coerce ();
25 subtype Header => as Object => where { $_->isa('HTTP::Headers') };
27 coerce Header => from ArrayRef => via { HTTP::Headers->new( @{$_} ) } =>
28 from HashRef => via { HTTP::Headers->new( %{$_} ) };
30 subtype Uri => as Object => where { $_->isa('URI') };
32 coerce Uri => from Object =>
33 via { $_->isa('URI') ? $_ : Params::Coerce::coerce( 'URI', $_ ) } =>
34 from Str => via { URI->new( $_, 'http' ) };
36 subtype Protocol => as Str => where {/^HTTP\/[0-9]\.[0-9]$/};
38 has 'base' => ( is => 'rw', isa => 'Uri', coerce => 1 );
39 has 'url' => ( is => 'rw', isa => 'Uri', coerce => 1 );
40 has 'method' => ( is => 'rw', isa => 'Str' );
41 has 'protocol' => ( is => 'rw', isa => 'Protocol' );
46 default => sub { HTTP::Headers->new }
49 __PACKAGE__->meta->make_immutable( debug => 0 );
53 isa_ok($r, 'Request');
56 my $header = $r->headers;
57 isa_ok($header, 'HTTP::Headers');
59 is($r->headers->content_type, '', '... got no content type in the header');
61 $r->headers( { content_type => 'text/plain' } );
63 my $header2 = $r->headers;
64 isa_ok($header2, 'HTTP::Headers');
65 isnt($header, $header2, '... created a new HTTP::Header object');
67 is($header2->content_type, 'text/plain', '... got the right content type in the header');
69 $r->headers( [ content_type => 'text/html' ] );
71 my $header3 = $r->headers;
72 isa_ok($header3, 'HTTP::Headers');
73 isnt($header2, $header3, '... created a new HTTP::Header object');
75 is($header3->content_type, 'text/html', '... got the right content type in the header');
77 $r->headers( HTTP::Headers->new(content_type => 'application/pdf') );
79 my $header4 = $r->headers;
80 isa_ok($header4, 'HTTP::Headers');
81 isnt($header3, $header4, '... created a new HTTP::Header object');
83 is($header4->content_type, 'application/pdf', '... got the right content type in the header');
87 } '... dies when it gets bad params';
91 is($r->protocol, undef, '... got nothing by default');
94 $r->protocol('HTTP/1.0');
95 } '... set the protocol correctly';
96 is($r->protocol, 'HTTP/1.0', '... got nothing by default');
99 $r->protocol('http/1.0');
100 } '... the protocol died with bar params correctly';