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',
117 tmpdir => File::Spec->tmpdir(),
120 bless( $self, $body );
128 if ( $self->{cleanup} ) {
130 for my $upload ( values %{ $self->{upload} } ) {
131 push @temps, map { $_->{tempname} || () }
132 ( ref $upload eq 'ARRAY' ? @{$upload} : $upload );
135 unlink map { $_ } grep { -e $_ } @temps;
141 Add string to internal buffer. Will call spin unless done. returns
142 length before adding self.
149 if ( $self->{chunked} ) {
150 $self->{chunk_buffer} .= $_[0];
152 while ( $self->{chunk_buffer} =~ m/^([\da-fA-F]+).*\x0D\x0A/ ) {
153 my $chunk_len = hex($1);
155 if ( $chunk_len == 0 ) {
157 $self->{chunk_buffer} =~ s/^([\da-fA-F]+).*\x0D\x0A//;
159 # End of data, there may be trailing headers
160 if ( my ($headers) = $self->{chunk_buffer} =~ m/(.*)\x0D\x0A/s ) {
161 if ( my $message = HTTP::Message->parse( $headers ) ) {
162 $self->{trailing_headers} = $message->headers;
166 $self->{chunk_buffer} = '';
168 # Set content_length equal to the amount of data we read,
169 # so the spin methods can finish up.
170 $self->{content_length} = $self->{length};
173 # Make sure we have the whole chunk in the buffer (+CRLF)
174 if ( length( $self->{chunk_buffer} ) >= $chunk_len ) {
176 $self->{chunk_buffer} =~ s/^([\da-fA-F]+).*\x0D\x0A//;
178 # Pull chunk data out of chunk buffer into real buffer
179 $self->{buffer} .= substr $self->{chunk_buffer}, 0, $chunk_len, '';
181 # Strip remaining CRLF
182 $self->{chunk_buffer} =~ s/^\x0D\x0A//;
184 $self->{length} += $chunk_len;
187 # Not enough data for this chunk, wait for more calls to add()
192 unless ( $self->{state} eq 'done' ) {
200 my $cl = $self->content_length;
202 if ( defined $_[0] ) {
203 $self->{length} += length( $_[0] );
205 # Don't allow buffer data to exceed content-length
206 if ( $self->{length} > $cl ) {
207 $_[0] = substr $_[0], 0, $cl - $self->{length};
208 $self->{length} = $cl;
211 $self->{buffer} .= $_[0];
214 unless ( $self->state eq 'done' ) {
218 return ( $self->length - $cl );
223 accessor for the body.
229 $self->{body} = shift if @_;
230 return $self->{body};
235 Returns 1 if the request is chunked.
240 return shift->{chunked};
245 Set to 1 to enable automatic deletion of temporary files at DESTROY-time.
251 $self->{cleanup} = shift if @_;
252 return $self->{cleanup};
257 Returns the content-length for the body data if known.
258 Returns -1 if the request is chunked.
263 return shift->{content_length};
268 Returns the content-type of the body data.
273 return shift->{content_type};
288 Returns the total length of data we expect to read if known.
289 In the case of a chunked request, returns the amount of data
295 return shift->{length};
298 =item trailing_headers
300 If a chunked request body had trailing headers, trailing_headers will
301 return an HTTP::Headers object populated with those headers.
305 sub trailing_headers {
306 return shift->{trailing_headers};
311 Abstract method to spin the io handle.
316 Carp::croak('Define abstract method spin() in implementation');
321 Returns the current state of the parser.
327 $self->{state} = shift if @_;
328 return $self->{state};
333 Get/set body parameters.
342 my ( $name, $value ) = @_;
344 if ( exists $self->{param}->{$name} ) {
345 for ( $self->{param}->{$name} ) {
346 $_ = [$_] unless ref($_) eq "ARRAY";
351 $self->{param}->{$name} = $value;
354 push @{$self->{param_order}}, $name;
357 return $self->{param};
362 Get/set file uploads.
371 my ( $name, $upload ) = @_;
373 if ( exists $self->{upload}->{$name} ) {
374 for ( $self->{upload}->{$name} ) {
375 $_ = [$_] unless ref($_) eq "ARRAY";
376 push( @$_, $upload );
380 $self->{upload}->{$name} = $upload;
384 return $self->{upload};
389 Specify a different path for temporary files. Defaults to the system temporary path.
395 $self->{tmpdir} = shift if @_;
396 return $self->{tmpdir};
401 Returns the array ref of the param keys in the order how they appeared on the body
406 return shift->{param_order};
413 Since its original creation this module has been taken over by the Catalyst
414 development team. If you want to contribute patches, these will be your
415 primary contact points:
419 Join #catalyst-dev on irc.perl.org.
423 http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
427 Christian Hansen, C<chansen@cpan.org>
429 Sebastian Riedel, C<sri@cpan.org>
431 Andy Grundman, C<andy@hybridized.org>
435 Simon Elliott C<cpan@papercreatures.com>
437 Kent Fredric <kentnl@cpan.org>
441 Torsten Raudssus <torsten@raudssus.de>
445 This library is free software. You can redistribute it and/or modify
446 it under the same terms as perl itself.