foo
[gitmo/Moose.git] / t / 005_recipe.t
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5
6 use Test::More;
7
8 BEGIN {
9     eval "use HTTP::Headers; use Params::Coerce; use URI;";
10     plan skip_all => "HTTP::Headers & Params::Coerce & URI required for this test" if $@;        
11     plan no_plan => 1;    
12 }
13
14 use Test::Exception;
15
16 BEGIN {
17     use_ok('Moose');           
18 }
19
20 {
21         package Request;
22         use Moose;
23     use Moose::Util::TypeConstraints;
24         
25         use HTTP::Headers  ();
26         use Params::Coerce ();
27         use URI            ();
28
29         subtype Header
30             => as Object
31             => where { $_->isa('HTTP::Headers') };
32
33         coerce Header
34             => from ArrayRef
35                 => via { HTTP::Headers->new( @{ $_ } ) }
36             => from HashRef
37                 => via { HTTP::Headers->new( %{ $_ } ) };
38
39         subtype Uri
40             => as Object
41             => where { $_->isa('URI') };
42
43         coerce Uri
44             => from Object
45                 => via { $_->isa('URI') ? $_ : Params::Coerce::coerce( 'URI', $_ ) }
46             => from Str
47                 => via { URI->new( $_, 'http' ) };
48
49         subtype Protocol
50             => as Str
51             => where { /^HTTP\/[0-9]\.[0-9]$/ };
52
53
54         has 'base'     => (is => 'rw', isa => 'Uri', coerce  => 1);
55         has 'url'      => (is => 'rw', isa => 'Uri', coerce  => 1);     
56         has 'method'   => (is => 'rw', isa => 'Str');   
57         has 'protocol' => (is => 'rw', isa => 'Protocol');              
58         has 'headers'  => (
59             is      => 'rw',
60             isa     => 'Header',
61             coerce  => 1,
62             default => sub { HTTP::Headers->new } 
63     );
64 }
65
66 my $r = Request->new;
67 isa_ok($r, 'Request');
68
69 {
70     my $header = $r->headers;
71     isa_ok($header, 'HTTP::Headers');
72
73     is($r->headers->content_type, '', '... got no content type in the header');
74
75     $r->headers( { content_type => 'text/plain' } );
76
77     my $header2 = $r->headers;
78     isa_ok($header2, 'HTTP::Headers');
79     isnt($header, $header2, '... created a new HTTP::Header object');
80
81     is($header2->content_type, 'text/plain', '... got the right content type in the header');
82
83     $r->headers( [ content_type => 'text/html' ] );
84
85     my $header3 = $r->headers;
86     isa_ok($header3, 'HTTP::Headers');
87     isnt($header2, $header3, '... created a new HTTP::Header object');
88
89     is($header3->content_type, 'text/html', '... got the right content type in the header');
90     
91     $r->headers( HTTP::Headers->new(content_type => 'application/pdf') );
92     
93     my $header4 = $r->headers;    
94     isa_ok($header4, 'HTTP::Headers');
95     isnt($header3, $header4, '... created a new HTTP::Header object');
96
97     is($header4->content_type, 'application/pdf', '... got the right content type in the header');    
98     
99     dies_ok {
100         $r->headers('Foo')
101     } '... dies when it gets bad params';
102 }
103
104 {
105     is($r->protocol, undef, '... got nothing by default');
106
107     lives_ok {
108         $r->protocol('HTTP/1.0');
109     } '... set the protocol correctly';
110     is($r->protocol, 'HTTP/1.0', '... got nothing by default');
111             
112     dies_ok {
113         $r->protocol('http/1.0');
114     } '... the protocol died with bar params correctly';            
115 }
116