line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/perl |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
package HTTP::Engine::Role::RequestBuilder::HTTPBody; |
4
|
56
|
|
|
56
|
|
36490
|
use Any::Moose '::Role'; |
|
56
|
|
|
|
|
127
|
|
|
56
|
|
|
|
|
398
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
with qw( |
7
|
|
|
|
|
|
|
HTTP::Engine::Role::RequestBuilder::ReadBody |
8
|
|
|
|
|
|
|
); |
9
|
56
|
|
|
56
|
|
189857
|
use HTTP::Body; |
|
56
|
|
|
|
|
2301619
|
|
|
56
|
|
|
|
|
1879
|
|
10
|
56
|
|
|
56
|
|
33793
|
use HTTP::Engine::Request::Upload; |
|
56
|
|
|
|
|
167
|
|
|
56
|
|
|
|
|
37176
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
# tempolary file path for upload file. |
13
|
|
|
|
|
|
|
has upload_tmp => ( |
14
|
|
|
|
|
|
|
is => 'rw', |
15
|
|
|
|
|
|
|
); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
has chunk_size => ( |
18
|
|
|
|
|
|
|
is => 'ro', |
19
|
|
|
|
|
|
|
isa => 'Int', |
20
|
|
|
|
|
|
|
default => 4096, |
21
|
|
|
|
|
|
|
); |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
sub _build_http_body { |
24
|
14
|
|
|
14
|
|
31
|
my ( $self, $req ) = @_; |
25
|
|
|
|
|
|
|
|
26
|
14
|
|
|
|
|
101
|
$self->_read_to_end($req->_read_state, $req); |
27
|
|
|
|
|
|
|
|
28
|
14
|
|
|
|
|
221
|
return delete $req->_read_state->{data}{http_body}; |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
sub _build_raw_body { |
32
|
5
|
|
|
5
|
|
11
|
my ( $self, $req ) = @_; |
33
|
|
|
|
|
|
|
|
34
|
5
|
|
|
|
|
43
|
$self->_read_to_end($req->_read_state, $req); |
35
|
|
|
|
|
|
|
|
36
|
4
|
|
|
|
|
67
|
return delete $req->_read_state->{data}{raw_body}; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub _build_read_state { |
41
|
19
|
|
|
19
|
|
47
|
my($self, $req) = @_; |
42
|
|
|
|
|
|
|
|
43
|
19
|
|
100
|
|
|
111
|
my $length = $req->content_length || 0; |
44
|
19
|
|
100
|
|
|
565
|
my $type = $req->header('Content-Type') || ''; |
45
|
|
|
|
|
|
|
|
46
|
19
|
|
|
|
|
827
|
my $body = HTTP::Body->new($type, $length); |
47
|
19
|
100
|
|
|
|
2045
|
if (my $upload_tmp = $req->{builder_options}->{upload_tmp}) { |
|
|
100
|
|
|
|
|
|
48
|
2
|
100
|
|
|
|
23
|
$body->tmpdir(ref($upload_tmp) eq 'CODE' ? $upload_tmp->() : $upload_tmp); |
49
|
|
|
|
|
|
|
} elsif ($self->upload_tmp) { |
50
|
4
|
|
|
|
|
59
|
$body->tmpdir($self->upload_tmp); |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
19
|
|
|
|
|
884
|
return $self->_read_init({ |
54
|
|
|
|
|
|
|
input_handle => $req->_connection->{input_handle}, |
55
|
|
|
|
|
|
|
content_length => $length, |
56
|
|
|
|
|
|
|
read_position => 0, |
57
|
|
|
|
|
|
|
data => { |
58
|
|
|
|
|
|
|
raw_body => "", |
59
|
|
|
|
|
|
|
http_body => $body, |
60
|
|
|
|
|
|
|
}, |
61
|
|
|
|
|
|
|
}); |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub _handle_read_chunk { |
65
|
75
|
|
|
75
|
|
126
|
my ( $self, $state, $chunk, $req ) = @_; |
66
|
|
|
|
|
|
|
|
67
|
75
|
|
|
|
|
118
|
my $d = $state->{data}; |
68
|
|
|
|
|
|
|
|
69
|
75
|
100
|
|
|
|
260
|
$d->{raw_body} .= $chunk unless $req->{builder_options}->{disable_raw_body}; |
70
|
75
|
|
|
|
|
276
|
$d->{http_body}->add($chunk); |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
sub _prepare_uploads { |
74
|
8
|
|
|
8
|
|
17
|
my($self, $req) = @_; |
75
|
|
|
|
|
|
|
|
76
|
8
|
|
|
|
|
70
|
my $uploads = $req->http_body->upload; |
77
|
8
|
|
|
|
|
55
|
my %uploads; |
78
|
8
|
|
|
|
|
23
|
for my $name (keys %{ $uploads }) { |
|
8
|
|
|
|
|
34
|
|
79
|
10
|
|
|
|
|
23
|
my $files = $uploads->{$name}; |
80
|
10
|
100
|
|
|
|
40
|
$files = ref $files eq 'ARRAY' ? $files : [$files]; |
81
|
|
|
|
|
|
|
|
82
|
10
|
|
|
|
|
17
|
my @uploads; |
83
|
10
|
|
|
|
|
17
|
for my $upload (@{ $files }) { |
|
10
|
|
|
|
|
18
|
|
84
|
12
|
|
|
|
|
17
|
my $headers = HTTP::Headers::Fast->new( %{ $upload->{headers} } ); |
|
12
|
|
|
|
|
88
|
|
85
|
12
|
|
|
|
|
843
|
push( |
86
|
|
|
|
|
|
|
@uploads, |
87
|
|
|
|
|
|
|
HTTP::Engine::Request::Upload->new( |
88
|
|
|
|
|
|
|
headers => $headers, |
89
|
|
|
|
|
|
|
tempname => $upload->{tempname}, |
90
|
|
|
|
|
|
|
size => $upload->{size}, |
91
|
|
|
|
|
|
|
filename => $upload->{filename}, |
92
|
|
|
|
|
|
|
) |
93
|
|
|
|
|
|
|
); |
94
|
|
|
|
|
|
|
} |
95
|
10
|
100
|
|
|
|
372
|
$uploads{$name} = @uploads > 1 ? \@uploads : $uploads[0]; |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
# support access to the filename as a normal param |
98
|
10
|
|
|
|
|
22
|
my @filenames = map { $_->{filename} } @uploads; |
|
12
|
|
|
|
|
53
|
|
99
|
10
|
100
|
|
|
|
88
|
$req->parameters->{$name} = @filenames > 1 ? \@filenames : $filenames[0]; |
100
|
|
|
|
|
|
|
} |
101
|
8
|
|
|
|
|
100
|
return \%uploads; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
1; |
105
|
|
|
|
|
|
|
|