lib/HTTP/Body/Context.pm

   1 package HTTP::Body::Context;
   2
   3 use strict;
   4 use warnings;
   5 use base 'Class::Accessor::Fast';
   6
   7 use Class::Param     qw[];
   8 use HTTP::Headers    qw[];
   9 use Params::Validate qw[];
  10 use Scalar::Util     qw[];
  11
  12 __PACKAGE__->mk_accessors( qw[ content headers param upload ] );
  13
  14 sub new {
  15     my $class  = ref $_[0] ? ref shift : shift;
  16     my $params = Params::Validate::validate_with(
  17         params  => \@_,
  18         spec    => {
  19             headers => {
  20                 type      =>   Params::Validate::ARRAYREF
  21                              | Params::Validate::HASHREF
  22                              | Params::Validate::OBJECT,
  23                 optional  => 0,
  24                 callbacks => {
  25                     'isa HTTP::Headers instance' => sub {
  26                         return 1 unless Scalar::Util::blessed( $_[0] );
  27                         return $_[0]->isa('HTTP::Headers');
  28                     }
  29                 }
  30             },
  31             param => {
  32                 type      => Params::Validate::OBJECT,
  33                 isa       => 'Class::Param::Base',
  34                 optional  => 1
  35             },
  36             upload => {
  37                 type      => Params::Validate::OBJECT,
  38                 isa       => 'Class::Param::Base',
  39                 optional  => 1
  40             }
  41         },
  42         called  => "$class\::new"
  43     );
  44
  45     return bless( {}, $class )->initialize($params);
  46 }
  47
  48 sub initialize {
  49     my ( $self, $params ) = @_;
  50
  51     if ( ref $params->{headers} eq 'ARRAY' ) {
  52         $params->{headers} = HTTP::Headers->new( @{ $params->{headers} } );
  53     }
  54
  55     if ( ref $params->{headers} eq 'HASH' ) {
  56         $params->{headers} = HTTP::Headers->new( %{ $params->{headers} } );
  57     }
  58
  59     $params->{param}  ||= Class::Param->new;
  60     $params->{upload} ||= Class::Param->new;
  61
  62     while ( my ( $param, $value ) = each( %{ $params } ) ) {
  63         $self->$param($value);
  64     }
  65
  66     return $self;
  67 }
  68
  69 sub content_length {
  70     return shift->headers->content_length(@_);
  71 }
  72
  73 sub content_type {
  74     return shift->headers->content_type(@_);
  75 }
  76
  77 sub header {
  78     return shift->headers->header(@_);
  79 }
  80
  81 1;
  82
  83 __END__