lib/HTTP/Body/Compat.pm

   1 package HTTP::Body::Compat;
   2
   3 use strict;
   4 use warnings;
   5 use base 'HTTP::Body';
   6
   7 use Params::Validate    qw[];
   8 use HTTP::Body::Context qw[];
   9
  10 sub new {
  11     my $class   = ref $_[0] ? ref shift : shift;
  12     my ( $content_type, $content_length ) = Params::Validate::validate_with(
  13         params  => \@_,
  14         spec    => [
  15             {
  16                 type      => Params::Validate::SCALAR,
  17                 optional  => 0
  18             },
  19             {
  20                 type      => Params::Validate::SCALAR,
  21                 optional  => 0
  22             }
  23         ],
  24         called  => "$class\::new"
  25     );
  26
  27     my $context = HTTP::Body::Context->new(
  28         headers => {
  29             'Content-Type'   => $content_type,
  30             'Content-Length' => $content_length
  31         }
  32     );
  33
  34     return bless( {}, $class )->initialize( { context => $context } );
  35 }
  36
  37 sub add {
  38     my $self = shift;
  39
  40     if ( defined $_[0] ) {
  41         $self->{length} += bytes::length $_[0];
  42     }
  43
  44     $self->put(@_);
  45
  46     if ( $self->length == $self->content_length ) {
  47         $self->eos;
  48         return 0;
  49     }
  50
  51     return ( $self->length - $self->content_length );
  52 }
  53
  54 sub body {
  55     return $_[0]->context->content;
  56 }
  57
  58 sub buffer {
  59     return '';
  60 }
  61
  62 sub content_length {
  63     return $_[0]->context->content_length;
  64 }
  65
  66 sub content_type {
  67     return $_[0]->context->content_type;
  68 }
  69
  70 sub length {
  71     return $_[0]->{length};
  72 }
  73
  74 sub state {
  75     return 'done';
  76 }
  77
  78 sub param {
  79     my $self = shift;
  80
  81     if ( @_ == 2 ) {
  82         return $self->context->param->add(@_);
  83     }
  84
  85     return scalar $self->context->param->as_hash;
  86 }
  87
  88 sub upload {
  89     my $self = shift;
  90
  91     if ( @_ == 2 ) {
  92         return $self->context->upload->add(@_);
  93     }
  94
  95     return scalar $self->context->upload->as_hash;
  96 }
  97
  98 1;