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
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 ] )' );
93 foreach my $supported ( keys %{$TYPES} ) {
94 if ( index( lc($content_type), $supported ) >= 0 ) {
99 my $body = $TYPES->{ $type || 'application/octet-stream' };
106 chunked => !defined $content_length,
107 content_length => defined $content_length ? $content_length : -1,
108 content_type => $content_type,
111 state => 'buffering',
113 tmpdir => File::Spec->tmpdir(),
116 bless( $self, $body );
124 if ( $self->{cleanup} ) {
126 for my $upload ( values %{ $self->{upload} } ) {
127 push @temps, map { $_->{tempname} || () }
128 ( ref $upload eq 'ARRAY' ? @{$upload} : $upload );
131 unlink map { $_ } grep { -e $_ } @temps;
137 Add string to internal buffer. Will call spin unless done. returns
138 length before adding self.
145 if ( $self->{chunked} ) {
146 $self->{chunk_buffer} .= $_[0];
148 while ( $self->{chunk_buffer} =~ m/^([\da-fA-F]+).*\x0D\x0A/ ) {
149 my $chunk_len = hex($1);
151 if ( $chunk_len == 0 ) {
153 $self->{chunk_buffer} =~ s/^([\da-fA-F]+).*\x0D\x0A//;
155 # End of data, there may be trailing headers
156 if ( my ($headers) = $self->{chunk_buffer} =~ m/(.*)\x0D\x0A/s ) {
157 if ( my $message = HTTP::Message->parse( $headers ) ) {
158 $self->{trailing_headers} = $message->headers;
162 $self->{chunk_buffer} = '';
164 # Set content_length equal to the amount of data we read,
165 # so the spin methods can finish up.
166 $self->{content_length} = $self->{length};
169 # Make sure we have the whole chunk in the buffer (+CRLF)
170 if ( length( $self->{chunk_buffer} ) >= $chunk_len ) {
172 $self->{chunk_buffer} =~ s/^([\da-fA-F]+).*\x0D\x0A//;
174 # Pull chunk data out of chunk buffer into real buffer
175 $self->{buffer} .= substr $self->{chunk_buffer}, 0, $chunk_len, '';
177 # Strip remaining CRLF
178 $self->{chunk_buffer} =~ s/^\x0D\x0A//;
180 $self->{length} += $chunk_len;
183 # Not enough data for this chunk, wait for more calls to add()
188 unless ( $self->{state} eq 'done' ) {
196 my $cl = $self->content_length;
198 if ( defined $_[0] ) {
199 $self->{length} += length( $_[0] );
201 # Don't allow buffer data to exceed content-length
202 if ( $self->{length} > $cl ) {
203 $_[0] = substr $_[0], 0, $cl - $self->{length};
204 $self->{length} = $cl;
207 $self->{buffer} .= $_[0];
210 unless ( $self->state eq 'done' ) {
214 return ( $self->length - $cl );
219 accessor for the body.
225 $self->{body} = shift if @_;
226 return $self->{body};
231 Returns 1 if the request is chunked.
236 return shift->{chunked};
241 Set to 1 to enable automatic deletion of temporary files at DESTROY-time.
247 $self->{cleanup} = shift if @_;
248 return $self->{cleanup};
253 Returns the content-length for the body data if known.
254 Returns -1 if the request is chunked.
259 return shift->{content_length};
264 Returns the content-type of the body data.
269 return shift->{content_type};
284 Returns the total length of data we expect to read if known.
285 In the case of a chunked request, returns the amount of data
291 return shift->{length};
294 =item trailing_headers
296 If a chunked request body had trailing headers, trailing_headers will
297 return an HTTP::Headers object populated with those headers.
301 sub trailing_headers {
302 return shift->{trailing_headers};
307 Abstract method to spin the io handle.
312 Carp::croak('Define abstract method spin() in implementation');
317 Returns the current state of the parser.
323 $self->{state} = shift if @_;
324 return $self->{state};
329 Get/set body parameters.
338 my ( $name, $value ) = @_;
340 if ( exists $self->{param}->{$name} ) {
341 for ( $self->{param}->{$name} ) {
342 $_ = [$_] unless ref($_) eq "ARRAY";
347 $self->{param}->{$name} = $value;
351 return $self->{param};
356 Get/set file uploads.
365 my ( $name, $upload ) = @_;
367 if ( exists $self->{upload}->{$name} ) {
368 for ( $self->{upload}->{$name} ) {
369 $_ = [$_] unless ref($_) eq "ARRAY";
370 push( @$_, $upload );
374 $self->{upload}->{$name} = $upload;
378 return $self->{upload};
383 Specify a different path for temporary files. Defaults to the system temporary path.
389 $self->{tmpdir} = shift if @_;
390 return $self->{tmpdir};
397 Christian Hansen, C<ch@ngmedia.com>
399 Sebastian Riedel, C<sri@cpan.org>
401 Andy Grundman, C<andy@hybridized.org>
405 This library is free software. You can redistribute it and/or modify
406 it under the same terms as perl itself.