Bump HTTP::Body to 0.8, search.cpan took 0.7 even though I don't have permission
[catagits/HTTP-Body.git] / lib / HTTP / Body.pm
index f0a75e1..27addcc 100644 (file)
@@ -3,9 +3,8 @@ package HTTP::Body;
 use strict;
 
 use Carp       qw[ ];
-use List::Util qw[ first ];
 
-our $VERSION = '0.01';
+our $VERSION = 0.8;
 
 our $TYPES = {
     'application/octet-stream'          => 'HTTP::Body::OctetStream',
@@ -13,6 +12,10 @@ our $TYPES = {
     'multipart/form-data'               => 'HTTP::Body::MultiPart'
 };
 
+require HTTP::Body::OctetStream;
+require HTTP::Body::UrlEncoded;
+require HTTP::Body::MultiPart;
+
 =head1 NAME
 
 HTTP::Body - HTTP Body Parser
@@ -46,11 +49,20 @@ HTTP::Body - HTTP Body Parser
 
 =head1 DESCRIPTION
 
-HTTP Body Parser.
+HTTP::Body parses chunks of HTTP POST data and supports 
+application/octet-stream, application/x-www-form-urlencoded, and
+multipart/form-data.
+
+It is currently used by L<Catalyst> to parse POST bodies.
 
 =head1 METHODS
 
-=over 4
+=over 4 
+
+=item new 
+
+Constructor. Takes content type and content length as parameters,
+returns a L<HTTP::Body> object.
 
 =cut
 
@@ -61,7 +73,13 @@ sub new {
         Carp::croak( $class, '->new( $content_type, $content_length )' );
     }
 
-    my $type = first { index( lc($content_type), $_ ) >= 0 } keys %{$TYPES};
+    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";
@@ -88,25 +106,39 @@ sub new {
 
 =item add
 
+Add string to internal buffer. Will call spin unless done. returns
+length before adding self.
+
 =cut
 
 sub add {
     my $self = shift;
+    
+    my $cl = $self->content_length;
 
     if ( defined $_[0] ) {
-        $self->{buffer} .= $_[0];
         $self->{length} += length( $_[0] );
+        
+        # Don't allow buffer data to exceed content-length
+        if ( $self->{length} > $cl ) {
+            $_[0] = substr $_[0], 0, $cl - $self->{length};
+            $self->{length} = $cl;
+        }
+        
+        $self->{buffer} .= $_[0];
     }
 
     unless ( $self->state eq 'done' ) {
         $self->spin;
     }
 
-    return ( $self->length - $self->content_length );
+    return ( $self->length - $cl );
 }
 
 =item body
 
+accessor for the body.
+
 =cut
 
 sub body {
@@ -117,6 +149,8 @@ sub body {
 
 =item buffer
 
+read only accessor for the buffer.
+
 =cut
 
 sub buffer {
@@ -125,6 +159,8 @@ sub buffer {
 
 =item content_length
 
+read only accessor for content length
+
 =cut
 
 sub content_length {
@@ -133,6 +169,8 @@ sub content_length {
 
 =item content_type
 
+ready only accessor for the content type
+
 =cut
 
 sub content_type {
@@ -141,6 +179,8 @@ sub content_type {
 
 =item init
 
+return self.
+
 =cut
 
 sub init {
@@ -149,6 +189,8 @@ sub init {
 
 =item length
 
+read only accessor for body length.
+
 =cut
 
 sub length {
@@ -157,6 +199,8 @@ sub length {
 
 =item spin
 
+Abstract method to spin the io handle.
+
 =cut
 
 sub spin {
@@ -165,6 +209,8 @@ sub spin {
 
 =item state
 
+accessor for body state.
+
 =cut
 
 sub state {
@@ -175,6 +221,8 @@ sub state {
 
 =item param
 
+accesor for http parameters.
+
 =cut
 
 sub param {
@@ -225,6 +273,10 @@ sub upload {
 
 =back
 
+=head1 BUGS
+
+Chunked requests are currently not supported.
+
 =head1 AUTHOR
 
 Christian Hansen, C<ch@ngmedia.com>