replace HTTP::Body with URL::Encode and HTTP::MultiPartParser

cpanfile

@@ -5,7 +5,6 @@ requires 'Devel::StackTrace', '1.23';
 requires 'Devel::StackTrace::AsHTML', '0.11';
 requires 'File::ShareDir', '1.00';
 requires 'Filesys::Notify::Simple';
-requires 'HTTP::Body', '1.06';
 requires 'HTTP::Message', '5.814';
 requires 'HTTP::Headers::Fast', '0.18';
 requires 'Hash::MultiValue', '0.05';
@@ -16,7 +15,9 @@ requires 'Try::Tiny';
 requires 'URI', '1.59';
 requires 'parent';
 requires 'Apache::LogFormat::Compiler', '0.12';
-requires 'HTTP::Tiny', 0.034;
+requires 'HTTP::Tiny', '0.034';
+requires 'URL::Encode', '0.03';
+requires 'HTTP::MultiPartParser', '0.01';
 
 on test => sub {
     requires 'Test::More', '0.88';
@@ -41,5 +42,5 @@ on runtime => sub {
     suggests 'CGI::Compile';
     suggests 'IO::Handle::Util';
     suggests 'LWP::UserAgent', '5.814';
+    suggests 'URL::Encode::XS';
 };
-

lib/Plack/Request.pm

@@ -7,9 +7,7 @@ our $VERSION = '1.0037';
 use HTTP::Headers::Fast;
 use Carp ();
 use Hash::MultiValue;
-use HTTP::Body;
-
-use Plack::Request::Upload;
+use Plack::Request::Body;
 use Stream::Buffered;
 use URI;
 use URI::Escape ();
@@ -161,11 +159,10 @@ sub parameters {
 sub uploads {
     my $self = shift;
 
-    if ($self->env->{'plack.request.upload'}) {
-        return $self->env->{'plack.request.upload'};
+    unless ($self->env->{'plack.request.upload'}) {
+        $self->_parse_request_body;
     }
 
-    $self->_parse_request_body;
     return $self->env->{'plack.request.upload'};
 }
 
@@ -249,15 +246,12 @@ sub _parse_request_body {
         return;
     }
 
-    my $body = HTTP::Body->new($ct, $cl);
+
+
+    my $body = Plack::Request::Body->new($ct, $cl);
 
-    # HTTP::Body will create temporary files in case there was an
-    # upload.  Those temporary files can be cleaned up by telling
-    # HTTP::Body to do so. It will run the cleanup when the request
-    # env is destroyed. That the object will not go out of scope by
-    # the end of this sub we will store a reference here.
+    # Save the reference here so that Body will cleanup temp files in the end of request
     $self->env->{'plack.request.http.body'} = $body;
-    $body->cleanup(1);
 
     my $input = $self->input;
 
@@ -274,41 +268,29 @@ sub _parse_request_body {
         $input->read(my $chunk, $cl < 8192 ? $cl : 8192);
         my $read = length $chunk;
         $cl -= $read;
-        $body->add($chunk);
+        $body->read($chunk);
         $buffer->print($chunk) if $buffer;
 
         if ($read == 0 && $spin++ > 2000) {
             Carp::croak "Bad Content-Length: maybe client disconnect? ($cl bytes remaining)";
         }
     }
 
+    $body->finish;
+
     if ($buffer) {
         $self->env->{'psgix.input.buffered'} = 1;
         $self->env->{'psgi.input'} = $buffer->rewind;
     } else {
         $input->seek(0, 0);
     }
 
-    $self->env->{'plack.request.body'}   = Hash::MultiValue->from_mixed($body->param);
-
-    my @uploads = Hash::MultiValue->from_mixed($body->upload)->flatten;
-    my @obj;
-    while (my($k, $v) = splice @uploads, 0, 2) {
-        push @obj, $k, $self->_make_upload($v);
-    }
-
-    $self->env->{'plack.request.upload'} = Hash::MultiValue->new(@obj);
+    $self->env->{'plack.request.body'}   = $body->parameters;
+    $self->env->{'plack.request.upload'} = $body->uploads;
 
     1;
 }
 
-sub _make_upload {
-    my($self, $upload) = @_;
-    my %copy = %$upload;
-    $copy{headers} = HTTP::Headers::Fast->new(%{$upload->{headers}});
-    Plack::Request::Upload->new(%copy);
-}
-
 1;
 __END__
 

lib/Plack/Request/Body.pm

@@ -0,0 +1,157 @@
+package Plack::Request::Body;
+use strict;
+use warnings;
+use Hash::MultiValue;
+
+sub new {
+    my($class, $content_type, $length) = @_;
+
+    if ($content_type =~ m!^application/x-www-form-urlencoded\b!i) {
+        $class = "$class\::UrlEncoded";
+    } elsif ($content_type =~ m!^multipart/form-data\b!i) {
+        $class = "$class\::MultiPart";
+    }
+
+    my $self = bless {
+        content_type => $content_type,
+        length       => $length,
+        param_list   => [],
+        upload_list  => [],
+    }, $class;
+
+    $self->init;
+    $self;
+}
+
+sub init { }
+sub read { }
+sub finish { }
+
+sub parameters {
+    my $self = shift;
+    Hash::MultiValue->new(@{ $self->{param_list} });
+}
+
+sub uploads {
+    my $self = shift;
+    Hash::MultiValue->new(@{ $self->{upload_list} });
+}
+
+package Plack::Request::Body::UrlEncoded;
+our @ISA = qw( Plack::Request::Body );
+use URL::Encode ();
+
+sub init {
+    my $self = shift;
+    $self->{buffer} = '';
+}
+
+sub read {
+    my($self, $chunk) = @_;
+    $self->{buffer} .= $chunk;
+}
+
+sub finish {
+    my $self = shift;
+    $self->{param_list} = URL::Encode::url_params_flat($self->{buffer});
+}
+
+package Plack::Request::Body::MultiPart;
+our @ISA = qw( Plack::Request::Body );
+use Carp ();
+use File::Temp ();
+use File::Spec ();
+use HTTP::MultiPartParser ();
+use Plack::Request::Upload;
+
+our $HeaderToken = qr/[^][\x00-\x1f\x7f()<>@,;:\\"\/?={} \t]+/;
+
+sub init {
+    my $self = shift;
+
+    $self->{content_type} =~ /boundary=\"?([^\";]+)\"?/
+      or Carp::croak("Invalid boundary in content_type: $self->{content_type}");
+
+    my $part;
+
+    $self->{parser} = HTTP::MultiPartParser->new(
+        boundary => $1,
+        on_header => sub { $part = {}; $self->on_header($part, @_) },
+        on_body   => sub { $self->on_body($part, @_); if ($_[1]) { $self->on_complete($part, @_) } },
+    );
+
+    my $template = File::Spec->catdir(File::Spec->tmpdir, "Plack-Request-Body-XXXXX");
+    $self->{tempdir} = File::Temp->newdir($template, CLEANUP => 1)
+}
+
+sub on_header {
+    my($self, $part, $headers) = @_;
+
+    $part->{headers} = HTTP::Headers::Fast->new;
+
+    for my $header (@$headers) {
+        $header =~ s/^($HeaderToken):[\t ]*//;
+        $part->{headers}->push_header($1 => $header);
+    }
+
+    my $disposition = $part->{headers}->header('Content-Disposition');
+    my ($name)      = $disposition =~ / name="?([^\";]+)"?/;
+    my ($filename)  = $disposition =~ / filename="?([^\"]*)"?/;
+
+    $part->{name} = $name;
+
+    if ($filename) {
+        $part->{filename} = $filename;
+        $part->{fh} = File::Temp->new(UNLINK => 0, DIR => $self->{tempdir});
+    } else {
+        $part->{value} = '';
+    }
+}
+
+sub on_body {
+    my($self, $part, $chunk) = @_;
+
+    if ($part->{fh}) {
+        $part->{fh}->write($chunk);
+    } else {
+        $part->{value} .= $chunk;
+    }
+}
+
+sub on_complete {
+    my($self, $part) = @_;
+
+    if ($part->{fh}) {
+        $part->{fh}->seek(0, 0);
+
+        my $upload = Plack::Request::Upload->new(
+            filename => $part->{filename},
+            headers => $part->{headers},
+            size => -s $part->{fh},
+            tempname => $part->{fh}->filename,
+        );
+
+        push @{$self->{upload_list}}, $part->{name} => $upload;
+    } else {
+        push @{$self->{param_list}}, $part->{name} => $part->{value};
+    }
+
+    1;
+}
+
+sub read {
+    my($self, $chunk) = @_;
+    $self->{parser}->parse($chunk);
+}
+
+sub finish {
+    my $self = shift;
+    $self->{parser}->finish;
+
+    # break circular refs
+    delete $self->{parser};
+
+    1;
+}
+
+1;

t/Plack-Request/upload.t

@@ -56,7 +56,9 @@ test_psgi $app, sub {
 };
 
 # Check if the temp files got cleaned up properly
-ok !-f $_ for @temp_files;
+for (@temp_files) {
+    ok !-f $_, "file $_ is cleaned up";
+}
 
 done_testing;