lib/HTTP/Body.pm

   1 package HTTP::Body;
   2
   3 use strict;
   4
   5 use Carp         qw[ ];
   6 use List::Util   qw[ first ];
   7 use Scalar::Util qw[ blessed ];
   8
   9 our $PARSERS = {
  10     'application/octet-stream'          => 'HTTP::Body::Octetstream',
  11     'application/x-www-form-urlencoded' => 'HTTP::Body::Urlencoded',
  12     'multipart/form-data'               => 'HTTP::Body::Multipart'
  13 };
  14
  15 sub new {
  16     my ( $class, $content_type, $content_length ) = @_;
  17
  18     unless ( @_ == 3 ) {
  19         Carp::croak( $class, '->new( $content_type, $content_length )' );
  20     }
  21
  22     my $type = first { index( lc($content_type), $_ ) >= 0 } keys %{ $PARSERS };
  23     my $body = $PARSERS->{ $type || 'application/octet-stream' };
  24
  25     eval "require $body";
  26
  27     if ( $@ ) {
  28         die $@;
  29     }
  30
  31     my $self = {
  32         buffer         => '',
  33         content_length => $content_length,
  34         content_type   => $content_type,
  35         param          => { },
  36         upload         => { }
  37     };
  38
  39     bless( $self, $body );
  40
  41     return $self->init;
  42 }
  43
  44 sub add {
  45     Carp::croak('Define abstract method add() in implementation');
  46 }
  47
  48 sub init {
  49     return $_[0];
  50 }
  51
  52 sub body {
  53     my $self = shift;
  54     $self->{body} = shift if @_;
  55     return $self->{body};
  56 }
  57
  58 sub content_length {
  59     return shift->{content_length};
  60 }
  61
  62 sub content_type {
  63     return shift->{content_type};
  64 }
  65
  66 sub param {
  67     my $self = shift;
  68
  69     if ( @_ == 2 ) {
  70
  71         my ( $name, $value ) = @_;
  72
  73         if ( exists $self->{param}->{$name} ) {
  74             for ( $self->{param}->{$name} ) {
  75                 $_ = [$_] unless ref($_) eq "ARRAY";
  76                 push( @$_, $value );
  77             }
  78         }
  79         else {
  80             $self->{param}->{$name} = $value;
  81         }
  82     }
  83
  84     return $self->{param};
  85 }
  86
  87 sub upload {
  88     my $self = shift;
  89
  90     if ( @_ == 2 ) {
  91
  92         my ( $name, $upload ) = @_;
  93
  94         if ( exists $self->{upload}->{$name} ) {
  95             for ( $self->{upload}->{$name} ) {
  96                 $_ = [$_] unless ref($_) eq "ARRAY";
  97                 push( @$_, $upload );
  98             }
  99         }
 100         else {
 101             $self->{upload}->{$name} = $upload;
 102         }
 103     }
 104
 105     return $self->{upload};
 106 }
 107
 108 1;