[libhttp-entity-parser-perl] 08/11: parse disposition with regexp

[gregor herrmann]

This is an automated email from the git hooks/post-receive script.

gregoa pushed a commit to tag 0.01
in repository libhttp-entity-parser-perl.

commit e2355429b9912d9f5ed5cfff8335d67a1618aca1
Author: Masahiro Nagano <kazeburo at gmail.com>
Date:   Wed Feb 5 10:07:54 2014 +0900

    parse disposition with regexp
---
 META.json                            |  4 ++--
 cpanfile                             |  4 ++--
 lib/HTTP/Entity/Parser/MultiPart.pm  | 25 +++++++------------------
 lib/HTTP/Entity/Parser/UrlEncoded.pm |  8 ++++----
 t/02_http_body/multipart.t           | 11 +++++++++++
 5 files changed, 26 insertions(+), 26 deletions(-)

diff --git a/META.json b/META.json
index 3eb9c9a..1ef5f78 100644
--- a/META.json
+++ b/META.json
@@ -45,10 +45,9 @@
          "requires" : {
             "Encode" : "0",
             "File::Temp" : "0",
-            "HTTP::Message" : "6",
             "HTTP::MultiPartParser" : "0",
             "JSON" : "2",
-            "Module::load" : "0",
+            "Module::Load" : "0",
             "Stream::Buffered" : "0",
             "perl" : "5.008005"
          }
@@ -57,6 +56,7 @@
          "requires" : {
             "Cwd" : "0",
             "File::Spec::Functions" : "0",
+            "HTTP::Message" : "6",
             "Hash::MultiValue" : "0",
             "Test::More" : "0.98"
          }
diff --git a/cpanfile b/cpanfile
index c70cb51..52d01dd 100644
--- a/cpanfile
+++ b/cpanfile
@@ -1,10 +1,9 @@
 requires 'perl', '5.008001';
 requires 'Stream::Buffered';
-requires 'Module::load';
+requires 'Module::Load';
 requires 'JSON' => '2';
 requires 'Encode';
 requires 'HTTP::MultiPartParser';
-requires 'HTTP::Message' => 6;
 requires 'File::Temp';
 
 on 'test' => sub {
@@ -12,6 +11,7 @@ on 'test' => sub {
     requires 'Hash::MultiValue';
     requires 'File::Spec::Functions';
     requires 'Cwd';
+    requires 'HTTP::Message' => 6;
 };
 
 
diff --git a/lib/HTTP/Entity/Parser/MultiPart.pm b/lib/HTTP/Entity/Parser/MultiPart.pm
index c227d40..60ad2c8 100644
--- a/lib/HTTP/Entity/Parser/MultiPart.pm
+++ b/lib/HTTP/Entity/Parser/MultiPart.pm
@@ -3,7 +3,6 @@ package HTTP::Entity::Parser::MultiPart;
 use strict;
 use warnings;
 use HTTP::MultiPartParser;
-use HTTP::Headers::Util qw/split_header_words/;
 use File::Temp qw/tempfile/;
 use Carp qw//;
 use Fcntl ":seek";
@@ -41,27 +40,17 @@ sub new {
             (defined $disposition)
                 or die q/Content-Disposition header is missing in part/;
 
-            my ($p) = split_header_words($disposition);
-
-            ($p->[0] eq 'form-data')
-            or die q/Disposition type is not form-data/;
-            use Data::Dumper;
-            my ($name, $filename);
-            for(my $i = 2; $i < @$p; $i += 2) {
-                if    ($p->[$i] eq 'name')     { $name     = $p->[$i + 1] }
-                elsif ($p->[$i] eq 'filename') { $filename = $p->[$i + 1] }
-            }
-
-            (defined $name)
+            my %disposition_param = ($disposition =~ /\b((?:file)?name)="?([^\";]*)"?/g);
+            (exists $disposition_param{name} && length $disposition_param{name} > 0 )
                 or die q/Parameter 'name' is missing from Content-Disposition header/;
 
             $part = {
-                name    => $name,
+                name    => $disposition_param{name},
                 headers => $headers,
             };
 
-            if (defined $filename) {
-                $part->{filename} = $filename;
+            if ( exists $disposition_param{filename}) {
+                $part->{filename} = $disposition_param{filename};
                 my ($tempfh, $tempname) = tempfile(UNLINK => 1);
                 $part->{fh} = $tempfh;
                 $part->{tempname} = $tempname;
@@ -77,13 +66,14 @@ sub new {
             if ($fh) {
                 print $fh $chunk
                     or die qq/Could not write to file handle: '$!'/;
-                if ($final) {
+                if ($final && $part->{filename} ne "" ) {
                     seek($fh, 0, SEEK_SET)
                         or die qq/Could not rewind file handle: '$!'/;
 
                     my @headers = map { split(/\s*:\s*/, $_, 2) }
                         @{$part->{headers}};
                     push @uploads, $part->{name}, {
+                        name     => $part->{name},
                         headers  => \@headers,
                         size     => -s $part->{fh},
                         filename => $part->{filename},
@@ -93,7 +83,6 @@ sub new {
             } else {
                 $part->{data} .= $chunk;
                 if ($final) {
-
                     push @params, $part->{name}, $part->{data};
                 }
             }
diff --git a/lib/HTTP/Entity/Parser/UrlEncoded.pm b/lib/HTTP/Entity/Parser/UrlEncoded.pm
index 718705d..7745d42 100644
--- a/lib/HTTP/Entity/Parser/UrlEncoded.pm
+++ b/lib/HTTP/Entity/Parser/UrlEncoded.pm
@@ -8,10 +8,10 @@ our %DecodeMap;
 for my $num ( 0 .. 255 ) {
     my $h = sprintf "%02X", $num;
     my $chr = chr $num;
-    $DecodeMap{ lc $h } = $chr;
-    $DecodeMap{ uc $h } = $chr;
-    $DecodeMap{ ucfirst lc $h } = $chr;
-    $DecodeMap{ lcfirst uc $h } = $chr;
+    $DecodeMap{ lc $h } = $chr; #%aa
+    $DecodeMap{ uc $h } = $chr; #%AA
+    $DecodeMap{ ucfirst lc $h } = $chr; #%Aa
+    $DecodeMap{ lcfirst uc $h } = $chr; #%aA
 }
 
 sub new {
diff --git a/t/02_http_body/multipart.t b/t/02_http_body/multipart.t
index 5de333d..c7e2a91 100644
--- a/t/02_http_body/multipart.t
+++ b/t/02_http_body/multipart.t
@@ -31,6 +31,17 @@ for my $i ( 1..15 ) {
         my $hash = Hash::MultiValue->new(@$params);
         is_deeply([$hash->keys], $results->{param_order}, "[$i] param_order");
         is_deeply($hash->as_hashref_mixed, $results->{param}, "[$i] param");
+
+        my $upload_hash = Hash::MultiValue->new(@$uploads);
+        $upload_hash->each(sub {
+            delete $_[1]->{tempname};
+            my $headers = delete $_[1]->{headers};
+            my %headers = @$headers;
+            $_[1]->{headers} = \%headers;
+        });
+        
+        is_deeply($upload_hash->as_hashref_mixed, $results->{upload} || {}, "[$i] upload");
+
     }
     else {
         ok($@);

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libhttp-entity-parser-perl.git