use tempdir for multipart ref:plack/Plack#537

kazeburo · kazeburo · commit d1bd9ee9196e · 2015-11-15T00:50:38.000+09:00
diff --git a/Build.PL b/Build.PL
@@ -12,8 +12,6 @@ use utf8;
 use Module::Build;
 use File::Basename;
 use File::Spec;
-use CPAN::Meta;
-use CPAN::Meta::Prereqs;
 
 my %args = (
     license              => 'perl',
@@ -34,7 +32,7 @@ my %args = (
     test_files           => ((-d '.git' || $ENV{RELEASE_TESTING}) && -d 'xt') ? 't/ xt/' : 't/',
     recursive_test_files => 1,
 
-    
+
 );
 if (-d 'share') {
     $args{share_dir} = 'share';
@@ -53,20 +51,15 @@ my $builder = Module::Build->subclass(
 )->new(%args);
 $builder->create_build_script();
 
-my $mbmeta = CPAN::Meta->load_file('MYMETA.json');
-my $meta = CPAN::Meta->load_file('META.json');
-my $prereqs_hash = CPAN::Meta::Prereqs->new(
-    $meta->prereqs
-)->with_merged_prereqs(
-    CPAN::Meta::Prereqs->new($mbmeta->prereqs)
-)->as_string_hash;
-my $mymeta = CPAN::Meta->new(
-    {
-        %{$meta->as_struct},
-        prereqs => $prereqs_hash
-    }
-);
-print "Merging cpanfile prereqs to MYMETA.yml\n";
-$mymeta->save('MYMETA.yml', { version => 1.4 });
-print "Merging cpanfile prereqs to MYMETA.json\n";
-$mymeta->save('MYMETA.json', { version => 2 });
+use File::Copy;
+
+print "cp META.json MYMETA.json\n";
+copy("META.json","MYMETA.json") or die "Copy failed(META.json): $!";
+
+if (-f 'META.yml') {
+    print "cp META.yml MYMETA.yml\n";
+    copy("META.yml","MYMETA.yml") or die "Copy failed(META.yml): $!";
+} else {
+    print "There is no META.yml... You may install this module from the repository...\n";
+}
+
diff --git a/META.json b/META.json
@@ -4,7 +4,7 @@
       "Masahiro Nagano <kazeburo@gmail.com>"
    ],
    "dynamic_config" : 0,
-   "generated_by" : "Minilla/v0.11.0, CPAN::Meta::Converter version 2.132830",
+   "generated_by" : "Minilla/v2.4.1, CPAN::Meta::Converter version 2.141170",
    "license" : [
       "perl_5"
    ],
@@ -28,15 +28,14 @@
    "prereqs" : {
       "configure" : {
          "requires" : {
-            "CPAN::Meta" : "0",
-            "CPAN::Meta::Prereqs" : "0",
             "Module::Build" : "0.38"
          }
       },
       "develop" : {
          "requires" : {
             "Test::CPAN::Meta" : "0",
-            "Test::MinimumVersion" : "0.10108",
+            "Test::MinimumVersion::Fast" : "0.04",
+            "Test::PAUSE::Permissions" : "0.04",
             "Test::Pod" : "1.41",
             "Test::Spellunker" : "v0.2.7"
          }
diff --git a/README.md b/README.md
@@ -6,7 +6,6 @@ HTTP::Entity::Parser - PSGI compliant HTTP Entity Parser
 
     use HTTP::Entity::Parser;
     
-
     my $parser = HTTP::Entity::Parser->new;
     $parser->register('application/x-www-form-urlencoded','HTTP::Entity::Parser::UrlEncoded');
     $parser->register('multipart/form-data','HTTP::Entity::Parser::MultiPart');
@@ -20,12 +19,10 @@ HTTP::Entity::Parser - PSGI compliant HTTP Entity Parser
 # DESCRIPTION
 
 HTTP::Entity::Parser is PSGI compliant HTTP Entity parser. This module also has compatibility 
-with [HTTP::Body](http://search.cpan.org/perldoc?HTTP::Body). Unlike HTTP::Body, HTTP::Entity::Parser reads HTTP entity from 
+with [HTTP::Body](https://metacpan.org/pod/HTTP::Body). Unlike HTTP::Body, HTTP::Entity::Parser reads HTTP entity from 
 PSGI's env `$env->{'psgi.input'}` and parse it.
 This module support application/x-www-form-urlencoded, multipart/form-data and application/json.
 
-
-
 # METHODS
 
 - new()
@@ -93,7 +90,7 @@ This module support application/x-www-form-urlencoded, multipart/form-data and a
 
     For `multipart/form-data`. It is used for HTTP POST contains file upload.
 
-    MultiPart parser use [HTTP::MultiPartParser](http://search.cpan.org/perldoc?HTTP::MultiPartParser).
+    MultiPart parser use [HTTP::MultiPartParser](https://metacpan.org/pod/HTTP::MultiPartParser).
 
 - JSON
 
@@ -109,10 +106,10 @@ HTTP::Entity::Parser is able to choose parsers by the instance, HTTP::Body requi
 
 # SEE ALSO
 
-- [HTTP::Body](http://search.cpan.org/perldoc?HTTP::Body)
-- [HTTP::MultiPartParser](http://search.cpan.org/perldoc?HTTP::MultiPartParser)
-- [Plack::Request](http://search.cpan.org/perldoc?Plack::Request)
-- [WWW::Form::UrlEncoded](http://search.cpan.org/perldoc?WWW::Form::UrlEncoded)
+- [HTTP::Body](https://metacpan.org/pod/HTTP::Body)
+- [HTTP::MultiPartParser](https://metacpan.org/pod/HTTP::MultiPartParser)
+- [Plack::Request](https://metacpan.org/pod/Plack::Request)
+- [WWW::Form::UrlEncoded](https://metacpan.org/pod/WWW::Form::UrlEncoded)
 
     HTTP::Entity::Parser uses this for parse application/x-www-form-urlencoded
 
diff --git a/lib/HTTP/Entity/Parser.pm b/lib/HTTP/Entity/Parser.pm
@@ -49,7 +49,7 @@ sub parse {
             last;
         }
     }
-    
+
     if ( !$parser ) {
         $parser = HTTP::Entity::Parser::OctetStream->new();
     }
@@ -74,7 +74,6 @@ sub parse {
             $cl -= $read;
             $parser->add($chunk);
             $buffer->print($chunk) if $buffer;
-            
             if ($read == 0 && $spin++ > 2000) {
                 Carp::croak "Bad Content-Length: maybe client disconnect? ($cl bytes remaining)";
             }
@@ -99,7 +98,7 @@ sub parse {
                 $parser->add($loaded);
                 $buffer->print($loaded);
                 $chunk_buffer =~ s/^\015\012//;
-                $length += $chunk_len;                        
+                $length += $chunk_len;
             }
         }
         $env->{CONTENT_LENGTH} = $length;
diff --git a/lib/HTTP/Entity/Parser/MultiPart.pm b/lib/HTTP/Entity/Parser/MultiPart.pm
@@ -23,6 +23,12 @@ sub new {
     }
     my $boundary = $1;
 
+    my $template = File::Spec->catdir(File::Spec->tmpdir, "HTTP-Entity-Parser-MultiPart-XXXXX");
+    my $dir = File::Temp->newdir($template, CLEANUP => 1);
+    # Temporary dir will remove after the request.
+    push @{$env->{'http.entity.parser.multipart.tempdir'}}, $dir;
+    $self->{tempdir} = "$dir";
+
     my $part;
     my $parser = HTTP::MultiPartParser->new(
         boundary => $boundary,
@@ -51,12 +57,9 @@ sub new {
 
             if ( exists $disposition_param{filename}) {
                 $part->{filename} = $disposition_param{filename};
-                my ($tempfh, $tempname) = tempfile(UNLINK => 1);
+                my ($tempfh, $tempname) = tempfile(UNLINK => 0, DIR => $self->{tempdir});
                 $part->{fh} = $tempfh;
                 $part->{tempname} = $tempname;
-                # Save temporary files to $env.
-                # Temporary files will remove after the request.
-                push @{$env->{'http.entity.parser.multipart.filehandles'}}, $part->{fh};
             }
         },
         on_body => sub {
diff --git a/t/01_content_type/multipart.t b/t/01_content_type/multipart.t
@@ -5,6 +5,7 @@ use HTTP::Entity::Parser::MultiPart;
 use Hash::MultiValue;
 use HTTP::Headers;
 use t::Util;
+use File::Basename;
 
 my $content = qq{------BOUNDARY
 Content-Disposition: form-data; name="hoge"
@@ -59,41 +60,49 @@ SHOGUN6
 $content =~ s/\r\n/\n/g;
 $content =~ s/\n/\r\n/g;
 
-my $env = {
-    CONTENT_LENGTH => length($content),
-    CONTENT_TYPE   => 'multipart/form-data; boundary=----BOUNDARY',
-};
-
-# read from file.
-my $parser = HTTP::Entity::Parser::MultiPart->new($env);
-$parser->add($_) for split //, $content;
-my ($params, $uploads) = $parser->finalize();
-
-is_deeply( Hash::MultiValue->new(@$params)->as_hashref_multi, {   
-    hoge => ['fuga', 'hige'],
-    nobuko => ['iwaki'],
-});
-
-$uploads = Hash::MultiValue->new(@$uploads);
-
-my @test_upload_file = $uploads->get_all('test_upload_file');
-is 0+@test_upload_file, 2;
-is slurp($test_upload_file[0]->{tempname}), 'SHOGUN';
-is slurp($test_upload_file[1]->{tempname}), 'SHOGUN2';
+my $tmpdir;
 
 {
-    my $test_upload_file3 = $uploads->{'test_upload_file3'};
-    is slurp($test_upload_file3->{tempname}), 'SHOGUN3';
-
-    my @test_upload_file6 = $uploads->{'test_upload_file6'};
-    is slurp($test_upload_file6[0]->{tempname}), 'SHOGUN6';
-    my $header = HTTP::Headers->new(@{$test_upload_file6[0]->{headers}});
-    is $header->header('Content-Type'), 'text/plain';
-    is $header->content_type, 'text/plain';
-    is $header->header('X'), 'Y:Z';
-    is $header->header('Foo'), 'bar baz';
+    my $env = {
+        CONTENT_LENGTH => length($content),
+        CONTENT_TYPE   => 'multipart/form-data; boundary=----BOUNDARY',
+    };
+
+    # read from file.
+    my $parser = HTTP::Entity::Parser::MultiPart->new($env);
+    $parser->add($_) for split //, $content;
+    my ($params, $uploads) = $parser->finalize();
+
+    is_deeply( Hash::MultiValue->new(@$params)->as_hashref_multi, {   
+        hoge => ['fuga', 'hige'],
+        nobuko => ['iwaki'],
+    });
+
+    $uploads = Hash::MultiValue->new(@$uploads);
+
+    my @test_upload_file = $uploads->get_all('test_upload_file');
+    is 0+@test_upload_file, 2;
+    is slurp($test_upload_file[0]->{tempname}), 'SHOGUN';
+    is slurp($test_upload_file[1]->{tempname}), 'SHOGUN2';
+
+    {
+        my $test_upload_file3 = $uploads->{'test_upload_file3'};
+        is slurp($test_upload_file3->{tempname}), 'SHOGUN3';
+
+        my @test_upload_file6 = $uploads->{'test_upload_file6'};
+        is slurp($test_upload_file6[0]->{tempname}), 'SHOGUN6';
+        my $header = HTTP::Headers->new(@{$test_upload_file6[0]->{headers}});
+        is $header->header('Content-Type'), 'text/plain';
+        is $header->content_type, 'text/plain';
+        is $header->header('X'), 'Y:Z';
+        is $header->header('Foo'), 'bar baz';
+    }
+
+    $tmpdir = dirname($test_upload_file[0]->{tempname});
 }
 
+ok(! -d $tmpdir);
+
 done_testing();
 
 

Original file line number	Diff line number	Diff line change
`@@ -49,7 +49,7 @@ sub parse {`
`49`	`49`	`last;`
`50`	`50`	`}`
`51`	`51`	`}`
`52`		`-`
	`52`	`+`
`53`	`53`	`if ( !$parser ) {`
`54`	`54`	`$parser = HTTP::Entity::Parser::OctetStream->new();`
`55`	`55`	`}`
`@@ -74,7 +74,6 @@ sub parse {`
`74`	`74`	`$cl -= $read;`
`75`	`75`	`$parser->add($chunk);`
`76`	`76`	`$buffer->print($chunk) if $buffer;`
`77`		`-`
`78`	`77`	`if ($read == 0 && $spin++ > 2000) {`
`79`	`78`	`Carp::croak "Bad Content-Length: maybe client disconnect? ($cl bytes remaining)";`
`80`	`79`	`}`
`@@ -99,7 +98,7 @@ sub parse {`
`99`	`98`	`$parser->add($loaded);`
`100`	`99`	`$buffer->print($loaded);`
`101`	`100`	`$chunk_buffer =~ s/^\015\012//;`
`102`		`- $length += $chunk_len;`
	`101`	`+ $length += $chunk_len;`
`103`	`102`	`}`
`104`	`103`	`}`
`105`	`104`	`$env->{CONTENT_LENGTH} = $length;`