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