lib/HTTP/Body.pm

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