4 use Test::More 'no_plan';
10 # =begin testing SETUP
12 eval 'use HTTP::Headers; use Params::Coerce; use URI;';
14 diag 'HTTP::Headers, Params::Coerce & URI required for this test';
22 # =begin testing SETUP
27 use Mouse::Util::TypeConstraints;
30 use Params::Coerce ();
33 subtype 'My::Types::HTTP::Headers' => as class_type('HTTP::Headers');
35 coerce 'My::Types::HTTP::Headers'
37 => via { HTTP::Headers->new( @{$_} ) }
39 => via { HTTP::Headers->new( %{$_} ) };
41 subtype 'My::Types::URI' => as class_type('URI');
43 coerce 'My::Types::URI'
45 => via { $_->isa('URI')
47 : Params::Coerce::coerce( 'URI', $_ ); }
49 => via { URI->new( $_, 'http' ) };
53 => where { /^HTTP\/[0-9]\.[0-9]$/ };
55 has 'base' => ( is => 'rw', isa => 'My::Types::URI', coerce => 1 );
56 has 'uri' => ( is => 'rw', isa => 'My::Types::URI', coerce => 1 );
57 has 'method' => ( is => 'rw', isa => 'Str' );
58 has 'protocol' => ( is => 'rw', isa => 'Protocol' );
61 isa => 'My::Types::HTTP::Headers',
63 default => sub { HTTP::Headers->new }
72 isa_ok( $r, 'Request' );
75 my $header = $r->headers;
76 isa_ok( $header, 'HTTP::Headers' );
78 is( $r->headers->content_type, '',
79 '... got no content type in the header' );
81 $r->headers( { content_type => 'text/plain' } );
83 my $header2 = $r->headers;
84 isa_ok( $header2, 'HTTP::Headers' );
85 isnt( $header, $header2, '... created a new HTTP::Header object' );
87 is( $header2->content_type, 'text/plain',
88 '... got the right content type in the header' );
90 $r->headers( [ content_type => 'text/html' ] );
92 my $header3 = $r->headers;
93 isa_ok( $header3, 'HTTP::Headers' );
94 isnt( $header2, $header3, '... created a new HTTP::Header object' );
96 is( $header3->content_type, 'text/html',
97 '... got the right content type in the header' );
99 $r->headers( HTTP::Headers->new( content_type => 'application/pdf' ) );
101 my $header4 = $r->headers;
102 isa_ok( $header4, 'HTTP::Headers' );
103 isnt( $header3, $header4, '... created a new HTTP::Header object' );
105 is( $header4->content_type, 'application/pdf',
106 '... got the right content type in the header' );
111 '... dies when it gets bad params';
115 is( $r->protocol, undef, '... got nothing by default' );
118 $r->protocol('HTTP/1.0');
120 '... set the protocol correctly';
121 is( $r->protocol, 'HTTP/1.0', '... got nothing by default' );
124 $r->protocol('http/1.0');
126 '... the protocol died with bar params correctly';
130 $r->base('http://localhost/');
131 isa_ok( $r->base, 'URI' );
133 $r->uri('http://localhost/');
134 isa_ok( $r->uri, 'URI' );