X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FHTTP%2FBody%2FMultiPart.pm;h=18354abc1004fb47de1e03f64d1a914972521608;hb=cc75c886256f187cda388641931e8dafad6c2346;hp=45569c33c32f9f86a1cba7d0962b2c11648b9738;hpb=7428d118b058657ee74c900c01b3278e67750d3d;p=catagits%2FHTTP-Body.git diff --git a/lib/HTTP/Body/MultiPart.pm b/lib/HTTP/Body/MultiPart.pm index 45569c3..18354ab 100644 --- a/lib/HTTP/Body/MultiPart.pm +++ b/lib/HTTP/Body/MultiPart.pm @@ -6,6 +6,7 @@ use bytes; use IO::File; use File::Temp 0.14; +use File::Spec; =head1 NAME @@ -13,7 +14,7 @@ HTTP::Body::MultiPart - HTTP Body Multipart Parser =head1 SYNOPSIS - use HTTP::Body::Multipart; + use HTTP::Body::MultiPart; =head1 DESCRIPTION @@ -30,7 +31,7 @@ HTTP Body Multipart Parser. sub init { my $self = shift; - unless ( $self->content_type =~ /boundary=\"?([^\";,]+)\"?/ ) { + unless ( $self->content_type =~ /boundary=\"?([^\";]+)\"?/ ) { my $content_type = $self->content_type; Carp::croak("Invalid boundary in content_type: '$content_type'"); } @@ -89,7 +90,7 @@ sub boundary_end { =cut -sub crlf { +sub crlf () { return "\x0d\x0a"; } @@ -254,55 +255,72 @@ sub parse_body { =cut +our $basename_regexp = qr/[^.]+(\.[^\\\/]+)$/; +our $file_temp_suffix = '.upload'; +our $file_temp_template; +our %file_temp_parameters; + sub handler { my ( $self, $part ) = @_; - # skip parts without content - if ( $part->{done} && $part->{size} == 0 ) { - return 0; - } - unless ( exists $part->{name} ) { my $disposition = $part->{headers}->{'Content-Disposition'}; - my ($name) = $disposition =~ / name="?([^\";]+)"?/; - my ($filename) = $disposition =~ / filename="?([^\"]+)"?/; + my ($name) = $disposition =~ / name="?([^\";]+)"?/; + my ($filename) = $disposition =~ / filename="?([^\"]*)"?/; + # Need to match empty filenames above, so this part is flagged as an upload type + + $part->{name} = $name; - $part->{name} = $name; - $part->{filename} = $filename; + if ( defined $filename ) { + $part->{filename} = $filename; - if ($filename) { + if ( $filename ne "" ) { + my $basename = (File::Spec->splitpath($filename))[2]; + my $suffix = $basename =~ $basename_regexp ? $1 : q{}; - my $fh = File::Temp->new( UNLINK => 0 ); + my $fh = File::Temp->new( + UNLINK => 0, DIR => $self->tmpdir, SUFFIX => ($file_temp_suffix||$suffix), + ( $file_temp_template ? ( TEMPLATE => $file_temp_template ) : () ), + %file_temp_parameters, + ); - $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} ) { + if ( exists $part->{filename} ) { + if ( $part->{filename} ne "" ) { + $part->{fh}->close if defined $part->{fh}; - $part->{fh}->close; + delete @{$part}{qw[ data done fh ]}; - delete @{$part}{qw[ data done fh ]}; - - $self->upload( $part->{name}, $part ); + $self->upload( $part->{name}, $part ); + } } - + # If we have more than the content-disposition, we need to create a + # data key so that we don't waste the headers. else { $self->param( $part->{name}, $part->{data} ); + $self->part_data( $part->{name}, $part ) } } } =back +=head1 SUPPORT + +See L + =head1 AUTHOR Christian Hansen, C