line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/perl |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
package HTTP::Engine::Role::RequestBuilder::ReadBody; |
4
|
1
|
|
|
1
|
|
411
|
use Any::Moose '::Role'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
4
|
|
5
|
1
|
|
|
1
|
|
320
|
use Carp (); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
241
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
requires "_handle_read_chunk"; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
sub _read_init { |
10
|
|
|
|
|
|
|
my ( $self, $read_state ) = @_; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
foreach my $key qw(input_handle content_length) { |
13
|
|
|
|
|
|
|
Carp::confess "read initialization must set $key" |
14
|
|
|
|
|
|
|
unless defined $read_state->{$key}; |
15
|
|
|
|
|
|
|
} |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
return $read_state; |
18
|
|
|
|
|
|
|
} |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub _read_start { |
21
|
|
|
|
|
|
|
my ( $self, $state ) = @_; |
22
|
|
|
|
|
|
|
$state->{started} = 1; |
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub _read_to_end { |
26
|
|
|
|
|
|
|
my ( $self, $state, @args ) = @_; |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
my $content_length = $state->{content_length}; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
if ($content_length > 0) { |
31
|
|
|
|
|
|
|
$self->_read_all($state, @args); |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# paranoia against wrong Content-Length header |
34
|
|
|
|
|
|
|
my $diff = $state->{content_length} - $state->{read_position}; |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
if ($diff) { |
37
|
|
|
|
|
|
|
if ( $diff > 0) { |
38
|
|
|
|
|
|
|
die "Wrong Content-Length value: " . $content_length; |
39
|
|
|
|
|
|
|
} else { |
40
|
|
|
|
|
|
|
die "Premature end of request body, $diff bytes remaining"; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
sub _read_all { |
47
|
|
|
|
|
|
|
my ( $self, $state ) = @_; |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
while (my $buffer = $self->_read($state) ) { |
50
|
|
|
|
|
|
|
$self->_handle_read_chunk($state, $buffer); |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
sub _read { |
55
|
|
|
|
|
|
|
my ($self, $state) = @_; |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
$self->_read_start($state) unless $state->{started}; |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
my ( $length, $pos ) = @{$state}{qw(content_length read_position)}; |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
my $remaining = $length - $pos; |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
my $maxlength = $self->chunk_size; |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
# Are we done reading? |
66
|
|
|
|
|
|
|
if ($remaining <= 0) { |
67
|
|
|
|
|
|
|
return; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
my $readlen = ($remaining > $maxlength) ? $maxlength : $remaining; |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
my $rc = $self->_read_chunk($state, my $buffer, $readlen); |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
if (defined $rc) { |
75
|
|
|
|
|
|
|
$state->{read_position} += $rc; |
76
|
|
|
|
|
|
|
return $buffer; |
77
|
|
|
|
|
|
|
} else { |
78
|
|
|
|
|
|
|
die "Unknown error reading input: $!"; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sub _read_chunk { |
83
|
|
|
|
|
|
|
my ( $self, $state ) = ( shift, shift ); |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
my $handle = $state->{input_handle}; |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
$self->_io_read( $handle, @_ ); |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
sub _io_read { |
91
|
|
|
|
|
|
|
my ( $self, $handle ) = ( shift, shift ); |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
Carp::confess "no handle" unless defined $handle; |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
return $handle->read(@_); |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
1; |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
__END__ |