add "multipart" content generator to Mojo::UserAgent::Transactor

mojolicious · Oct 3, 2017 · 5407815 · 5407815
1 parent 29f56b0
commit 5407815
Show file tree

Hide file tree

Showing 3 changed files with 147 additions and 38 deletions.
diff --git a/Changes b/Changes
@@ -1,5 +1,6 @@
 
 7.47  2017-10-03
+  - Added "multipart" content generator to Mojo::UserAgent::Transactor.
 
 7.46  2017-09-12
   - Fixed support for versions of IO::Socket::SSL older than 1.965 again.

diff --git a/lib/Mojo/UserAgent/Transactor.pm b/lib/Mojo/UserAgent/Transactor.pm
@@ -14,7 +14,8 @@ use Mojo::URL;
 use Mojo::Util qw(encode url_escape);
 use Mojo::WebSocket qw(challenge client_handshake);
 
-has generators => sub { {form => \&_form, json => \&_json} };
+has generators =>
+  sub { {form => \&_form, json => \&_json, multipart => \&_multipart} };
 has name => 'Mojolicious (Perl)';
 
 sub add_generator { $_[0]->generators->{$_[1]} = $_[2] and return $_[0] }
@@ -168,7 +169,7 @@ sub _form {
 
   # Multipart
   if ($multipart) {
-    my $parts = $self->_multipart($options{charset}, $form);
+    my $parts = $self->_multipart_form($options{charset}, $form);
     $req->content(
       Mojo::Content::MultiPart->new(headers => $headers, parts => $parts));
     _type($headers, 'multipart/form-data');
@@ -194,54 +195,79 @@ sub _json {
 }
 
 sub _multipart {
+  my ($self, $tx, $parts) = @_;
+
+  my $req     = $tx->req;
+  my $headers = $req->headers;
+  my @parts   = $self->_parts(undef, undef, $parts);
+  $req->content(
+    Mojo::Content::MultiPart->new(headers => $headers, parts => \@parts));
+
+  return $tx;
+}
+
+sub _multipart_form {
   my ($self, $charset, $form) = @_;
 
   my @parts;
   for my $name (sort keys %$form) {
     next unless defined(my $values = $form->{$name});
-    for my $value (ref $values eq 'ARRAY' ? @$values : ($values)) {
-      push @parts, my $part = Mojo::Content::Single->new;
-
-      # Upload
-      my $filename;
-      my $headers = $part->headers;
-      if (ref $value eq 'HASH') {
-
-        # File
-        if (my $file = delete $value->{file}) {
-          $file = Mojo::Asset::File->new(path => $file) unless ref $file;
-          $part->asset($file);
-          $value->{filename} //= path($file->path)->basename
-            if $file->isa('Mojo::Asset::File');
-        }
-
-        # Memory
-        elsif (defined(my $content = delete $value->{content})) {
-          $part->asset(Mojo::Asset::Memory->new->add_chunk($content));
-        }
-
-        # Filename and headers
-        $filename = url_escape delete $value->{filename} // $name, '"';
-        $filename = encode $charset, $filename if $charset;
-        $headers->from_hash($value);
+    push @parts,
+      $self->_parts($charset, $name,
+      ref $values eq 'ARRAY' ? $values : [$values]);
+  }
+
+  return \@parts;
+}
+
+sub _parts {
+  my ($self, $charset, $name, $parts) = @_;
+
+  my @parts;
+  for my $value (@$parts) {
+    push @parts, my $part = Mojo::Content::Single->new;
+
+    my $filename;
+    my $headers = $part->headers;
+    if (ref $value eq 'HASH') {
+
+      # File
+      if (my $file = delete $value->{file}) {
+        $file = Mojo::Asset::File->new(path => $file) unless ref $file;
+        $part->asset($file);
+        $value->{filename} //= path($file->path)->basename
+          if $file->isa('Mojo::Asset::File');
       }
 
-      # Field
-      else {
-        $value = encode $charset, $value if $charset;
-        $part->asset(Mojo::Asset::Memory->new->add_chunk($value));
+      # Memory
+      elsif (defined(my $content = delete $value->{content})) {
+        $part->asset(Mojo::Asset::Memory->new->add_chunk($content));
       }
 
-      # Content-Disposition
-      $name = url_escape $name, '"';
-      $name = encode $charset, $name if $charset;
-      my $disposition = qq{form-data; name="$name"};
-      $disposition .= qq{; filename="$filename"} if defined $filename;
-      $headers->content_disposition($disposition);
+      # Filename and headers
+      $filename = delete $value->{filename};
+      $headers->from_hash($value);
+      next unless defined $name;
+      $filename = url_escape $filename // $name, '"';
+      $filename = encode $charset, $filename if $charset;
     }
+
+    # Field
+    else {
+      $value = encode $charset, $value if $charset;
+      $part->asset(Mojo::Asset::Memory->new->add_chunk($value));
+    }
+
+    # Content-Disposition
+    next unless defined $name;
+    $name = url_escape $name, '"';
+    $name = encode $charset, $name if $charset;
+    my $disposition = qq{form-data; name="$name"};
+    $disposition .= qq{; filename="$filename"} if defined $filename;
+    $headers->content_disposition($disposition);
   }
 
-  return \@parts;
+  return @parts;
 }
 
 sub _proxy {
@@ -470,6 +496,37 @@ C<Content-Type> header manually.
   my $headers = {'Content-Type' => 'multipart/form-data'};
   my $tx = $t->tx(POST => 'example.com' => $headers => form => {a => 'b'});
 
+The C<multipart> content generator can be used to build custom multipart
+requests and does not set a content type.
+
+  # POST request with multipart content ("foo" and "bar")
+  my $tx = $t->tx(POST => 'http://example.com' => multipart => ['foo', 'bar']);
+
+Similar to the C<form> content generator you can also pass a hash reference with
+a C<content> or C<file> value, as well as headers.
+
+  # POST request with multipart content streamed from file
+  my $tx = $t->tx(
+    POST => 'http://example.com' => multipart => [{file => '/foo.txt'}]);
+
+  # PUT request with multipart content streamed from asset
+  my $headers = {'Content-Type' => 'multipart/custom'};
+  my $asset   = Mojo::Asset::Memory->new->add_chunk('lalala');
+  my $tx      = $t->tx(
+    PUT => 'http://example.com' => $headers => multipart => [{file => $asset}]);
+
+  # POST request with multipart content and custom headers
+  my $tx = $t->tx(POST => 'http://example.com' => multipart => [
+    {
+      content        => 'foo',
+      'Content-Type' => 'text/plain'
+    },
+    {
+      content        => 'bar',
+      'Content-Type' => 'text/plain'
+    }
+  ]);
+
 =head2 upgrade
 
   my $tx = $t->upgrade(Mojo::Transaction::HTTP->new);

diff --git a/t/mojo/transactor.t b/t/mojo/transactor.t
@@ -360,6 +360,57 @@ like $tx->req->content->parts->[1]->headers->content_disposition, qr/two\.txt/,
 is $tx->req->content->parts->[1]->asset->slurp, 'works', 'right part';
 is $tx->req->content->parts->[2], undef, 'no more parts';
 
+# Multipart request (long)
+$tx = $t->tx(POST => 'http://example.com/foo' => multipart =>
+    [{content => 'just'}, {content => 'works'}]);
+is $tx->req->url->to_abs, 'http://example.com/foo', 'right URL';
+is $tx->req->method, 'POST', 'right method';
+is $tx->req->headers->content_type, undef, 'no "Content-Type" value';
+is $tx->req->content->parts->[0]->headers->content_disposition, undef,
+  'no "Content-Disposition" value';
+is $tx->req->content->parts->[0]->asset->slurp, 'just', 'right part';
+is $tx->req->content->parts->[1]->headers->content_disposition, undef,
+  'no "Content-Disposition" value';
+is $tx->req->content->parts->[1]->asset->slurp, 'works', 'right part';
+is $tx->req->content->parts->[2], undef, 'no more parts';
+
+# Multipart request (short)
+$tx
+  = $t->tx(POST => 'http://example.com/foo' => multipart => ['just', 'works']);
+is $tx->req->url->to_abs, 'http://example.com/foo', 'right URL';
+is $tx->req->method, 'POST', 'right method';
+is $tx->req->headers->content_type, undef, 'no "Content-Type" value';
+is $tx->req->content->parts->[0]->headers->content_disposition, undef,
+  'no "Content-Disposition" value';
+is $tx->req->content->parts->[0]->asset->slurp, 'just', 'right part';
+is $tx->req->content->parts->[1]->headers->content_disposition, undef,
+  'no "Content-Disposition" value';
+is $tx->req->content->parts->[1]->asset->slurp, 'works', 'right part';
+is $tx->req->content->parts->[2], undef, 'no more parts';
+
+# Multipart request with asset
+$tx = $t->tx(POST => 'http://example.com/foo' => multipart =>
+    [{file => Mojo::Asset::Memory->new->add_chunk('snowman')}]);
+is $tx->req->url->to_abs, 'http://example.com/foo', 'right URL';
+is $tx->req->method, 'POST', 'right method';
+is $tx->req->headers->content_type, undef, 'no "Content-Type" value';
+is $tx->req->content->parts->[0]->headers->content_disposition, undef,
+  'no "Content-Disposition" value';
+is $tx->req->content->parts->[0]->asset->slurp, 'snowman', 'right part';
+is $tx->req->content->parts->[1], undef, 'no more parts';
+
+# Multipart request with real file and custom header
+$tx = $t->tx(POST => 'http://example.com/foo' => multipart =>
+    [{file => __FILE__, DNT => 1}]);
+is $tx->req->url->to_abs, 'http://example.com/foo', 'right URL';
+is $tx->req->method, 'POST', 'right method';
+is $tx->req->headers->content_type, undef, 'no "Content-Type" value';
+like $tx->req->content->parts->[0]->asset->slurp, qr/mytext/, 'right part';
+ok $tx->req->content->parts->[0]->asset->is_file, 'stored in file';
+ok !$tx->req->content->parts->[0]->headers->header('file'), 'no "file" header';
+is $tx->req->content->parts->[0]->headers->dnt, 1, 'right "DNT" header';
+is $tx->req->content->parts->[1], undef, 'no more parts';
+
 # Simple endpoint
 $tx = $t->tx(GET => 'mojolicious.org');
 is(($t->endpoint($tx))[0], 'http',            'right scheme');