t/000_recipes/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 tests => 18;
  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     __PACKAGE__->meta->make_immutable(debug => 0);
  66 }
  67
  68 my $r = Request->new;
  69 isa_ok($r, 'Request');
  70
  71 {
  72     my $header = $r->headers;
  73     isa_ok($header, 'HTTP::Headers');
  74
  75     is($r->headers->content_type, '', '... got no content type in the header');
  76
  77     $r->headers( { content_type => 'text/plain' } );
  78
  79     my $header2 = $r->headers;
  80     isa_ok($header2, 'HTTP::Headers');
  81     isnt($header, $header2, '... created a new HTTP::Header object');
  82
  83     is($header2->content_type, 'text/plain', '... got the right content type in the header');
  84
  85     $r->headers( [ content_type => 'text/html' ] );
  86
  87     my $header3 = $r->headers;
  88     isa_ok($header3, 'HTTP::Headers');
  89     isnt($header2, $header3, '... created a new HTTP::Header object');
  90
  91     is($header3->content_type, 'text/html', '... got the right content type in the header');
  92
  93     $r->headers( HTTP::Headers->new(content_type => 'application/pdf') );
  94
  95     my $header4 = $r->headers;
  96     isa_ok($header4, 'HTTP::Headers');
  97     isnt($header3, $header4, '... created a new HTTP::Header object');
  98
  99     is($header4->content_type, 'application/pdf', '... got the right content type in the header');
 100
 101     dies_ok {
 102         $r->headers('Foo')
 103     } '... dies when it gets bad params';
 104 }
 105
 106 {
 107     is($r->protocol, undef, '... got nothing by default');
 108
 109     lives_ok {
 110         $r->protocol('HTTP/1.0');
 111     } '... set the protocol correctly';
 112     is($r->protocol, 'HTTP/1.0', '... got nothing by default');
 113
 114     dies_ok {
 115         $r->protocol('http/1.0');
 116     } '... the protocol died with bar params correctly';
 117 }
 118