8 'application/octet-stream' => 'HTTP::Body::OctetStream',
9 'application/x-www-form-urlencoded' => 'HTTP::Body::UrlEncoded',
10 'multipart/form-data' => 'HTTP::Body::MultiPart',
11 'multipart/related' => 'HTTP::Body::XFormsMultipart',
12 'application/xml' => 'HTTP::Body::XForms',
13 'application/json' => 'HTTP::Body::OctetStream',
16 require HTTP::Body::OctetStream;
17 require HTTP::Body::UrlEncoded;
18 require HTTP::Body::MultiPart;
19 require HTTP::Body::XFormsMultipart;
20 require HTTP::Body::XForms;
27 HTTP::Body - HTTP Body Parser
33 sub handler : method {
34 my ( $class, $r ) = @_;
36 my $content_type = $r->headers_in->get('Content-Type');
37 my $content_length = $r->headers_in->get('Content-Length');
39 my $body = HTTP::Body->new( $content_type, $content_length );
40 my $length = $content_length;
44 $r->read( my $buffer, ( $length < 8192 ) ? $length : 8192 );
46 $length -= length($buffer);
51 my $uploads = $body->upload; # hashref
52 my $params = $body->param; # hashref
53 my $param_order = $body->param_order # arrayref
54 my $body = $body->body; # IO::Handle
59 HTTP::Body parses chunks of HTTP POST data and supports
60 application/octet-stream, application/json, application/x-www-form-urlencoded,
61 and multipart/form-data.
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
71 processing them, or set $body->cleanup(1) to automatically delete them
80 Constructor. Takes content type and content length as parameters,
81 returns a L<HTTP::Body> object.
86 my ( $class, $content_type, $content_length ) = @_;
89 Carp::croak( $class, '->new( $content_type, [ $content_length ] )' );
94 foreach my $supported ( keys %{$TYPES} ) {
95 my $index = index( lc($content_type), $supported );
96 if ($index >= 0 && (!defined $earliest_index || $index < $earliest_index)) {
98 $earliest_index = $index;
102 my $body = $TYPES->{ $type || 'application/octet-stream' };
109 chunked => !defined $content_length,
110 content_length => defined $content_length ? $content_length : -1,
111 content_type => $content_type,
115 state => 'buffering',
118 tmpdir => File::Spec->tmpdir(),
121 bless( $self, $body );
129 if ( $self->{cleanup} ) {
131 for my $upload ( values %{ $self->{upload} } ) {
132 push @temps, map { $_->{tempname} || () }
133 ( ref $upload eq 'ARRAY' ? @{$upload} : $upload );
136 unlink map { $_ } grep { -e $_ } @temps;
142 Add string to internal buffer. Will call spin unless done. returns
143 length before adding self.
150 if ( $self->{chunked} ) {
151 $self->{chunk_buffer} .= $_[0];
153 while ( $self->{chunk_buffer} =~ m/^([\da-fA-F]+).*\x0D\x0A/ ) {
154 my $chunk_len = hex($1);
156 if ( $chunk_len == 0 ) {
158 $self->{chunk_buffer} =~ s/^([\da-fA-F]+).*\x0D\x0A//;
160 # End of data, there may be trailing headers
161 if ( my ($headers) = $self->{chunk_buffer} =~ m/(.*)\x0D\x0A/s ) {
162 if ( my $message = HTTP::Message->parse( $headers ) ) {
163 $self->{trailing_headers} = $message->headers;
167 $self->{chunk_buffer} = '';
169 # Set content_length equal to the amount of data we read,
170 # so the spin methods can finish up.
171 $self->{content_length} = $self->{length};
174 # Make sure we have the whole chunk in the buffer (+CRLF)
175 if ( length( $self->{chunk_buffer} ) >= $chunk_len ) {
177 $self->{chunk_buffer} =~ s/^([\da-fA-F]+).*\x0D\x0A//;
179 # Pull chunk data out of chunk buffer into real buffer
180 $self->{buffer} .= substr $self->{chunk_buffer}, 0, $chunk_len, '';
182 # Strip remaining CRLF
183 $self->{chunk_buffer} =~ s/^\x0D\x0A//;
185 $self->{length} += $chunk_len;
188 # Not enough data for this chunk, wait for more calls to add()
193 unless ( $self->{state} eq 'done' ) {
201 my $cl = $self->content_length;
203 if ( defined $_[0] ) {
204 $self->{length} += length( $_[0] );
206 # Don't allow buffer data to exceed content-length
207 if ( $self->{length} > $cl ) {
208 $_[0] = substr $_[0], 0, $cl - $self->{length};
209 $self->{length} = $cl;
212 $self->{buffer} .= $_[0];
215 unless ( $self->state eq 'done' ) {
219 return ( $self->length - $cl );
224 accessor for the body.
230 $self->{body} = shift if @_;
231 return $self->{body};
236 Returns 1 if the request is chunked.
241 return shift->{chunked};
246 Set to 1 to enable automatic deletion of temporary files at DESTROY-time.
252 $self->{cleanup} = shift if @_;
253 return $self->{cleanup};
258 Returns the content-length for the body data if known.
259 Returns -1 if the request is chunked.
264 return shift->{content_length};
269 Returns the content-type of the body data.
274 return shift->{content_type};
289 Returns the total length of data we expect to read if known.
290 In the case of a chunked request, returns the amount of data
296 return shift->{length};
299 =item trailing_headers
301 If a chunked request body had trailing headers, trailing_headers will
302 return an HTTP::Headers object populated with those headers.
306 sub trailing_headers {
307 return shift->{trailing_headers};
312 Abstract method to spin the io handle.
317 Carp::croak('Define abstract method spin() in implementation');
322 Returns the current state of the parser.
328 $self->{state} = shift if @_;
329 return $self->{state};
334 Get/set body parameters.
343 my ( $name, $value ) = @_;
345 if ( exists $self->{param}->{$name} ) {
346 for ( $self->{param}->{$name} ) {
347 $_ = [$_] unless ref($_) eq "ARRAY";
352 $self->{param}->{$name} = $value;
355 push @{$self->{param_order}}, $name;
358 return $self->{param};
363 Get/set file uploads.
372 my ( $name, $upload ) = @_;
374 if ( exists $self->{upload}->{$name} ) {
375 for ( $self->{upload}->{$name} ) {
376 $_ = [$_] unless ref($_) eq "ARRAY";
377 push( @$_, $upload );
381 $self->{upload}->{$name} = $upload;
385 return $self->{upload};
390 Just like 'param' but gives you a hash of the full data associated with the
391 part in a multipart type POST/PUT. Example:
397 "Content-Disposition" => "form-data; name=\"arg2\"",
398 "Content-Type" => "text/plain"
411 my ( $name, $data ) = @_;
413 if ( exists $self->{part_data}->{$name} ) {
414 for ( $self->{part_data}->{$name} ) {
415 $_ = [$_] unless ref($_) eq "ARRAY";
420 $self->{part_data}->{$name} = $data;
424 return $self->{part_data};
429 Specify a different path for temporary files. Defaults to the system temporary path.
435 $self->{tmpdir} = shift if @_;
436 return $self->{tmpdir};
441 Returns the array ref of the param keys in the order how they appeared on the body
446 return shift->{param_order};
453 Since its original creation this module has been taken over by the Catalyst
454 development team. If you want to contribute patches, these will be your
455 primary contact points:
459 Join #catalyst-dev on irc.perl.org.
463 http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
467 Christian Hansen, C<chansen@cpan.org>
469 Sebastian Riedel, C<sri@cpan.org>
471 Andy Grundman, C<andy@hybridized.org>
475 Simon Elliott C<cpan@papercreatures.com>
477 Kent Fredric <kentnl@cpan.org>
481 Torsten Raudssus <torsten@raudssus.de>
485 This library is free software. You can redistribute it and/or modify
486 it under the same terms as perl itself.