Skip to content

Commit

Permalink
fixed multiple small bugs in Mojo::UserAgent::Transactor->form
Browse files Browse the repository at this point in the history
  • Loading branch information
@kraih
kraih committed Apr 3, 2012
1 parent e56eb05 commit c6770cc
Show file tree
Hide file tree
Showing 4 changed files with 113 additions and 86 deletions.
1 change: 1 addition & 0 deletions Changes
View file
Expand Up @@ -3,6 +3,7 @@ This file documents the revision history for Perl extension Mojolicious.
2.74 2012-04-04
- Improved documentation.
- Improved tests.
- Fixed multiple small bugs in Mojo::UserAgent::Transactor->form.

2.73 2012-04-03
- Improved documentation.
Expand Down
129 changes: 57 additions & 72 deletions lib/Mojo/UserAgent/Transactor.pm
View file
@@ -1,6 +1,7 @@
package Mojo::UserAgent::Transactor;
use Mojo::Base -base;

use File::Spec::Functions 'splitpath';
use Mojo::Asset::File;
use Mojo::Asset::Memory;
use Mojo::Content::MultiPart;
Expand All @@ -27,103 +28,47 @@ sub form {
$params->charset($encoding) if defined $encoding;
my $multipart;
for my $name (sort keys %$form) {
my $value = $form->{$name};

# Array
if (ref $form->{$name} eq 'ARRAY') {
$params->append($name, $_) for @{$form->{$name}};
}
if (ref $value eq 'ARRAY') { $params->append($name, $_) for @$value }

# Hash
elsif (ref $form->{$name} eq 'HASH') {
my $hash = $form->{$name};
elsif (ref $value eq 'HASH') {

# Enforce "multipart/form-data"
$multipart = 1;

# File
if (my $file = $hash->{file}) {

# Upgrade
$file = $hash->{file} = Mojo::Asset::File->new(path => $file)
unless ref $file;

# Filename
$hash->{filename} ||= $file->path if $file->can('path');
if (my $file = $value->{file}) {
$value->{file} = Mojo::Asset::File->new(path => $file) if !ref $file;
$value->{filename} ||= (splitpath($value->{file}->path))[2]
if $value->{file}->isa('Mojo::Asset::File');
}

# Memory
elsif (defined(my $content = delete $hash->{content})) {
$hash->{file} = Mojo::Asset::Memory->new->add_chunk($content);
elsif (defined(my $content = delete $value->{content})) {
$value->{file} = Mojo::Asset::Memory->new->add_chunk($content);
}

$hash->{'Content-Type'} ||= 'application/octet-stream';
push @{$params->params}, $name, $hash;
push @{$params->params}, $name, $value;
}

# Single value
else { $params->append($name, $form->{$name}) }
else { $params->append($name, $value) }
}

# New transaction
my $tx = $self->tx(POST => $url);
my $req = $tx->req;
my $headers = $req->headers;
$headers->from_hash(ref $_[0] eq 'HASH' ? $_[0] : {@_});
my $headers = $req->headers->from_hash(ref $_[0] eq 'HASH' ? $_[0] : {@_});

# Multipart
$headers->content_type('multipart/form-data') if $multipart;
my $type = $headers->content_type || '';
if ($type eq 'multipart/form-data') {
my $form = $params->to_hash;

# Parts
my @parts;
for my $name (sort keys %$form) {
my $part = Mojo::Content::Single->new;
my $h = $part->headers;
my $f = $form->{$name};

# File
my $filename;
if (ref $f eq 'HASH') {
$filename = delete $f->{filename} || $name;
$filename = encode $encoding, $filename if $encoding;
$filename = url_escape $filename, $Mojo::URL::UNRESERVED;
$part->asset(delete $f->{file});
$h->from_hash($f);
push @parts, $part;
}

# Fields
else {
my $type = 'text/plain';
$type .= qq/;charset=$encoding/ if $encoding;
$h->content_type($type);

# Values
for my $value (ref $f ? @$f : ($f)) {
$part = Mojo::Content::Single->new(headers => $h);
$value = encode $encoding, $value if $encoding;
$part->asset->add_chunk($value);
push @parts, $part;
}
}

# Content-Disposition
$name = encode $encoding, $name if $encoding;
$name = url_escape $name, $Mojo::URL::UNRESERVED;
my $disposition = qq/form-data; name="$name"/;
$disposition .= qq/; filename="$filename"/ if $filename;
$h->content_disposition($disposition);
}

# Multipart content
my $content = Mojo::Content::MultiPart->new;
$headers->content_type('multipart/form-data');
$content->headers($headers)->parts(\@parts);

# Add content to transaction
$req->content($content);
if (($headers->content_type || '') eq 'multipart/form-data') {
my $parts = $self->_multipart($params->to_hash, $encoding);
$req->content(
Mojo::Content::MultiPart->new(headers => $headers, parts => $parts));
}

# Urlencoded
Expand Down Expand Up @@ -252,6 +197,46 @@ sub websocket {
return wantarray ? ($tx, $cb) : $tx;
}

sub _multipart {
my ($self, $form, $encoding) = @_;

# Parts
my @parts;
for my $name (sort keys %$form) {
my $values = $form->{$name};
my $part = Mojo::Content::Single->new;

# File
my $filename;
my $headers = $part->headers;
if (ref $values eq 'HASH') {
$filename = delete $values->{filename} || $name;
$filename = encode $encoding, $filename if $encoding;
$filename = url_escape $filename, $Mojo::URL::UNRESERVED;
push @parts, $part->asset(delete $values->{file});
$headers->from_hash($values);
}

# Fields
else {
for my $value (ref $values ? @$values : ($values)) {
push @parts, $part = Mojo::Content::Single->new(headers => $headers);
$value = encode $encoding, $value if $encoding;
$part->asset->add_chunk($value);
}
}

# Content-Disposition
$name = encode $encoding, $name if $encoding;
$name = url_escape $name, $Mojo::URL::UNRESERVED;
my $disposition = qq/form-data; name="$name"/;
$disposition .= qq/; filename="$filename"/ if $filename;
$headers->content_disposition($disposition);
}

return \@parts;
}

1;
__END__
Expand Down
51 changes: 47 additions & 4 deletions t/mojo/transactor.t
View file
@@ -1,6 +1,6 @@
use Mojo::Base -strict;

use Test::More tests => 178;
use Test::More tests => 197;

# "Once the government approves something, it's no longer immoral!"
use File::Spec::Functions 'catdir';
Expand Down Expand Up @@ -69,17 +69,60 @@ is $tx->req->headers->content_type, 'application/x-www-form-urlencoded',
is $tx->req->headers->accept, '*/*', 'right "Accept" value';
is $tx->req->body, 'test=123', 'right content';

# Multipart form with real file
# Multipart form
$tx =
$t->form('http://kraih.com/foo' => {test => 123} =>
{'Content-Type' => 'multipart/form-data'});
is $tx->req->url->to_abs, 'http://kraih.com/foo', 'right URL';
is $tx->req->method, 'POST', 'right method';
is $tx->req->headers->content_type, 'multipart/form-data',
'right "Content-Type" value';
like $tx->req->content->parts->[0]->headers->content_disposition,
qr/"test"/,
'right "Content-Disposition" value';
is $tx->req->content->parts->[0]->asset->slurp, 123, 'right part';
is $tx->req->content->parts->[1], undef, 'no more parts';

# Multipart form with multiple values
$tx =
$t->form('http://kraih.com/foo' => {test => [1, 2, 3]} =>
{'Content-Type' => 'multipart/form-data'});
is $tx->req->url->to_abs, 'http://kraih.com/foo', 'right URL';
is $tx->req->method, 'POST', 'right method';
is $tx->req->headers->content_type, 'multipart/form-data',
'right "Content-Type" value';
like $tx->req->content->parts->[0]->headers->content_disposition,
qr/"test"/,
'right "Content-Disposition" value';
is $tx->req->content->parts->[0]->asset->slurp, 1, 'right part';
like $tx->req->content->parts->[1]->headers->content_disposition,
qr/"test"/,
'right "Content-Disposition" value';
is $tx->req->content->parts->[1]->asset->slurp, 2, 'right part';
like $tx->req->content->parts->[2]->headers->content_disposition,
qr/"test"/,
'right "Content-Disposition" value';
is $tx->req->content->parts->[2]->asset->slurp, 3, 'right part';
is $tx->req->content->parts->[3], undef, 'no more parts';

# Multipart form with real file and custom header
$tx =
$t->form('http://kraih.com/foo',
{mytext => {file => catdir($FindBin::Bin, 'transactor.t')}});
{mytext => {file => catdir($FindBin::Bin, 'transactor.t'), DNT => 1}});
is $tx->req->url->to_abs, 'http://kraih.com/foo', 'right URL';
is $tx->req->method, 'POST', 'right method';
is $tx->req->headers->content_type, 'multipart/form-data',
'right "Content-Type" value';
like $tx->req->content->parts->[0]->headers->content_disposition, qr/mytext/,
like $tx->req->content->parts->[0]->headers->content_disposition,
qr/"mytext"/,
'right "Content-Disposition" value';
like $tx->req->content->parts->[0]->headers->content_disposition,
qr/"transactor.t"/,
'right "Content-Disposition" value';
like $tx->req->content->parts->[0]->asset->slurp, qr/mytext/, 'right part';
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';

# Multipart form with in-memory content
Expand Down
18 changes: 8 additions & 10 deletions t/mojolicious/upload_lite_app.t
View file
Expand Up @@ -16,14 +16,14 @@ use Test::Mojo;

# POST /upload
post '/upload' => sub {
my $self = shift;
my $file = $self->param('file');
my $h = $file->headers;
my $self = shift;
my $file = $self->param('file');
my $headers = $file->headers;
$self->render_text($file->filename
. $file->asset->slurp
. $self->param('test')
. $h->content_type
. ($h->header('X-X') || '')
. ($headers->content_type || '')
. ($headers->header('X-X') || '')
. join(',', $self->param));
};

Expand Down Expand Up @@ -55,17 +55,15 @@ my $t = Test::Mojo->new;
my $file = Mojo::Asset::File->new->add_chunk('lalala');
$t->post_form_ok('/upload',
{file => {file => $file, filename => 'x'}, test => 'tset'})->status_is(200)
->content_is('xlalalatsetapplication/octet-streamfile,test');
->content_is('xlalalatsetfile,test');

# POST /upload (path)
$t->post_form_ok('/upload', {file => {file => $file->path}, test => 'foo'})
->status_is(200)
->content_like(qr#lalalafooapplication/octet-streamfile,test$#);
->status_is(200)->content_like(qr#lalalafoofile,test$#);

# POST /upload (memory)
$t->post_form_ok('/upload', {file => {content => 'alalal'}, test => 'tset'})
->status_is(200)
->content_is('filealalaltsetapplication/octet-streamfile,test');
->status_is(200)->content_is('filealalaltsetfile,test');

# POST /upload (memory with headers)
my $hash = {content => 'alalal', 'Content-Type' => 'foo/bar', 'X-X' => 'Y'};
Expand Down

0 comments on commit c6770cc

Please sign in to comment.