use Carp qw[ ];
-our $VERSION = '1.05';
-
our $TYPES = {
'application/octet-stream' => 'HTTP::Body::OctetStream',
'application/x-www-form-urlencoded' => 'HTTP::Body::UrlEncoded',
'multipart/form-data' => 'HTTP::Body::MultiPart',
'multipart/related' => 'HTTP::Body::XFormsMultipart',
- 'application/xml' => 'HTTP::Body::XForms'
+ 'application/xml' => 'HTTP::Body::XForms',
+ 'application/json' => 'HTTP::Body::OctetStream',
};
require HTTP::Body::OctetStream;
$body->add($buffer);
}
- my $uploads = $body->upload; # hashref
- my $params = $body->param; # hashref
- my $body = $body->body; # IO::Handle
+ my $uploads = $body->upload; # hashref
+ my $params = $body->param; # hashref
+ my $param_order = $body->param_order # arrayref
+ my $body = $body->body; # IO::Handle
}
=head1 DESCRIPTION
-HTTP::Body parses chunks of HTTP POST data and supports
-application/octet-stream, application/x-www-form-urlencoded, and
-multipart/form-data.
+HTTP::Body parses chunks of HTTP POST data and supports
+application/octet-stream, application/json, application/x-www-form-urlencoded,
+and multipart/form-data.
Chunked bodies are supported by not passing a length value to new().
When parsing multipart bodies, temporary files are created to store any
uploaded files. You must delete these temporary files yourself after
-processing them.
+processing them, or set $body->cleanup(1) to automatically delete them
+at DESTROY-time.
=head1 METHODS
}
my $type;
+ my $earliest_index;
foreach my $supported ( keys %{$TYPES} ) {
- if ( index( lc($content_type), $supported ) >= 0 ) {
- $type = $supported;
+ my $index = index( lc($content_type), $supported );
+ if ($index >= 0 && (!defined $earliest_index || $index < $earliest_index)) {
+ $type = $supported;
+ $earliest_index = $index;
}
}
my $body = $TYPES->{ $type || 'application/octet-stream' };
my $self = {
+ cleanup => 0,
buffer => '',
chunk_buffer => '',
body => undef,
content_type => $content_type,
length => 0,
param => {},
+ param_order => [],
state => 'buffering',
upload => {},
tmpdir => File::Spec->tmpdir(),
return $self->init;
}
+sub DESTROY {
+ my $self = shift;
+
+ if ( $self->{cleanup} ) {
+ my @temps = ();
+ for my $upload ( values %{ $self->{upload} } ) {
+ push @temps, map { $_->{tempname} || () }
+ ( ref $upload eq 'ARRAY' ? @{$upload} : $upload );
+ }
+
+ unlink map { $_ } grep { -e $_ } @temps;
+ }
+}
+
=item add
Add string to internal buffer. Will call spin unless done. returns
return shift->{chunked};
}
+=item cleanup
+
+Set to 1 to enable automatic deletion of temporary files at DESTROY-time.
+
+=cut
+
+sub cleanup {
+ my $self = shift;
+ $self->{cleanup} = shift if @_;
+ return $self->{cleanup};
+}
+
=item content_length
Returns the content-length for the body data if known.
else {
$self->{param}->{$name} = $value;
}
+
+ push @{$self->{param_order}}, $name;
}
return $self->{param};
return $self->{tmpdir};
}
+=item param_order
+
+Returns the array ref of the param keys in the order how they appeared on the body
+
+=cut
+
+sub param_order {
+ return shift->{param_order};
+}
+
=back
+=head1 SUPPORT
+
+Since its original creation this module has been taken over by the Catalyst
+development team. If you want to contribute patches, these will be your
+primary contact points:
+
+IRC:
+
+ Join #catalyst-dev on irc.perl.org.
+
+Mailing Lists:
+
+ http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
+
=head1 AUTHOR
-Christian Hansen, C<ch@ngmedia.com>
+Christian Hansen, C<chansen@cpan.org>
Sebastian Riedel, C<sri@cpan.org>
Andy Grundman, C<andy@hybridized.org>
+=head1 CONTRIBUTORS
+
+Simon Elliott C<cpan@papercreatures.com>
+
+Kent Fredric <kentnl@cpan.org>
+
+Christian Walde
+
+Torsten Raudssus <torsten@raudssus.de>
+
=head1 LICENSE
This library is free software. You can redistribute it and/or modify