10 'application/octet-stream' => 'HTTP::Body::OctetStream',
11 'application/x-www-form-urlencoded' => 'HTTP::Body::UrlEncoded',
12 'multipart/form-data' => 'HTTP::Body::MultiPart',
13 'multipart/related' => 'HTTP::Body::XFormsMultipart',
14 'application/xml' => 'HTTP::Body::XForms'
17 require HTTP::Body::OctetStream;
18 require HTTP::Body::UrlEncoded;
19 require HTTP::Body::MultiPart;
20 require HTTP::Body::XFormsMultipart;
21 require HTTP::Body::XForms;
28 HTTP::Body - HTTP Body Parser
34 sub handler : method {
35 my ( $class, $r ) = @_;
37 my $content_type = $r->headers_in->get('Content-Type');
38 my $content_length = $r->headers_in->get('Content-Length');
40 my $body = HTTP::Body->new( $content_type, $content_length );
41 my $length = $content_length;
45 $r->read( my $buffer, ( $length < 8192 ) ? $length : 8192 );
47 $length -= length($buffer);
52 my $uploads = $body->upload; # hashref
53 my $params = $body->param; # hashref
54 my $body = $body->body; # IO::Handle
59 HTTP::Body parses chunks of HTTP POST data and supports
60 application/octet-stream, application/x-www-form-urlencoded, and
63 Chunked bodies are supported by not passing a length value to new().
65 It is currently used by L<Catalyst> to parse POST bodies.
69 When parsing multipart bodies, temporary files are created to store any
70 uploaded files. You must delete these temporary files yourself after
79 Constructor. Takes content type and content length as parameters,
80 returns a L<HTTP::Body> object.
85 my ( $class, $content_type, $content_length ) = @_;
88 Carp::croak( $class, '->new( $content_type, [ $content_length ] )' );
92 foreach my $supported ( keys %{$TYPES} ) {
93 if ( index( lc($content_type), $supported ) >= 0 ) {
98 my $body = $TYPES->{ $type || 'application/octet-stream' };
100 eval "require $body";
110 chunked => !defined $content_length,
111 content_length => defined $content_length ? $content_length : -1,
112 content_type => $content_type,
115 state => 'buffering',
119 bless( $self, $body );
126 Add string to internal buffer. Will call spin unless done. returns
127 length before adding self.
134 if ( $self->{chunked} ) {
135 $self->{chunk_buffer} .= $_[0];
137 while ( $self->{chunk_buffer} =~ m/^([\da-fA-F]+).*\x0D\x0A/ ) {
138 my $chunk_len = hex($1);
140 if ( $chunk_len == 0 ) {
142 $self->{chunk_buffer} =~ s/^([\da-fA-F]+).*\x0D\x0A//;
144 # End of data, there may be trailing headers
145 if ( my ($headers) = $self->{chunk_buffer} =~ m/(.*)\x0D\x0A/s ) {
146 if ( my $message = HTTP::Message->parse( $headers ) ) {
147 $self->{trailing_headers} = $message->headers;
151 $self->{chunk_buffer} = '';
153 # Set content_length equal to the amount of data we read,
154 # so the spin methods can finish up.
155 $self->{content_length} = $self->{length};
158 # Make sure we have the whole chunk in the buffer (+CRLF)
159 if ( length( $self->{chunk_buffer} ) >= $chunk_len ) {
161 $self->{chunk_buffer} =~ s/^([\da-fA-F]+).*\x0D\x0A//;
163 # Pull chunk data out of chunk buffer into real buffer
164 $self->{buffer} .= substr $self->{chunk_buffer}, 0, $chunk_len, '';
166 # Strip remaining CRLF
167 $self->{chunk_buffer} =~ s/^\x0D\x0A//;
169 $self->{length} += $chunk_len;
172 # Not enough data for this chunk, wait for more calls to add()
177 unless ( $self->{state} eq 'done' ) {
185 my $cl = $self->content_length;
187 if ( defined $_[0] ) {
188 $self->{length} += length( $_[0] );
190 # Don't allow buffer data to exceed content-length
191 if ( $self->{length} > $cl ) {
192 $_[0] = substr $_[0], 0, $cl - $self->{length};
193 $self->{length} = $cl;
196 $self->{buffer} .= $_[0];
199 unless ( $self->state eq 'done' ) {
203 return ( $self->length - $cl );
208 accessor for the body.
214 $self->{body} = shift if @_;
215 return $self->{body};
220 Returns 1 if the request is chunked.
225 return shift->{chunked};
230 Returns the content-length for the body data if known.
231 Returns -1 if the request is chunked.
236 return shift->{content_length};
241 Returns the content-type of the body data.
246 return shift->{content_type};
261 Returns the total length of data we expect to read if known.
262 In the case of a chunked request, returns the amount of data
268 return shift->{length};
271 =item trailing_headers
273 If a chunked request body had trailing headers, trailing_headers will
274 return an HTTP::Headers object populated with those headers.
278 sub trailing_headers {
279 return shift->{trailing_headers};
284 Abstract method to spin the io handle.
289 Carp::croak('Define abstract method spin() in implementation');
294 Returns the current state of the parser.
300 $self->{state} = shift if @_;
301 return $self->{state};
306 Get/set body parameters.
315 my ( $name, $value ) = @_;
317 if ( exists $self->{param}->{$name} ) {
318 for ( $self->{param}->{$name} ) {
319 $_ = [$_] unless ref($_) eq "ARRAY";
324 $self->{param}->{$name} = $value;
328 return $self->{param};
333 Get/set file uploads.
342 my ( $name, $upload ) = @_;
344 if ( exists $self->{upload}->{$name} ) {
345 for ( $self->{upload}->{$name} ) {
346 $_ = [$_] unless ref($_) eq "ARRAY";
347 push( @$_, $upload );
351 $self->{upload}->{$name} = $upload;
355 return $self->{upload};
362 Christian Hansen, C<ch@ngmedia.com>
364 Sebastian Riedel, C<sri@cpan.org>
366 Andy Grundman, C<andy@hybridized.org>
370 This library is free software. You can redistribute it and/or modify
371 it under the same terms as perl itself.