use base 'HTTP::Body';
use bytes;
+use IO::File;
use File::Temp 0.14;
+=head1 NAME
+
+HTTP::Body::MultiPart - HTTP Body Multipart Parser
+
+=head1 SYNOPSIS
+
+ use HTTP::Body::Multipart;
+
+=head1 DESCRIPTION
+
+HTTP Body Multipart Parser.
+
+=head1 METHODS
+
+=over 4
+
+=item init
+
+=cut
+
sub init {
my $self = shift;
unless ( $self->content_type =~ /boundary=\"?([^\";,]+)\"?/ ) {
my $content_type = $self->content_type;
- Carp::croak("Invalid boudrary in content_type: '$content_type'");
+ Carp::croak("Invalid boundary in content_type: '$content_type'");
}
$self->{boundary} = $1;
return $self;
}
+=item spin
+
+=cut
+
sub spin {
my $self = shift;
}
}
+=item boundary
+
+=cut
+
sub boundary {
return shift->{boundary};
}
+=item boundary_begin
+
+=cut
+
sub boundary_begin {
return "--" . shift->boundary;
}
+=item boundary_end
+
+=cut
+
sub boundary_end {
return shift->boundary_begin . "--";
}
-sub crlf {
+=item crlf
+
+=cut
+
+sub crlf () {
return "\x0d\x0a";
}
+=item delimiter_begin
+
+=cut
+
sub delimiter_begin {
my $self = shift;
return $self->crlf . $self->boundary_begin;
}
+=item delimiter_end
+
+=cut
+
sub delimiter_end {
my $self = shift;
return $self->crlf . $self->boundary_end;
}
+=item parse_preamble
+
+=cut
+
sub parse_preamble {
my $self = shift;
return 1;
}
+=item parse_boundary
+
+=cut
+
sub parse_boundary {
my $self = shift;
}
if ( index( $self->{buffer}, $self->delimiter_end . $self->crlf ) == 0 ) {
-
+
substr( $self->{buffer}, 0, length( $self->delimiter_end ) + 2, '' );
$self->{part} = {};
$self->{state} = 'done';
-
+
return 0;
}
return 0;
}
+=item parse_header
+
+=cut
+
sub parse_header {
my $self = shift;
return 1;
}
+=item parse_body
+
+=cut
+
sub parse_body {
my $self = shift;
$self->{part}->{data} .= substr( $self->{buffer}, 0, $length, '' );
$self->{part}->{size} += $length;
- $self->{part}->{done} = 0;
+ $self->{part}->{done} = 0;
$self->handler( $self->{part} );
$self->{part}->{data} .= substr( $self->{buffer}, 0, $index, '' );
$self->{part}->{size} += $index;
- $self->{part}->{done} = 1;
+ $self->{part}->{done} = 1;
$self->handler( $self->{part} );
return 1;
}
+=item handler
+
+=cut
+
sub handler {
my ( $self, $part ) = @_;
- # skip parts without content
- if ( $part->{done} && $part->{size} == 0 ) {
- return 0;
- }
-
- unless ( $self->{seen}->{"$part"}++ ) {
+ unless ( exists $part->{name} ) {
my $disposition = $part->{headers}->{'Content-Disposition'};
my ($name) = $disposition =~ / name="?([^\";]+)"?/;
- my ($filename) = $disposition =~ / filename="?([^\"]+)"?/;
+ my ($filename) = $disposition =~ / filename="?([^\"]*)"?/;
+ # Need to match empty filenames above, so this part is flagged as an upload type
- $part->{name} = $name;
- $part->{filename} = $filename;
+ $part->{name} = $name;
- if ($filename) {
+ if ( defined $filename ) {
+ $part->{filename} = $filename;
- my $fh = File::Temp->new( UNLINK => 0 );
+ if ( $filename ne "" ) {
+ my $fh = File::Temp->new( UNLINK => 0 );
- $part->{fh} = $fh;
- $part->{tempname} = $fh->filename;
+ $part->{fh} = $fh;
+ $part->{tempname} = $fh->filename;
+ }
}
}
- if ( $part->{filename} && ( my $length = length( $part->{data} ) ) ) {
+ if ( $part->{fh} && ( my $length = length( $part->{data} ) ) ) {
$part->{fh}->write( substr( $part->{data}, 0, $length, '' ), $length );
}
if ( $part->{done} ) {
- if ( $part->{filename} ) {
-
- $part->{fh}->close;
-
- delete @{ $part }{ qw[ data done fh ] };
-
- $self->upload( $part->{name}, $part );
- }
+ if ( exists $part->{filename} ) {
+ if ( $part->{filename} ne "" ) {
+ $part->{fh}->close if defined $part->{fh};
+ delete @{$part}{qw[ data done fh ]};
+
+ $self->upload( $part->{name}, $part );
+ }
+ }
else {
$self->param( $part->{name}, $part->{data} );
}
}
}
+=back
+
+=head1 AUTHOR
+
+Christian Hansen, C<ch@ngmedia.com>
+
+=head1 LICENSE
+
+This library is free software . You can redistribute it and/or modify
+it under the same terms as perl itself.
+
+=cut
+
1;