-
Notifications
You must be signed in to change notification settings - Fork 214
/
many_upload.t
76 lines (61 loc) · 1.85 KB
/
many_upload.t
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
use strict;
use warnings;
use Test::More;
use Plack::Request;
my $content = qq{------BOUNDARY
Content-Disposition: form-data; name="test_upload_file"; filename="yappo.txt"
Content-Type: text/plain
SHOGUN
------BOUNDARY
Content-Disposition: form-data; name="test_upload_file"; filename="yappo2.txt"
Content-Type: text/plain
SHOGUN2
------BOUNDARY
Content-Disposition: form-data; name="test_upload_file3"; filename="yappo3.txt"
Content-Type: text/plain
SHOGUN3
------BOUNDARY
Content-Disposition: form-data; name="test_upload_file4"; filename="yappo4.txt"
Content-Type: text/plain
SHOGUN4
------BOUNDARY
Content-Disposition: form-data; name="test_upload_file4"; filename="yappo5.txt"
Content-Type: text/plain
SHOGUN4
------BOUNDARY
Content-Disposition: form-data; name="test_upload_file6"; filename="yappo6.txt"
Content-Type: text/plain
SHOGUN6
------BOUNDARY--
};
$content =~ s/\r\n/\n/g;
$content =~ s/\n/\r\n/g;
{
open my $in, '<', \$content;
my $req = Plack::Request->new({
'psgi.input' => $in,
CONTENT_LENGTH => length($content),
CONTENT_TYPE => 'multipart/form-data; boundary=----BOUNDARY',
REQUEST_METHOD => 'POST',
SCRIPT_NAME => '/',
SERVER_PORT => 80,
});
my @undef = $req->upload('undef');
is @undef, 0;
my $undef = $req->upload('undef');
is $undef, undef;
my @uploads = $req->upload('test_upload_file');
like slurp($uploads[0]), qr|^SHOGUN|;
like slurp($uploads[1]), qr|^SHOGUN|;
is slurp($req->upload('test_upload_file4')), 'SHOGUN4';
my $test_upload_file3 = $req->upload('test_upload_file3');
is slurp($test_upload_file3), 'SHOGUN3';
my @test_upload_file6 = $req->upload('test_upload_file6');
is slurp($test_upload_file6[0]), 'SHOGUN6';
}
done_testing;
sub slurp {
my $up = shift;
open my $fh, "<", $up->path or die;
join '', <$fh>;
}