X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FHTTP%2FBody.pm;h=2ee5ab06b21c41cfa24e5ed724aaf4110b0fed83;hb=5940e4c70958ddb4e6498bce92f577a80f54352e;hp=c6ab81559caed77ba09eda308578aeaddb7ff7ab;hpb=304dca13376a044cb4e24fc98a8fa28edd475a3c;p=catagits%2FHTTP-Body.git

diff --git a/lib/HTTP/Body.pm b/lib/HTTP/Body.pm
index c6ab815..2ee5ab0 100644
--- a/lib/HTTP/Body.pm
+++ b/lib/HTTP/Body.pm
@@ -4,17 +4,24 @@ use strict;
 
 use Carp       qw[ ];
 
-our $VERSION = 0.7;
+our $VERSION = 1.00;
 
 our $TYPES = {
     'application/octet-stream'          => 'HTTP::Body::OctetStream',
     'application/x-www-form-urlencoded' => 'HTTP::Body::UrlEncoded',
-    'multipart/form-data'               => 'HTTP::Body::MultiPart'
+    'multipart/form-data'               => 'HTTP::Body::MultiPart',
+    'multipart/related'                 => 'HTTP::Body::XFormsMultipart',
+    'application/xml'                   => 'HTTP::Body::XForms'
 };
 
 require HTTP::Body::OctetStream;
 require HTTP::Body::UrlEncoded;
 require HTTP::Body::MultiPart;
+require HTTP::Body::XFormsMultipart;
+require HTTP::Body::XForms;
+
+use HTTP::Headers;
+use HTTP::Message;
 
 =head1 NAME
 
@@ -49,7 +56,19 @@ 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.
+
+Chunked bodies are supported by not passing a length value to new().
+
+It is currently used by L<Catalyst> to parse POST bodies.
+
+=head1 NOTES
+
+When parsing multipart bodies, temporary files are created to store any
+uploaded files.  You must delete these temporary files yourself after
+processing them.
 
 =head1 METHODS
 
@@ -65,8 +84,8 @@ returns a L<HTTP::Body> object.
 sub new {
     my ( $class, $content_type, $content_length ) = @_;
 
-    unless ( @_ == 3 ) {
-        Carp::croak( $class, '->new( $content_type, $content_length )' );
+    unless ( @_ >= 2 ) {
+        Carp::croak( $class, '->new( $content_type, [ $content_length ] )' );
     }
 
     my $type;
@@ -86,8 +105,10 @@ sub new {
 
     my $self = {
         buffer         => '',
+        chunk_buffer   => '',
         body           => undef,
-        content_length => $content_length,
+        chunked        => !defined $content_length,
+        content_length => defined $content_length ? $content_length : -1,
         content_type   => $content_type,
         length         => 0,
         param          => {},
@@ -110,6 +131,57 @@ length before adding self.
 sub add {
     my $self = shift;
     
+    if ( $self->{chunked} ) {
+        $self->{chunk_buffer} .= $_[0];
+        
+        while ( $self->{chunk_buffer} =~ m/^([\da-fA-F]+).*\x0D\x0A/ ) {
+            my $chunk_len = hex($1);
+            
+            if ( $chunk_len == 0 ) {
+                # Strip chunk len
+                $self->{chunk_buffer} =~ s/^([\da-fA-F]+).*\x0D\x0A//;
+                
+                # End of data, there may be trailing headers
+                if (  my ($headers) = $self->{chunk_buffer} =~ m/(.*)\x0D\x0A/s ) {
+                    if ( my $message = HTTP::Message->parse( $headers ) ) {
+                        $self->{trailing_headers} = $message->headers;
+                    }
+                }
+                
+                $self->{chunk_buffer} = '';
+                
+                # Set content_length equal to the amount of data we read,
+                # so the spin methods can finish up.
+                $self->{content_length} = $self->{length};
+            }
+            else {
+                # Make sure we have the whole chunk in the buffer (+CRLF)
+                if ( length( $self->{chunk_buffer} ) >= $chunk_len ) {
+                    # Strip chunk len
+                    $self->{chunk_buffer} =~ s/^([\da-fA-F]+).*\x0D\x0A//;
+                    
+                    # Pull chunk data out of chunk buffer into real buffer
+                    $self->{buffer} .= substr $self->{chunk_buffer}, 0, $chunk_len, '';
+                
+                    # Strip remaining CRLF
+                    $self->{chunk_buffer} =~ s/^\x0D\x0A//;
+                
+                    $self->{length} += $chunk_len;
+                }
+                else {
+                    # Not enough data for this chunk, wait for more calls to add()
+                    return;
+                }
+            }
+            
+            unless ( $self->{state} eq 'done' ) {
+                $self->spin;
+            }
+        }
+        
+        return;
+    }
+    
     my $cl = $self->content_length;
 
     if ( defined $_[0] ) {
@@ -143,19 +215,20 @@ sub body {
     return $self->{body};
 }
 
-=item buffer
+=item chunked
 
-read only accessor for the buffer.
+Returns 1 if the request is chunked.
 
 =cut
 
-sub buffer {
-    return shift->{buffer};
+sub chunked {
+    return shift->{chunked};
 }
 
 =item content_length
 
-read only accessor for content length
+Returns the content-length for the body data if known.
+Returns -1 if the request is chunked.
 
 =cut
 
@@ -165,7 +238,7 @@ sub content_length {
 
 =item content_type
 
-ready only accessor for the content type
+Returns the content-type of the body data.
 
 =cut
 
@@ -185,7 +258,9 @@ sub init {
 
 =item length
 
-read only accessor for body length.
+Returns the total length of data we expect to read if known.
+In the case of a chunked request, returns the amount of data
+read so far.
 
 =cut
 
@@ -193,6 +268,17 @@ sub length {
     return shift->{length};
 }
 
+=item trailing_headers
+
+If a chunked request body had trailing headers, trailing_headers will
+return an HTTP::Headers object populated with those headers.
+
+=cut
+
+sub trailing_headers {
+    return shift->{trailing_headers};
+}
+
 =item spin
 
 Abstract method to spin the io handle.
@@ -205,7 +291,7 @@ sub spin {
 
 =item state
 
-accessor for body state.
+Returns the current state of the parser.
 
 =cut
 
@@ -217,7 +303,7 @@ sub state {
 
 =item param
 
-accesor for http parameters.
+Get/set body parameters.
 
 =cut
 
@@ -244,6 +330,8 @@ sub param {
 
 =item upload
 
+Get/set file uploads.
+
 =cut
 
 sub upload {
@@ -269,16 +357,14 @@ sub upload {
 
 =back
 
-=head1 BUGS
-
-Chunked requests are currently not supported.
-
 =head1 AUTHOR
 
 Christian Hansen, C<ch@ngmedia.com>
 
 Sebastian Riedel, C<sri@cpan.org>
 
+Andy Grundman, C<andy@hybridized.org>
+
 =head1 LICENSE
 
 This library is free software. You can redistribute it and/or modify