use Carp qw[ ];
use List::Util qw[ first ];
-our $PARSERS = {
+our $TYPES = {
'application/octet-stream' => 'HTTP::Body::Octetstream',
'application/x-www-form-urlencoded' => 'HTTP::Body::Urlencoded',
'multipart/form-data' => 'HTTP::Body::Multipart'
unless ( @_ == 3 ) {
Carp::croak( $class, '->new( $content_type, $content_length )' );
}
-
- my $type = first { index( lc($content_type), $_ ) >= 0 } keys %{ $PARSERS };
- my $body = $PARSERS->{ $type || 'application/octet-stream' };
-
+
+ my $type = first { index( lc($content_type), $_ ) >= 0 } keys %{$TYPES};
+ my $body = $TYPES->{ $type || 'application/octet-stream' };
+
eval "require $body";
-
- if ( $@ ) {
+
+ if ($@) {
die $@;
}
-
+
my $self = {
buffer => '',
content_length => $content_length,
content_type => $content_type,
length => 0,
- param => { },
- upload => { }
+ param => {},
+ state => 'buffering',
+ upload => {}
};
bless( $self, $body );
-
+
return $self->init;
}
sub add {
my $self = shift;
-
+
if ( defined $_[0] ) {
$self->{buffer} .= $_[0];
- $self->{length} += length($_[0]);
+ $self->{length} += length( $_[0] );
}
- $self->spin;
-
+ unless ( $self->state eq 'done' ) {
+ $self->spin;
+ }
+
return ( $self->length - $self->content_length );
}
Carp::croak('Define abstract method spin() in implementation');
}
+sub state {
+ my $self = shift;
+ $self->{state} = shift if @_;
+ return $self->{state};
+}
+
sub param {
my $self = shift;
while (1) {
- if ( $self->{state} eq 'done' ) {
- return 0;
- }
-
- elsif ( $self->{state} =~ /^(preamble|boundary|header|body)$/ ) {
+ if ( $self->{state} =~ /^(preamble|boundary|header|body)$/ ) {
my $method = "parse_$1";
return unless $self->$method;
}
sub handler {
my ( $self, $part ) = @_;
+ # skip parts without content
if ( $part->{done} && $part->{size} == 0 ) {
return 0;
}
sub spin {
my $self = shift;
-
+
unless ( $self->body ) {
$self->body( File::Temp->new );
}
if ( $self->length == $self->content_length ) {
seek( $self->body, 0, 0 );
+ $self->state('done');
}
}
use base 'HTTP::Body';
use bytes;
+our $DECODE = qr/%(u?[0-9a-fA-F]{2,4})/;
+
sub spin {
my $self = shift;
+ return unless $self->length == $self->content_length;
+
+ for my $pair ( split( /[&;]/, $self->{buffer} ) ) {
+
+ my ( $name, $value ) = split( /=/, $pair );
+
+ next unless defined $name;
+ next unless defined $value;
+
+ $name =~ s/$DECODE/chr(hex($1))/eg;
+ $name =~ tr/+/ /;
+ $value =~ s/$DECODE/chr(hex($1))/eg;
+ $value =~ tr/+/ /;
+
+ $self->param( $name, $value );
+ }
+ $self->{state} = 'done';
+ $self->{buffer} = ''
}
1;
use IO::File;
use YAML qw[LoadFile];
-my $test = shift(@ARGV) || 1;
+my $number = $ARGV[0] || 1;
+my $test = $ARGV[1] || 'multipart';
-my $headers = LoadFile( sprintf( "t/data/multipart/%.3d-headers.yml", $test ) );
-my $content = IO::File->new( sprintf( "t/data/multipart/%.3d-content.dat", $test ), O_RDONLY );
+
+my $headers = LoadFile( sprintf( "t/data/%s/%.3d-headers.yml", $test, $number ) );
+my $content = IO::File->new( sprintf( "t/data/%s/%.3d-content.dat", $test, $number ), O_RDONLY );
my $body = HTTP::Body->new( $headers->{'Content-Type'}, $headers->{'Content-Length'} );
binmode $content;
warn Dumper( $body->upload );
warn Dumper( $body->body );
+warn "state : " . $body->state;
warn "length : " . $body->length;
warn "content length : " . $body->content_length;
-warn "state : " . $body->{state};
-warn "buffer : " . $body->buffer;
+warn "body length : " . ( $body->body->stat )[7] if $body->body;
+warn "buffer : " . $body->buffer if $body->buffer;