package HTTP::Body;
use strict;
+use warnings;
+use base 'Class::Accessor::Fast';
-use Carp qw[ ];
-use List::Util qw[ first ];
+use Params::Validate qw[];
+use HTTP::Body::Context qw[];
+use HTTP::Body::Parser qw[];
-our $TYPES = {
- 'application/octet-stream' => 'HTTP::Body::Octetstream',
- 'application/x-www-form-urlencoded' => 'HTTP::Body::Urlencoded',
- 'multipart/form-data' => 'HTTP::Body::Multipart'
-};
+__PACKAGE__->mk_accessors( qw[ context parser ] );
-sub new {
- my ( $class, $content_type, $content_length ) = @_;
-
- unless ( @_ == 3 ) {
- Carp::croak( $class, '->new( $content_type, $content_length )' );
- }
-
- my $type = first { index( lc($content_type), $_ ) >= 0 } keys %{$TYPES};
- my $body = $TYPES->{ $type || 'application/octet-stream' };
-
- eval "require $body";
-
- if ($@) {
- die $@;
- }
-
- my $self = {
- buffer => '',
- content_length => $content_length,
- content_type => $content_type,
- length => 0,
- param => {},
- state => 'buffering',
- upload => {}
- };
-
- bless( $self, $body );
-
- return $self->init;
-}
+our $VERSION = 0.7;
-sub add {
- my $self = shift;
-
- if ( defined $_[0] ) {
- $self->{buffer} .= $_[0];
- $self->{length} += length( $_[0] );
- }
+sub new {
+ my $class = ref $_[0] ? ref shift : shift;
- unless ( $self->state eq 'done' ) {
- $self->spin;
+ # bring in compat for old API <= 0.6
+ if ( @_ == 2 ) {
+ require HTTP::Body::Compat;
+ return HTTP::Body::Compat->new(@_);
}
- return ( $self->length - $self->content_length );
-}
-
-sub body {
- my $self = shift;
- $self->{body} = shift if @_;
- return $self->{body};
-}
-
-sub buffer {
- return shift->{buffer};
-}
-
-sub content_length {
- return shift->{content_length};
-}
-
-sub content_type {
- return shift->{content_type};
-}
-
-sub init {
- return $_[0];
-}
-
-sub length {
- return shift->{length};
-}
-
-sub spin {
- Carp::croak('Define abstract method spin() in implementation');
-}
+ my $params = Params::Validate::validate_with(
+ params => \@_,
+ spec => {
+ bufsize => {
+ type => Params::Validate::SCALAR,
+ default => 65536,
+ optional => 1
+ },
+ context => {
+ type => Params::Validate::OBJECT,
+ isa => 'HTTP::Body::Context',
+ optional => 0
+ },
+ parser => {
+ type => Params::Validate::OBJECT,
+ isa => 'HTTP::Body::Parser',
+ optional => 1
+ }
+ },
+ called => "$class\::new"
+ );
-sub state {
- my $self = shift;
- $self->{state} = shift if @_;
- return $self->{state};
+ return bless( {}, $class )->initialize($params);
}
-sub param {
- my $self = shift;
-
- if ( @_ == 2 ) {
+sub initialize {
+ my ( $self, $params ) = @_;
+
+ my $bufsize = delete $params->{bufsize} || 65536;
- my ( $name, $value ) = @_;
+ $params->{parser} ||= HTTP::Body::Parser->new(
+ bufsize => $bufsize,
+ context => $params->{context}
+ );
- if ( exists $self->{param}->{$name} ) {
- for ( $self->{param}->{$name} ) {
- $_ = [$_] unless ref($_) eq "ARRAY";
- push( @$_, $value );
- }
- }
- else {
- $self->{param}->{$name} = $value;
- }
+ while ( my ( $param, $value ) = each( %{ $params } ) ) {
+ $self->$param($value);
}
- return $self->{param};
+ return $self;
}
-sub upload {
- my $self = shift;
-
- if ( @_ == 2 ) {
-
- my ( $name, $upload ) = @_;
-
- if ( exists $self->{upload}->{$name} ) {
- for ( $self->{upload}->{$name} ) {
- $_ = [$_] unless ref($_) eq "ARRAY";
- push( @$_, $upload );
- }
- }
- else {
- $self->{upload}->{$name} = $upload;
- }
- }
+sub eos {
+ return shift->parser->eos;
+}
- return $self->{upload};
+sub put {
+ return shift->parser->put(@_);
}
1;