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 $VERSION = '0.01';
   9
  10 our $TYPES = {
  11     'application/octet-stream'          => 'HTTP::Body::OctetStream',
  12     'application/x-www-form-urlencoded' => 'HTTP::Body::UrlEncoded',
  13     'multipart/form-data'               => 'HTTP::Body::MultiPart'
  14 };
  15
  16 =head1 NAME
  17
  18 HTTP::Body - HTTP Body Parser
  19
  20 =head1 SYNOPSIS
  21
  22     use HTTP::Body;
  23
  24 =head1 DESCRIPTION
  25
  26 HTTP Body Parser.
  27
  28 =head1 METHODS
  29
  30 =over 4
  31
  32 =cut
  33
  34 sub new {
  35     my ( $class, $content_type, $content_length ) = @_;
  36
  37     unless ( @_ == 3 ) {
  38         Carp::croak( $class, '->new( $content_type, $content_length )' );
  39     }
  40
  41     my $type = first { index( lc($content_type), $_ ) >= 0 } keys %{$TYPES};
  42     my $body = $TYPES->{ $type || 'application/octet-stream' };
  43
  44     eval "require $body";
  45
  46     if ($@) {
  47         die $@;
  48     }
  49
  50     my $self = {
  51         buffer         => '',
  52         body           => '',
  53         content_length => $content_length,
  54         content_type   => $content_type,
  55         length         => 0,
  56         param          => {},
  57         state          => 'buffering',
  58         upload         => {}
  59     };
  60
  61     bless( $self, $body );
  62
  63     return $self->init;
  64 }
  65
  66 =item add
  67
  68 =cut
  69
  70 sub add {
  71     my $self = shift;
  72
  73     if ( defined $_[0] ) {
  74         $self->{buffer} .= $_[0];
  75         $self->{length} += length( $_[0] );
  76     }
  77
  78     unless ( $self->state eq 'done' ) {
  79         $self->spin;
  80     }
  81
  82     return ( $self->length - $self->content_length );
  83 }
  84
  85 =item body
  86
  87 =cut
  88
  89 sub body {
  90     my $self = shift;
  91     $self->{body} = shift if @_;
  92     return $self->{body};
  93 }
  94
  95 =item buffer
  96
  97 =cut
  98
  99 sub buffer {
 100     return shift->{buffer};
 101 }
 102
 103 =item content_length
 104
 105 =cut
 106
 107 sub content_length {
 108     return shift->{content_length};
 109 }
 110
 111 =item content_type
 112
 113 =cut
 114
 115 sub content_type {
 116     return shift->{content_type};
 117 }
 118
 119 =item init
 120
 121 =cut
 122
 123 sub init {
 124     return $_[0];
 125 }
 126
 127 =item length
 128
 129 =cut
 130
 131 sub length {
 132     return shift->{length};
 133 }
 134
 135 =item spin
 136
 137 =cut
 138
 139 sub spin {
 140     Carp::croak('Define abstract method spin() in implementation');
 141 }
 142
 143 =item state
 144
 145 =cut
 146
 147 sub state {
 148     my $self = shift;
 149     $self->{state} = shift if @_;
 150     return $self->{state};
 151 }
 152
 153 =item param
 154
 155 =cut
 156
 157 sub param {
 158     my $self = shift;
 159
 160     if ( @_ == 2 ) {
 161
 162         my ( $name, $value ) = @_;
 163
 164         if ( exists $self->{param}->{$name} ) {
 165             for ( $self->{param}->{$name} ) {
 166                 $_ = [$_] unless ref($_) eq "ARRAY";
 167                 push( @$_, $value );
 168             }
 169         }
 170         else {
 171             $self->{param}->{$name} = $value;
 172         }
 173     }
 174
 175     return $self->{param};
 176 }
 177
 178 =item upload
 179
 180 =cut
 181
 182 sub upload {
 183     my $self = shift;
 184
 185     if ( @_ == 2 ) {
 186
 187         my ( $name, $upload ) = @_;
 188
 189         if ( exists $self->{upload}->{$name} ) {
 190             for ( $self->{upload}->{$name} ) {
 191                 $_ = [$_] unless ref($_) eq "ARRAY";
 192                 push( @$_, $upload );
 193             }
 194         }
 195         else {
 196             $self->{upload}->{$name} = $upload;
 197         }
 198     }
 199
 200     return $self->{upload};
 201 }
 202
 203 =back
 204
 205 =head1 AUTHOR
 206
 207 Christian Hansen, C<ch@ngmedia.com>
 208 Messed up by Sebastian Riedel
 209
 210 =head1 LICENSE
 211
 212 This library is free software . You can redistribute it and/or modify
 213 it under the same terms as perl itself.
 214
 215 =cut
 216
 217 1;