Changing default behavior of upload handling to stop taking over the upload extension...

[catagits/HTTP-Body.git] / lib / HTTP / Body / MultiPart.pm

diff --git a/lib/HTTP/Body/MultiPart.pm b/lib/HTTP/Body/MultiPart.pm
index 763838b..18354ab 100644 (file)
--- 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'");
     }
@@ -254,6 +255,11 @@ 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 ) = @_;
 
@@ -270,7 +276,14 @@ sub handler {
             $part->{filename} = $filename;
 
             if ( $filename ne "" ) {
-                my $fh = File::Temp->new( UNLINK => 0 );
+                my $basename = (File::Spec->splitpath($filename))[2];
+                my $suffix = $basename =~ $basename_regexp ? $1 : q{};
+
+                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;
@@ -293,14 +306,21 @@ sub handler {
                 $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<HTTP::Body>
+
 =head1 AUTHOR
 
 Christian Hansen, C<ch@ngmedia.com>