package HTTP::Body;
use strict;
+use warnings;
+use base 'Class::Accessor::Fast';
-use Carp qw[ ];
+use Params::Validate qw[];
+use HTTP::Body::Context qw[];
+use HTTP::Body::Parser qw[];
-our $VERSION = '0.201';
+__PACKAGE__->mk_accessors( qw[ context parser ] );
-our $TYPES = {
- 'application/octet-stream' => 'HTTP::Body::OctetStream',
- 'application/x-www-form-urlencoded' => 'HTTP::Body::UrlEncoded',
- 'multipart/form-data' => 'HTTP::Body::MultiPart'
-};
-
-=head1 NAME
-
-HTTP::Body - HTTP Body Parser
-
-=head1 SYNOPSIS
-
- use HTTP::Body;
-
- sub handler : method {
- my ( $class, $r ) = @_;
-
- my $content_type = $r->headers_in->get('Content-Type');
- my $content_length = $r->headers_in->get('Content-Length');
-
- my $body = HTTP::Body->new( $content_type, $content_length );
- my $length = $content_length;
-
- while ( $length ) {
-
- $r->read( my $buffer, ( $length < 8192 ) ? $length : 8192 );
-
- $length -= length($buffer);
-
- $body->add($buffer);
- }
-
- my $uploads = $body->upload; # hashref
- my $params = $body->param; # hashref
- my $body = $body->body; # IO::Handle
- }
-
-=head1 DESCRIPTION
-
-HTTP Body Parser.
-
-=head1 METHODS
-
-=over 4
-
-=item new
-
-Constructor. Takes content type and content length as parameters,
-returns a L<HTTP::Body> object.
-
-=cut
+our $VERSION = 0.7;
sub new {
- my ( $class, $content_type, $content_length ) = @_;
-
- unless ( @_ == 3 ) {
- Carp::croak( $class, '->new( $content_type, $content_length )' );
- }
-
- my $type;
- foreach my $supported ( keys %{$TYPES} ) {
- if ( index( lc($content_type), $supported ) >= 0 ) {
- $type = $supported;
- }
- }
-
- my $body = $TYPES->{ $type || 'application/octet-stream' };
-
- eval "require $body";
-
- if ($@) {
- die $@;
+ my $class = ref $_[0] ? ref shift : shift;
+
+ # bring in compat for old API <= 0.6
+ if ( @_ == 2 ) {
+ require HTTP::Body::Compat;
+ return HTTP::Body::Compat->new(@_);
}
- my $self = {
- buffer => '',
- body => undef,
- content_length => $content_length,
- content_type => $content_type,
- length => 0,
- param => {},
- state => 'buffering',
- upload => {}
- };
-
- bless( $self, $body );
+ 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"
+ );
- return $self->init;
+ return bless( {}, $class )->initialize($params);
}
-=item add
-
-Add string to internal buffer. Will call spin unless done. returns
-length before adding self.
-
-=cut
-
-sub add {
- my $self = shift;
+sub initialize {
+ my ( $self, $params ) = @_;
+
+ my $bufsize = delete $params->{bufsize} || 65536;
- if ( defined $_[0] ) {
- $self->{buffer} .= $_[0];
- $self->{length} += length( $_[0] );
- }
+ $params->{parser} ||= HTTP::Body::Parser->new(
+ bufsize => $bufsize,
+ context => $params->{context}
+ );
- unless ( $self->state eq 'done' ) {
- $self->spin;
+ while ( my ( $param, $value ) = each( %{ $params } ) ) {
+ $self->$param($value);
}
- return ( $self->length - $self->content_length );
+ return $self;
}
-=item body
-
-accessor for the body.
-
-=cut
-
-sub body {
- my $self = shift;
- $self->{body} = shift if @_;
- return $self->{body};
+sub eos {
+ return shift->parser->eos;
}
-=item buffer
-
-read only accessor for the buffer.
-
-=cut
-
-sub buffer {
- return shift->{buffer};
+sub put {
+ return shift->parser->put(@_);
}
-=item content_length
-
-read only accessor for content length
-
-=cut
-
-sub content_length {
- return shift->{content_length};
-}
-
-=item content_type
-
-ready only accessor for the content type
-
-=cut
-
-sub content_type {
- return shift->{content_type};
-}
-
-=item init
-
-return self.
-
-=cut
-
-sub init {
- return $_[0];
-}
-
-=item length
-
-read only accessor for body length.
-
-=cut
-
-sub length {
- return shift->{length};
-}
-
-=item spin
-
-Abstract method to spin the io handle.
-
-=cut
-
-sub spin {
- Carp::croak('Define abstract method spin() in implementation');
-}
-
-=item state
-
-accessor for body state.
-
-=cut
-
-sub state {
- my $self = shift;
- $self->{state} = shift if @_;
- return $self->{state};
-}
-
-=item param
-
-accesor for http parameters.
-
-=cut
-
-sub param {
- my $self = shift;
-
- if ( @_ == 2 ) {
-
- my ( $name, $value ) = @_;
-
- if ( exists $self->{param}->{$name} ) {
- for ( $self->{param}->{$name} ) {
- $_ = [$_] unless ref($_) eq "ARRAY";
- push( @$_, $value );
- }
- }
- else {
- $self->{param}->{$name} = $value;
- }
- }
-
- return $self->{param};
-}
-
-=item upload
-
-=cut
-
-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;
- }
- }
-
- return $self->{upload};
-}
-
-=back
-
-=head1 BUGS
-
-Chunked requests are currently not supported.
-
-=head1 AUTHOR
-
-Christian Hansen, C<ch@ngmedia.com>
-
-Sebastian Riedel, C<sri@cpan.org>
-
-=head1 LICENSE
-
-This library is free software. You can redistribute it and/or modify
-it under the same terms as perl itself.
-
-=cut
-
1;
projects / catagits/HTTP-Body.git / blobdiff