[libhttp-entity-parser-perl] 01/03: use tempdir for multipart ref:https://github.com/plack/Plack/pull/537
gregor herrmann
gregoa at debian.org
Sun Oct 23 00:23:42 UTC 2016
This is an automated email from the git hooks/post-receive script.
gregoa pushed a commit to tag 0.13
in repository libhttp-entity-parser-perl.
commit d1bd9ee9196e26423a7bf0fab036adb1e74cd79d
Author: Masahiro Nagano <kazeburo at gmail.com>
Date: Sun Nov 15 00:50:38 2015 +0900
use tempdir for multipart ref:https://github.com/plack/Plack/pull/537
---
Build.PL | 33 +++++++----------
META.json | 7 ++--
README.md | 15 ++++----
lib/HTTP/Entity/Parser.pm | 5 ++-
lib/HTTP/Entity/Parser/MultiPart.pm | 11 +++---
t/01_content_type/multipart.t | 71 +++++++++++++++++++++----------------
6 files changed, 71 insertions(+), 71 deletions(-)
diff --git a/Build.PL b/Build.PL
index 2c66fc2..42e060e 100644
--- 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
index b8e77ea..81a5b23 100644
--- a/META.json
+++ b/META.json
@@ -4,7 +4,7 @@
"Masahiro Nagano <kazeburo at 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
index 7567f58..2a84c07 100644
--- 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
index 1dddba4..6d6dfcf 100644
--- 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
index 60ad2c8..da9820d 100644
--- 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
index 3ec3375..10f76f8 100644
--- 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+ at 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+ at 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();
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libhttp-entity-parser-perl.git
More information about the Pkg-perl-cvs-commits
mailing list