woremacx's file upload tempdir patch, applied to HTTP::Body

[catagits/HTTP-Body.git] / lib / HTTP / Body.pm

diff --git a/lib/HTTP/Body.pm b/lib/HTTP/Body.pm
index 9af71ee..98306d7 100644 (file)
--- a/lib/HTTP/Body.pm
+++ b/lib/HTTP/Body.pm
@@ -1,228 +1,74 @@
 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[];
 
-use overload ( q/""/ => 'stringify', fallback => 1 );
+__PACKAGE__->mk_accessors( qw[ context parser ] );
 
-our $VERSION = '0.01';
-
-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;
-
-=head1 DESCRIPTION
-
-HTTP Body Parser.
-
-=head1 METHODS
-
-=over 4
-
-=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 = first { index( lc($content_type), $_ ) >= 0 } keys %{$TYPES};
-    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           => '',
-        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
-
-=cut
+sub initialize {
+    my ( $self, $params ) = @_;
+    
+    my $bufsize = delete $params->{bufsize} || 65536;
 
-sub add {
-    my $self = shift;
-
-    if ( defined $_[0] ) {
-        $self->{buffer} .= $_[0];
-        $self->{body}   .= $_[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
-
-=cut
-
-sub body {
-    my $self = shift;
-    $self->{body} = shift if @_;
-    return $self->{body};
-}
-
-=item buffer
-
-=cut
-
-sub buffer {
-    return shift->{buffer};
-}
-
-=item content_length
-
-=cut
-
-sub content_length {
-    return shift->{content_length};
+sub eos {
+    return shift->parser->eos;
 }
 
-=item content_type
-
-=cut
-
-sub content_type {
-    return shift->{content_type};
-}
-
-=item init
-
-=cut
-
-sub init {
-    return $_[0];
-}
-
-=item length
-
-=cut
-
-sub length {
-    return shift->{length};
+sub put {
+    return shift->parser->put(@_);
 }
 
-=item spin
-
-=cut
-
-sub spin {
-    Carp::croak('Define abstract method spin() in implementation');
-}
-
-=item state
-
-=cut
-
-sub state {
-    my $self = shift;
-    $self->{state} = shift if @_;
-    return $self->{state};
-}
-
-=item stringify
-
-=cut
-
-sub stringify {
-    return shift->{body};
-}
-
-=item param
-
-=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 AUTHOR
-
-Christian Hansen, C<ch@ngmedia.com>
-Messed up by Sebastian Riedel
-
-=head1 LICENSE
-
-This library is free software . You can redistribute it and/or modify 
-it under the same terms as perl itself.
-
-=cut
-
 1;