Added RT88342 related test (found parsing bug in that way), tighten some other tests

diff --git a/lib/HTTP/Body/MultiPart.pm b/lib/HTTP/Body/MultiPart.pm
index 0296171..41c7bab 100644 (file)
--- a/lib/HTTP/Body/MultiPart.pm
+++ b/lib/HTTP/Body/MultiPart.pm
@@ -255,6 +255,9 @@ sub parse_body {
 
 =cut
 
+our $basename_regexp = qr/[^.]+(\.[^\\\/]+)$/;
+#our $basename_regexp = qr/(\.\w+(?:\.\w+)*)$/;
+
 sub handler {
     my ( $self, $part ) = @_;
 
@@ -272,7 +275,7 @@ sub handler {
 
             if ( $filename ne "" ) {
                 my $basename = (File::Spec->splitpath($filename))[2];
-                my $suffix = $basename =~ /[^.]+(\.[^\\\/]+)$/ ? $1 : q{};
+                my $suffix = $basename =~ $basename_regexp ? $1 : q{};
 
                 my $fh = File::Temp->new( UNLINK => 0, DIR => $self->tmpdir, SUFFIX => $suffix );
 

diff --git a/t/08multipart-suffix.t b/t/08multipart-suffix.t
index fadc874..b72d161 100644 (file)
--- a/t/08multipart-suffix.t
+++ b/t/08multipart-suffix.t
@@ -24,7 +24,7 @@ my $path = catdir( getcwd(), 't', 'data', 'multipart' );
        {
                my ($volume,$directories,$file) = File::Spec->splitpath( $uploads->{upload2}{tempname} );       
                like(
-                       $file, qr/\.pl$/,
+                       $file, qr/^.{10}\.pl$/,
                        'tempname preserves .pl suffix'
                );
        }
@@ -32,7 +32,7 @@ my $path = catdir( getcwd(), 't', 'data', 'multipart' );
        {
                my ($volume,$directories,$file) = File::Spec->splitpath( $uploads->{upload4}{tempname} );       
                unlike(
-                       $file, qr/\..+$/,
+                       $file, qr/^.{10}\..+$/,
                        'tempname for upload4 has no suffix'
                );
        }
@@ -45,7 +45,7 @@ my $path = catdir( getcwd(), 't', 'data', 'multipart' );
        {
                my ($volume,$directories,$file) = File::Spec->splitpath( $uploads->{upload2}{tempname} );       
                like(
-                       $file, qr/\.pl$/,
+                       $file, qr/^.{10}\.pl$/,
                        'tempname preserves .pl suffix with Windows filename'
                );
        }
@@ -58,7 +58,7 @@ my $path = catdir( getcwd(), 't', 'data', 'multipart' );
        {
                my ($volume,$directories,$file) = File::Spec->splitpath( $uploads->{upload}{tempname} );        
                like(
-                       $file, qr/\.foo\.txt$/,
+                       $file, qr/^.{10}\.foo\.txt$/,
                        'tempname preserves .foo.txt suffix'
                );
        }
@@ -66,7 +66,7 @@ my $path = catdir( getcwd(), 't', 'data', 'multipart' );
        {
                my ($volume,$directories,$file) = File::Spec->splitpath( $uploads->{upload2}{tempname} );       
                like(
-                       $file, qr/\.txt$/,
+                       $file, qr/^.{10}\.txt$/,
                        'tempname preserves .txt suffix when dir name has .'
                );
        }

diff --git a/t/09rt88342.t b/t/09rt88342.t
new file mode 100644 (file)
index 0000000..d71d3d0
--- /dev/null
+++ b/t/09rt88342.t
@@ -0,0 +1,70 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 3;
+use Test::Deep;
+
+use Cwd;
+use HTTP::Body;
+use File::Spec::Functions;
+use IO::File;
+use PAML;
+use File::Temp qw/ tempdir /;
+
+my $path = catdir( getcwd(), 't', 'data', 'multipart' );
+
+{
+  $HTTP::Body::MultiPart::basename_regexp = qr/(\.\w+(?:\.\w+)*)$/;
+
+    my $uploads = uploads_for('015');
+
+       {
+               my ($volume,$directories,$file) = File::Spec->splitpath( $uploads->{upload}{tempname} );        
+               like(
+                       $file, qr/^.{10}\.tar\.gz\.Z$/,
+                       'tempname preserves .tar.gz.Z suffix'
+               );
+       }
+
+  {
+    my ($volume,$directories,$file) = File::Spec->splitpath( $uploads->{upload2}{tempname} );  
+    like(
+      $file, qr/^.{10}\.png$/,
+      'tempname preserves .png suffix'
+    );
+  }
+
+  {
+    my ($volume,$directories,$file) = File::Spec->splitpath( $uploads->{upload3}{tempname} );  
+    like(
+      $file, qr/^.{10}\.txt$/,
+      'tempname preserves .txt suffix'
+    );
+  }
+
+}
+
+sub uploads_for {
+    my $number = shift;
+
+    my $headers = PAML::LoadFile( catfile( $path, "$number-headers.pml" ) );
+    my $content = IO::File->new( catfile( $path, "$number-content.dat" ) );
+    my $body    = HTTP::Body->new( $headers->{'Content-Type'}, $headers->{'Content-Length'} );
+    my $tempdir = tempdir( 'XXXXXXX', CLEANUP => 1, DIR => File::Spec->tmpdir() );
+    $body->tmpdir($tempdir);
+
+    binmode $content, ':raw';
+
+    while ( $content->read( my $buffer, 1024 ) ) {
+        $body->add($buffer);
+    }
+
+    $body->cleanup(1);
+
+    return $body->upload;
+}

diff --git a/t/data/multipart/015-content.dat b/t/data/multipart/015-content.dat
new file mode 100644 (file)
index 0000000..de73506
--- /dev/null
+++ b/t/data/multipart/015-content.dat
@@ -0,0 +1,19 @@
+------------0xKhTmLbOuNdArY\r
+Content-Disposition: form-data; name="upload"; filename="xx xx.xx xx.tar.gz.Z"\r
+Content-Type: text/plain\r
+\r
+Some random junk\r
+\r
+------------0xKhTmLbOuNdArY\r
+Content-Disposition: form-data; name="upload2"; filename="2013-06-19 at 11.37.56 PM.png"\r
+Content-Type: text/plain\r
+\r
+Some random junk\r
+\r
+------------0xKhTmLbOuNdArY\r
+Content-Disposition: form-data; name="upload3"; filename="C:\Documents\foo bar\bar baz.txt"\r
+Content-Type: text/plain\r
+\r
+blah blah\r
+\r
+------------0xKhTmLbOuNdArY--\r

diff --git a/t/data/multipart/015-headers.pml b/t/data/multipart/015-headers.pml
new file mode 100644 (file)
index 0000000..d23f01b
--- /dev/null
+++ b/t/data/multipart/015-headers.pml
@@ -0,0 +1,5 @@
+{
+  "User-Agent" => "Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en) AppleWebKit/312.1 (KHTML, like Gecko) Safari/312",
+  "Content-Length" => 339,
+  "Content-Type" => "multipart/form-data; boundary=----------0xKhTmLbOuNdArY"
+}