Commit | Line | Data |
a9df1200 |
1 | #!perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
712c90b5 |
6 | use FindBin; |
7 | use lib "$FindBin::Bin/lib"; |
8 | |
08160cca |
9 | use Test::More tests => 153; |
b1da105b |
10 | use Test::Deep; |
a9df1200 |
11 | |
12 | use Cwd; |
13 | use HTTP::Body; |
14 | use File::Spec::Functions; |
15 | use IO::File; |
712c90b5 |
16 | use PAML; |
3debb7c0 |
17 | use File::Temp qw/ tempdir /; |
a9df1200 |
18 | |
19 | my $path = catdir( getcwd(), 't', 'data', 'multipart' ); |
20 | |
4f8ae3af |
21 | for ( my $i = 1; $i <= 13; $i++ ) { |
a9df1200 |
22 | |
23 | my $test = sprintf( "%.3d", $i ); |
712c90b5 |
24 | my $headers = PAML::LoadFile( catfile( $path, "$test-headers.pml" ) ); |
25 | my $results = PAML::LoadFile( catfile( $path, "$test-results.pml" ) ); |
a9df1200 |
26 | my $content = IO::File->new( catfile( $path, "$test-content.dat" ) ); |
27 | my $body = HTTP::Body->new( $headers->{'Content-Type'}, $headers->{'Content-Length'} ); |
3debb7c0 |
28 | my $tempdir = tempdir( 'XXXXXXX', CLEANUP => 1, DIR => File::Spec->tmpdir() ); |
29 | $body->tmpdir($tempdir); |
30 | |
31 | my $regex_tempdir = quotemeta($tempdir); |
a9df1200 |
32 | |
33 | binmode $content, ':raw'; |
34 | |
35 | while ( $content->read( my $buffer, 1024 ) ) { |
36 | $body->add($buffer); |
37 | } |
38 | |
b1da105b |
39 | # Tests >= 10 use auto-cleanup |
40 | if ( $i >= 10 ) { |
41 | $body->cleanup(1); |
42 | } |
43 | |
1ced50e0 |
44 | # Save tempnames for later deletion |
45 | my @temps; |
46 | |
a9df1200 |
47 | for my $field ( keys %{ $body->upload } ) { |
48 | |
49 | my $value = $body->upload->{$field}; |
50 | |
51 | for ( ( ref($value) eq 'ARRAY' ) ? @{$value} : $value ) { |
3debb7c0 |
52 | like($_->{tempname}, qr{$regex_tempdir}, "has tmpdir $tempdir"); |
b1da105b |
53 | push @temps, $_->{tempname}; |
54 | } |
55 | |
56 | # Tell Test::Deep to ignore tempname values |
57 | if ( ref $value eq 'ARRAY' ) { |
58 | for ( @{ $results->{upload}->{$field} } ) { |
59 | $_->{tempname} = ignore(); |
60 | } |
61 | } |
62 | else { |
63 | $results->{upload}->{$field}->{tempname} = ignore(); |
a9df1200 |
64 | } |
65 | } |
08160cca |
66 | |
b1da105b |
67 | cmp_deeply( $body->body, $results->{body}, "$test MultiPart body" ); |
68 | cmp_deeply( $body->param, $results->{param}, "$test MultiPart param" ); |
08160cca |
69 | cmp_deeply( $body->param_order, $results->{param_order} ? $results->{param_order} : [], "$test MultiPart param_order" ); |
b1da105b |
70 | cmp_deeply( $body->upload, $results->{upload}, "$test MultiPart upload" ) |
4f8ae3af |
71 | if $results->{upload}; |
a9df1200 |
72 | cmp_ok( $body->state, 'eq', 'done', "$test MultiPart state" ); |
0a66fd23 |
73 | cmp_ok( $body->length, '==', $body->content_length, "$test MultiPart length" ); |
1ced50e0 |
74 | |
b1da105b |
75 | if ( $i < 10 ) { |
76 | # Clean up temp files created |
77 | unlink map { $_ } grep { -e $_ } @temps; |
78 | } |
79 | |
80 | undef $body; |
81 | |
82 | # Ensure temp files were deleted |
83 | for my $temp ( @temps ) { |
84 | ok( !-e $temp, "Temp file $temp was deleted" ); |
85 | } |
08160cca |
86 | |
b1da105b |
87 | } |