File | /usr/local/lib/perl5/site_perl/5.10.1/Net/HTTP/Methods.pm |
Statements Executed | 1099 |
Statement Execution Time | 5.05ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
3 | 1 | 1 | 1.21ms | 37.6ms | gunzip_ok | Net::HTTP::Methods::
26 | 4 | 1 | 472µs | 175ms | my_readline | Net::HTTP::Methods::
3 | 1 | 1 | 297µs | 175ms | read_response_headers | Net::HTTP::Methods::
7 | 1 | 1 | 255µs | 646µs | read_entity_body | Net::HTTP::Methods::
3 | 1 | 1 | 240µs | 37.9ms | format_request | Net::HTTP::Methods::
5 | 2 | 1 | 229µs | 544µs | _read_header_lines | Net::HTTP::Methods::
2 | 1 | 1 | 192µs | 124ms | http_configure | Net::HTTP::Methods::
41 | 7 | 2 | 135µs | 135µs | CORE:subst (opcode) | Net::HTTP::Methods::
21 | 9 | 2 | 102µs | 102µs | __ANON__[:104] | Net::HTTP::Methods::
28 | 6 | 2 | 86µs | 86µs | CORE:match (opcode) | Net::HTTP::Methods::
5 | 2 | 1 | 50µs | 115µs | my_read | Net::HTTP::Methods::
3 | 1 | 1 | 23µs | 28µs | __ANON__[:19] | Net::HTTP::Methods::
2 | 1 | 1 | 18µs | 18µs | http_version | Net::HTTP::Methods::
1 | 1 | 1 | 14µs | 17µs | BEGIN@5 | Net::HTTP::Methods::
3 | 1 | 1 | 14µs | 14µs | get_trailers | Net::HTTP::Methods::
1 | 1 | 1 | 8µs | 21µs | BEGIN@98 | Net::HTTP::Methods::
1 | 1 | 1 | 7µs | 7µs | BEGIN@555 | Net::HTTP::Methods::
1 | 1 | 1 | 7µs | 27µs | BEGIN@6 | Net::HTTP::Methods::
2 | 1 | 1 | 4µs | 4µs | http_default_port | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | __ANON__[:23] | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | __ANON__[:424] | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | __ANON__[:437] | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | __ANON__[:440] | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | _rbuf | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | _rbuf_length | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | format_chunk | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | format_chunk_eof | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | inflate_ok | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | new | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | write_chunk | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | write_chunk_eof | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | write_request | Net::HTTP::Methods::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Net::HTTP::Methods; | ||||
2 | |||||
3 | 1 | 154µs | require 5.005; # 4-arg substr | ||
4 | |||||
5 | 3 | 24µs | 2 | 21µs | # spent 17µs (14+3) within Net::HTTP::Methods::BEGIN@5 which was called
# once (14µs+3µs) by LWP::Protocol::implementor at line 5 # spent 17µs making 1 call to Net::HTTP::Methods::BEGIN@5
# spent 3µs making 1 call to strict::import |
6 | 3 | 386µs | 2 | 47µs | # spent 27µs (7+20) within Net::HTTP::Methods::BEGIN@6 which was called
# once (7µs+20µs) by LWP::Protocol::implementor at line 6 # spent 27µs making 1 call to Net::HTTP::Methods::BEGIN@6
# spent 20µs making 1 call to vars::import |
7 | |||||
8 | 1 | 1µs | $VERSION = "5.834"; | ||
9 | |||||
10 | 1 | 1µs | my $CRLF = "\015\012"; # "\r\n" is not portable | ||
11 | |||||
12 | *_bytes = defined(&utf8::downgrade) ? | ||||
13 | # spent 28µs (23+5) within Net::HTTP::Methods::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/Net/HTTP/Methods.pm:19] which was called 3 times, avg 9µs/call:
# 3 times (23µs+5µs) by Net::HTTP::Methods::format_request at line 190, avg 9µs/call | ||||
14 | 6 | 29µs | 3 | 5µs | unless (utf8::downgrade($_[0], 1)) { # spent 5µs making 3 calls to utf8::downgrade, avg 2µs/call |
15 | require Carp; | ||||
16 | Carp::croak("Wide character in HTTP request (bytes required)"); | ||||
17 | } | ||||
18 | return $_[0]; | ||||
19 | } | ||||
20 | : | ||||
21 | sub { | ||||
22 | return $_[0]; | ||||
23 | 1 | 10µs | }; | ||
24 | |||||
25 | |||||
26 | sub new { | ||||
27 | my $class = shift; | ||||
28 | unshift(@_, "Host") if @_ == 1; | ||||
29 | my %cnf = @_; | ||||
30 | require Symbol; | ||||
31 | my $self = bless Symbol::gensym(), $class; | ||||
32 | return $self->http_configure(\%cnf); | ||||
33 | } | ||||
34 | |||||
35 | # spent 124ms (192µs+124) within Net::HTTP::Methods::http_configure which was called 2 times, avg 62.1ms/call:
# 2 times (192µs+124ms) by Net::HTTP::configure at line 24 of Net/HTTP.pm, avg 62.1ms/call | ||||
36 | 62 | 147µs | my($self, $cnf) = @_; | ||
37 | |||||
38 | die "Listen option not allowed" if $cnf->{Listen}; | ||||
39 | my $explict_host = (exists $cnf->{Host}); | ||||
40 | my $host = delete $cnf->{Host}; | ||||
41 | my $peer = $cnf->{PeerAddr} || $cnf->{PeerHost}; | ||||
42 | if (!$peer) { | ||||
43 | die "No Host option provided" unless $host; | ||||
44 | $cnf->{PeerAddr} = $peer = $host; | ||||
45 | } | ||||
46 | |||||
47 | if ($peer =~ s,:(\d+)$,,) { # spent 3µs making 2 calls to Net::HTTP::Methods::CORE:subst, avg 2µs/call | ||||
48 | $cnf->{PeerPort} = int($1); # always override | ||||
49 | } | ||||
50 | if (!$cnf->{PeerPort}) { | ||||
51 | $cnf->{PeerPort} = $self->http_default_port; | ||||
52 | } | ||||
53 | |||||
54 | 4 | 7µs | if (!$explict_host) { | ||
55 | $host = $peer; | ||||
56 | $host =~ s/:.*//; # spent 1µs making 2 calls to Net::HTTP::Methods::CORE:subst, avg 600ns/call | ||||
57 | } | ||||
58 | 4 | 13µs | 2 | 1µs | if ($host && $host !~ /:/) { # spent 1µs making 2 calls to Net::HTTP::Methods::CORE:match, avg 700ns/call |
59 | my $p = $cnf->{PeerPort}; | ||||
60 | $host .= ":$p" if $p != $self->http_default_port; # spent 4µs making 2 calls to Net::HTTP::Methods::http_default_port, avg 2µs/call | ||||
61 | } | ||||
62 | |||||
63 | $cnf->{Proto} = 'tcp'; | ||||
64 | |||||
65 | my $keep_alive = delete $cnf->{KeepAlive}; | ||||
66 | my $http_version = delete $cnf->{HTTPVersion}; | ||||
67 | $http_version = "1.1" unless defined $http_version; | ||||
68 | my $peer_http_version = delete $cnf->{PeerHTTPVersion}; | ||||
69 | $peer_http_version = "1.0" unless defined $peer_http_version; | ||||
70 | my $send_te = delete $cnf->{SendTE}; | ||||
71 | my $max_line_length = delete $cnf->{MaxLineLength}; | ||||
72 | $max_line_length = 8*1024 unless defined $max_line_length; | ||||
73 | my $max_header_lines = delete $cnf->{MaxHeaderLines}; | ||||
74 | $max_header_lines = 128 unless defined $max_header_lines; | ||||
75 | |||||
76 | return undef unless $self->http_connect($cnf); # spent 124ms making 2 calls to Net::HTTP::http_connect, avg 61.9ms/call | ||||
77 | |||||
78 | $self->host($host); # spent 23µs making 2 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:104], avg 12µs/call | ||||
79 | $self->keep_alive($keep_alive); # spent 10µs making 2 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:104], avg 5µs/call | ||||
80 | $self->send_te($send_te); # spent 7µs making 2 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:104], avg 4µs/call | ||||
81 | $self->http_version($http_version); # spent 18µs making 2 calls to Net::HTTP::Methods::http_version, avg 9µs/call | ||||
82 | $self->peer_http_version($peer_http_version); # spent 8µs making 2 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:104], avg 4µs/call | ||||
83 | $self->max_line_length($max_line_length); # spent 6µs making 2 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:104], avg 3µs/call | ||||
84 | $self->max_header_lines($max_header_lines); # spent 6µs making 2 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:104], avg 3µs/call | ||||
85 | |||||
86 | ${*$self}{'http_buf'} = ""; | ||||
87 | |||||
88 | return $self; | ||||
89 | } | ||||
90 | |||||
91 | # spent 4µs within Net::HTTP::Methods::http_default_port which was called 2 times, avg 2µs/call:
# 2 times (4µs+0s) by Net::HTTP::Methods::http_configure at line 60, avg 2µs/call | ||||
92 | 2 | 7µs | 80; | ||
93 | } | ||||
94 | |||||
95 | # set up property accessors | ||||
96 | 1 | 4µs | for my $method (qw(host keep_alive send_te max_line_length max_header_lines peer_http_version)) { | ||
97 | 12 | 53µs | my $prop_name = "http_" . $method; | ||
98 | 3 | 2.19ms | 2 | 35µs | # spent 21µs (8+13) within Net::HTTP::Methods::BEGIN@98 which was called
# once (8µs+13µs) by LWP::Protocol::implementor at line 98 # spent 21µs making 1 call to Net::HTTP::Methods::BEGIN@98
# spent 13µs making 1 call to strict::unimport |
99 | # spent 102µs within Net::HTTP::Methods::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/Net/HTTP/Methods.pm:104] which was called 21 times, avg 5µs/call:
# 3 times (18µs+0s) by LWP::Protocol::http::request at line 358 of LWP/Protocol/http.pm, avg 6µs/call
# 3 times (14µs+0s) by Net::HTTP::Methods::format_request at line 173, avg 4µs/call
# 3 times (10µs+0s) by Net::HTTP::Methods::format_request at line 162, avg 3µs/call
# 2 times (23µs+0s) by Net::HTTP::Methods::http_configure at line 78, avg 12µs/call
# 2 times (10µs+0s) by Net::HTTP::Methods::http_configure at line 79, avg 5µs/call
# 2 times (8µs+0s) by Net::HTTP::Methods::http_configure at line 82, avg 4µs/call
# 2 times (7µs+0s) by Net::HTTP::Methods::http_configure at line 80, avg 4µs/call
# 2 times (6µs+0s) by Net::HTTP::Methods::http_configure at line 84, avg 3µs/call
# 2 times (6µs+0s) by Net::HTTP::Methods::http_configure at line 83, avg 3µs/call | ||||
100 | 84 | 123µs | my $self = shift; | ||
101 | my $old = ${*$self}{$prop_name}; | ||||
102 | ${*$self}{$prop_name} = shift if @_; | ||||
103 | return $old; | ||||
104 | }; | ||||
105 | } | ||||
106 | |||||
107 | # we want this one to be a bit smarter | ||||
108 | # spent 18µs within Net::HTTP::Methods::http_version which was called 2 times, avg 9µs/call:
# 2 times (18µs+0s) by Net::HTTP::Methods::http_configure at line 81, avg 9µs/call | ||||
109 | 8 | 10µs | my $self = shift; | ||
110 | my $old = ${*$self}{'http_version'}; | ||||
111 | 8 | 8µs | if (@_) { | ||
112 | my $v = shift; | ||||
113 | $v = "1.0" if $v eq "1"; # float | ||||
114 | unless ($v eq "1.0" or $v eq "1.1") { | ||||
115 | require Carp; | ||||
116 | Carp::croak("Unsupported HTTP version '$v'"); | ||||
117 | } | ||||
118 | ${*$self}{'http_version'} = $v; | ||||
119 | } | ||||
120 | $old; | ||||
121 | } | ||||
122 | |||||
123 | # spent 37.9ms (240µs+37.7) within Net::HTTP::Methods::format_request which was called 3 times, avg 12.6ms/call:
# 3 times (240µs+37.7ms) by LWP::Protocol::http::request at line 206 of LWP/Protocol/http.pm, avg 12.6ms/call | ||||
124 | 57 | 115µs | my $self = shift; | ||
125 | my $method = shift; | ||||
126 | my $uri = shift; | ||||
127 | |||||
128 | my $content = (@_ % 2) ? pop : ""; | ||||
129 | |||||
130 | for ($method, $uri) { | ||||
131 | 12 | 34µs | require Carp; | ||
132 | Carp::croak("Bad method or uri") if /\s/ || !length; # spent 5µs making 6 calls to Net::HTTP::Methods::CORE:match, avg 800ns/call | ||||
133 | } | ||||
134 | |||||
135 | push(@{${*$self}{'http_request_method'}}, $method); | ||||
136 | my $ver = ${*$self}{'http_version'}; | ||||
137 | my $peer_ver = ${*$self}{'http_peer_http_version'} || "1.0"; | ||||
138 | |||||
139 | my @h; | ||||
140 | my @connection; | ||||
141 | my %given = (host => 0, "content-length" => 0, "te" => 0); | ||||
142 | while (@_) { | ||||
143 | 60 | 41µs | my($k, $v) = splice(@_, 0, 2); | ||
144 | my $lc_k = lc($k); | ||||
145 | if ($lc_k eq "connection") { | ||||
146 | $v =~ s/^\s+//; | ||||
147 | $v =~ s/\s+$//; | ||||
148 | push(@connection, split(/\s*,\s*/, $v)); | ||||
149 | next; | ||||
150 | } | ||||
151 | if (exists $given{$lc_k}) { | ||||
152 | $given{$lc_k}++; | ||||
153 | } | ||||
154 | push(@h, "$k: $v"); | ||||
155 | } | ||||
156 | |||||
157 | if (length($content) && !$given{'content-length'}) { | ||||
158 | push(@h, "Content-Length: " . length($content)); | ||||
159 | } | ||||
160 | |||||
161 | my @h2; | ||||
162 | 6 | 6µs | 6 | 37.6ms | if ($given{te}) { # spent 37.6ms making 3 calls to Net::HTTP::Methods::gunzip_ok, avg 12.5ms/call
# spent 10µs making 3 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:104], avg 3µs/call |
163 | push(@connection, "TE") unless grep lc($_) eq "te", @connection; | ||||
164 | } | ||||
165 | elsif ($self->send_te && gunzip_ok()) { | ||||
166 | # gzip is less wanted since the IO::Uncompress::Gunzip interface for | ||||
167 | # it does not really allow chunked decoding to take place easily. | ||||
168 | push(@h2, "TE: deflate,gzip;q=0.3"); | ||||
169 | push(@connection, "TE"); | ||||
170 | } | ||||
171 | |||||
172 | 3 | 10µs | unless (grep lc($_) eq "close", @connection) { | ||
173 | 3 | 2µs | 3 | 14µs | if ($self->keep_alive) { # spent 14µs making 3 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:104], avg 4µs/call |
174 | 4 | 4µs | if ($peer_ver eq "1.0") { | ||
175 | # from looking at Netscape's headers | ||||
176 | push(@h2, "Keep-Alive: 300"); | ||||
177 | unshift(@connection, "Keep-Alive"); | ||||
178 | } | ||||
179 | } | ||||
180 | else { | ||||
181 | push(@connection, "close") if $ver ge "1.1"; | ||||
182 | } | ||||
183 | } | ||||
184 | push(@h2, "Connection: " . join(", ", @connection)) if @connection; | ||||
185 | unless ($given{host}) { | ||||
186 | my $h = ${*$self}{'http_host'}; | ||||
187 | push(@h2, "Host: $h") if $h; | ||||
188 | } | ||||
189 | |||||
190 | return _bytes(join($CRLF, "$method $uri HTTP/$ver", @h2, @h, "", $content)); # spent 28µs making 3 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:19], avg 9µs/call | ||||
191 | } | ||||
192 | |||||
193 | |||||
194 | sub write_request { | ||||
195 | my $self = shift; | ||||
196 | $self->print($self->format_request(@_)); | ||||
197 | } | ||||
198 | |||||
199 | sub format_chunk { | ||||
200 | my $self = shift; | ||||
201 | return $_[0] unless defined($_[0]) && length($_[0]); | ||||
202 | return _bytes(sprintf("%x", length($_[0])) . $CRLF . $_[0] . $CRLF); | ||||
203 | } | ||||
204 | |||||
205 | sub write_chunk { | ||||
206 | my $self = shift; | ||||
207 | return 1 unless defined($_[0]) && length($_[0]); | ||||
208 | $self->print(_bytes(sprintf("%x", length($_[0])) . $CRLF . $_[0] . $CRLF)); | ||||
209 | } | ||||
210 | |||||
211 | sub format_chunk_eof { | ||||
212 | my $self = shift; | ||||
213 | my @h; | ||||
214 | while (@_) { | ||||
215 | push(@h, sprintf "%s: %s$CRLF", splice(@_, 0, 2)); | ||||
216 | } | ||||
217 | return _bytes(join("", "0$CRLF", @h, $CRLF)); | ||||
218 | } | ||||
219 | |||||
220 | sub write_chunk_eof { | ||||
221 | my $self = shift; | ||||
222 | $self->print($self->format_chunk_eof(@_)); | ||||
223 | } | ||||
224 | |||||
225 | |||||
226 | sub my_read { | ||||
227 | 20 | 14µs | die if @_ > 3; | ||
228 | my $self = shift; | ||||
229 | my $len = $_[1]; | ||||
230 | for (${*$self}{'http_buf'}) { | ||||
231 | 13 | 36µs | if (length) { | ||
232 | $_[0] = substr($_, 0, $len, ""); | ||||
233 | return length($_[0]); | ||||
234 | } | ||||
235 | else { | ||||
236 | return $self->sysread($_[0], $len); # spent 65µs making 2 calls to LWP::Protocol::http::SocketMethods::sysread, avg 33µs/call | ||||
237 | } | ||||
238 | } | ||||
239 | } | ||||
240 | |||||
241 | |||||
242 | # spent 175ms (472µs+175) within Net::HTTP::Methods::my_readline which was called 26 times, avg 6.73ms/call:
# 17 times (212µs+43µs) by Net::HTTP::Methods::_read_header_lines at line 315, avg 15µs/call
# 4 times (54µs+16µs) by Net::HTTP::Methods::read_entity_body at line 479, avg 17µs/call
# 3 times (166µs+174ms) by Net::HTTP::Methods::read_response_headers at line 343, avg 58.2ms/call
# 2 times (40µs+102µs) by Net::HTTP::Methods::read_entity_body at line 483, avg 71µs/call | ||||
243 | 78 | 56µs | my $self = shift; | ||
244 | my $what = shift; | ||||
245 | for (${*$self}{'http_buf'}) { | ||||
246 | 182 | 449µs | my $max_line_length = ${*$self}{'http_max_line_length'}; | ||
247 | my $pos; | ||||
248 | while (1) { | ||||
249 | # find line ending | ||||
250 | 72 | 47µs | $pos = index($_, "\012"); | ||
251 | last if $pos >= 0; | ||||
252 | die "$what line too long (limit is $max_line_length)" | ||||
253 | if $max_line_length && length($_) > $max_line_length; | ||||
254 | |||||
255 | # need to read more data to find a line ending | ||||
256 | 15 | 33µs | 5 | 174ms | READ: # spent 174ms making 5 calls to LWP::Protocol::http::SocketMethods::sysread, avg 34.9ms/call |
257 | { | ||||
258 | my $n = $self->sysread($_, 1024, length); | ||||
259 | unless (defined $n) { | ||||
260 | redo READ if $!{EINTR}; | ||||
261 | if ($!{EAGAIN}) { | ||||
262 | # Hmm, we must be reading from a non-blocking socket | ||||
263 | # XXX Should really wait until this socket is readable,... | ||||
264 | select(undef, undef, undef, 0.1); # but this will do for now | ||||
265 | redo READ; | ||||
266 | } | ||||
267 | # if we have already accumulated some data let's at least | ||||
268 | # return that as a line | ||||
269 | die "$what read failed: $!" unless length; | ||||
270 | } | ||||
271 | unless ($n) { | ||||
272 | return undef unless length; | ||||
273 | return substr($_, 0, length, ""); | ||||
274 | } | ||||
275 | } | ||||
276 | } | ||||
277 | die "$what line too long ($pos; limit is $max_line_length)" | ||||
278 | if $max_line_length && $pos > $max_line_length; | ||||
279 | |||||
280 | my $line = substr($_, 0, $pos+1, ""); | ||||
281 | $line =~ s/(\015?\012)\z// || die "Assert"; # spent 114µs making 26 calls to Net::HTTP::Methods::CORE:subst, avg 4µs/call | ||||
282 | return wantarray ? ($line, $1) : $line; | ||||
283 | } | ||||
284 | } | ||||
285 | |||||
286 | |||||
287 | sub _rbuf { | ||||
288 | my $self = shift; | ||||
289 | if (@_) { | ||||
290 | for (${*$self}{'http_buf'}) { | ||||
291 | my $old; | ||||
292 | $old = $_ if defined wantarray; | ||||
293 | $_ = shift; | ||||
294 | return $old; | ||||
295 | } | ||||
296 | } | ||||
297 | else { | ||||
298 | return ${*$self}{'http_buf'}; | ||||
299 | } | ||||
300 | } | ||||
301 | |||||
302 | sub _rbuf_length { | ||||
303 | my $self = shift; | ||||
304 | return length ${*$self}{'http_buf'}; | ||||
305 | } | ||||
306 | |||||
307 | |||||
308 | sub _read_header_lines { | ||||
309 | 35 | 71µs | my $self = shift; | ||
310 | my $junk_out = shift; | ||||
311 | |||||
312 | my @headers; | ||||
313 | my $line_count = 0; | ||||
314 | my $max_header_lines = ${*$self}{'http_max_header_lines'}; | ||||
315 | 24 | 138µs | 17 | 255µs | while (my $line = my_readline($self, 'Header')) { # spent 255µs making 17 calls to Net::HTTP::Methods::my_readline, avg 15µs/call |
316 | 1 | 35µs | 12 | 60µs | if ($line =~ /^(\S+?)\s*:\s*(.*)/s) { # spent 60µs making 12 calls to Net::HTTP::Methods::CORE:match, avg 5µs/call |
317 | push(@headers, $1, $2); | ||||
318 | } | ||||
319 | elsif (@headers && $line =~ s/^\s+//) { | ||||
320 | $headers[-1] .= " " . $line; | ||||
321 | } | ||||
322 | elsif ($junk_out) { | ||||
323 | push(@$junk_out, $line); | ||||
324 | } | ||||
325 | else { | ||||
326 | die "Bad header: '$line'\n"; | ||||
327 | } | ||||
328 | 24 | 7µs | if ($max_header_lines) { | ||
329 | $line_count++; | ||||
330 | if ($line_count >= $max_header_lines) { | ||||
331 | die "Too many header lines (limit is $max_header_lines)"; | ||||
332 | } | ||||
333 | } | ||||
334 | } | ||||
335 | return @headers; | ||||
336 | } | ||||
337 | |||||
338 | |||||
339 | # spent 175ms (297µs+175) within Net::HTTP::Methods::read_response_headers which was called 3 times, avg 58.4ms/call:
# 3 times (297µs+175ms) by LWP::Protocol::http::request at line 352 of LWP/Protocol/http.pm, avg 58.4ms/call | ||||
340 | 63 | 250µs | my($self, %opt) = @_; | ||
341 | my $laxed = $opt{laxed}; | ||||
342 | |||||
343 | my($status, $eol) = my_readline($self, 'Status'); # spent 175ms making 3 calls to Net::HTTP::Methods::my_readline, avg 58.2ms/call | ||||
344 | unless (defined $status) { | ||||
345 | die "Server closed connection without sending any data back"; | ||||
346 | } | ||||
347 | |||||
348 | my($peer_ver, $code, $message) = split(/\s+/, $status, 3); | ||||
349 | if (!$peer_ver || $peer_ver !~ s,^HTTP/,, || $code !~ /^[1-5]\d\d$/) { # spent 8µs making 3 calls to Net::HTTP::Methods::CORE:subst, avg 3µs/call
# spent 7µs making 3 calls to Net::HTTP::Methods::CORE:match, avg 2µs/call | ||||
350 | die "Bad response status line: '$status'" unless $laxed; | ||||
351 | # assume HTTP/0.9 | ||||
352 | ${*$self}{'http_peer_http_version'} = "0.9"; | ||||
353 | ${*$self}{'http_status'} = "200"; | ||||
354 | substr(${*$self}{'http_buf'}, 0, 0) = $status . ($eol || ""); | ||||
355 | return 200 unless wantarray; | ||||
356 | return (200, "Assumed OK"); | ||||
357 | }; | ||||
358 | |||||
359 | ${*$self}{'http_peer_http_version'} = $peer_ver; | ||||
360 | ${*$self}{'http_status'} = $code; | ||||
361 | |||||
362 | my $junk_out; | ||||
363 | if ($laxed) { | ||||
364 | $junk_out = $opt{junk_out} || []; | ||||
365 | } | ||||
366 | my @headers = $self->_read_header_lines($junk_out); # spent 496µs making 3 calls to Net::HTTP::Methods::_read_header_lines, avg 165µs/call | ||||
367 | |||||
368 | # pick out headers that read_entity_body might need | ||||
369 | my @te; | ||||
370 | my $content_length; | ||||
371 | 24 | 18µs | for (my $i = 0; $i < @headers; $i += 2) { | ||
372 | 1 | 7µs | my $h = lc($headers[$i]); | ||
373 | 8 | 28µs | if ($h eq 'transfer-encoding') { | ||
374 | my $te = $headers[$i+1]; | ||||
375 | $te =~ s/^\s+//; # spent 3µs making 2 calls to Net::HTTP::Methods::CORE:subst, avg 2µs/call | ||||
376 | $te =~ s/\s+$//; # spent 3µs making 2 calls to Net::HTTP::Methods::CORE:subst, avg 1µs/call | ||||
377 | push(@te, $te) if length($te); | ||||
378 | } | ||||
379 | elsif ($h eq 'content-length') { | ||||
380 | # ignore bogus and overflow values | ||||
381 | if ($headers[$i+1] =~ /^\s*(\d{1,15})(?:\s|$)/) { | ||||
382 | $content_length = $1; | ||||
383 | } | ||||
384 | } | ||||
385 | } | ||||
386 | ${*$self}{'http_te'} = join(",", @te); | ||||
387 | ${*$self}{'http_content_length'} = $content_length; | ||||
388 | ${*$self}{'http_first_body'}++; | ||||
389 | delete ${*$self}{'http_trailers'}; | ||||
390 | return $code unless wantarray; | ||||
391 | return ($code, $message, @headers); | ||||
392 | } | ||||
393 | |||||
394 | |||||
395 | # spent 646µs (255+390) within Net::HTTP::Methods::read_entity_body which was called 7 times, avg 92µs/call:
# 7 times (255µs+390µs) by LWP::Protocol::http::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/LWP/Protocol/http.pm:394] at line 383 of LWP/Protocol/http.pm, avg 92µs/call | ||||
396 | 56 | 24µs | my $self = shift; | ||
397 | my $buf_ref = \$_[0]; | ||||
398 | my $size = $_[1]; | ||||
399 | die "Offset not supported yet" if $_[2]; | ||||
400 | |||||
401 | my $chunked; | ||||
402 | my $bytes; | ||||
403 | |||||
404 | 26 | 32µs | if (${*$self}{'http_first_body'}) { | ||
405 | ${*$self}{'http_first_body'} = 0; | ||||
406 | delete ${*$self}{'http_chunked'}; | ||||
407 | delete ${*$self}{'http_bytes'}; | ||||
408 | my $method = shift(@{${*$self}{'http_request_method'}}); | ||||
409 | my $status = ${*$self}{'http_status'}; | ||||
410 | 12 | 25µs | 1 | 2µs | if ($method eq "HEAD") { # spent 2µs making 1 call to Net::HTTP::Methods::CORE:match |
411 | # this response is always empty regardless of other headers | ||||
412 | $bytes = 0; | ||||
413 | } | ||||
414 | elsif (my $te = ${*$self}{'http_te'}) { | ||||
415 | my @te = split(/\s*,\s*/, lc($te)); | ||||
416 | die "Chunked must be last Transfer-Encoding '$te'" | ||||
417 | unless pop(@te) eq "chunked"; | ||||
418 | |||||
419 | for (@te) { | ||||
420 | if ($_ eq "deflate" && inflate_ok()) { | ||||
421 | #require Compress::Raw::Zlib; | ||||
422 | my ($i, $status) = Compress::Raw::Zlib::Inflate->new(); | ||||
423 | die "Can't make inflator: $status" unless $i; | ||||
424 | $_ = sub { my $out; $i->inflate($_[0], \$out); $out } | ||||
425 | } | ||||
426 | elsif ($_ eq "gzip" && gunzip_ok()) { | ||||
427 | #require IO::Uncompress::Gunzip; | ||||
428 | my @buf; | ||||
429 | $_ = sub { | ||||
430 | push(@buf, $_[0]); | ||||
431 | return "" unless $_[1]; | ||||
432 | my $input = join("", @buf); | ||||
433 | my $output; | ||||
434 | IO::Uncompress::Gunzip::gunzip(\$input, \$output, Transparent => 0) | ||||
435 | or die "Can't gunzip content: $IO::Uncompress::Gunzip::GunzipError"; | ||||
436 | return \$output; | ||||
437 | }; | ||||
438 | } | ||||
439 | elsif ($_ eq "identity") { | ||||
440 | $_ = sub { $_[0] }; | ||||
441 | } | ||||
442 | else { | ||||
443 | die "Can't handle transfer encoding '$te'"; | ||||
444 | } | ||||
445 | } | ||||
446 | |||||
447 | @te = reverse(@te); | ||||
448 | |||||
449 | ${*$self}{'http_te2'} = @te ? \@te : ""; | ||||
450 | $chunked = -1; | ||||
451 | } | ||||
452 | elsif (defined(my $content_length = ${*$self}{'http_content_length'})) { | ||||
453 | $bytes = $content_length; | ||||
454 | } | ||||
455 | elsif ($status =~ /^(?:1|[23]04)/) { | ||||
456 | # RFC 2616 says that these responses should always be empty | ||||
457 | # but that does not appear to be true in practice [RT#17907] | ||||
458 | $bytes = 0; | ||||
459 | } | ||||
460 | else { | ||||
461 | # XXX Multi-Part types are self delimiting, but RFC 2616 says we | ||||
462 | # only has to deal with 'multipart/byteranges' | ||||
463 | |||||
464 | # Read until EOF | ||||
465 | } | ||||
466 | } | ||||
467 | else { | ||||
468 | $chunked = ${*$self}{'http_chunked'}; | ||||
469 | $bytes = ${*$self}{'http_bytes'}; | ||||
470 | } | ||||
471 | |||||
472 | 24 | 45µs | if (defined $chunked) { | ||
473 | # The state encoded in $chunked is: | ||||
474 | # $chunked == 0: read CRLF after chunk, then chunk header | ||||
475 | # $chunked == -1: read chunk header | ||||
476 | # $chunked > 0: bytes left in current chunk to read | ||||
477 | |||||
478 | 32 | 71µs | if ($chunked <= 0) { | ||
479 | my $line = my_readline($self, 'Entity body'); # spent 70µs making 4 calls to Net::HTTP::Methods::my_readline, avg 17µs/call | ||||
480 | 4 | 7µs | if ($chunked == 0) { | ||
481 | die "Missing newline after chunk data: '$line'" | ||||
482 | if !defined($line) || $line ne ""; | ||||
483 | $line = my_readline($self, 'Entity body'); # spent 142µs making 2 calls to Net::HTTP::Methods::my_readline, avg 71µs/call | ||||
484 | } | ||||
485 | die "EOF when chunk header expected" unless defined($line); | ||||
486 | my $chunk_len = $line; | ||||
487 | $chunk_len =~ s/;.*//; # ignore potential chunk parameters # spent 3µs making 4 calls to Net::HTTP::Methods::CORE:subst, avg 650ns/call | ||||
488 | unless ($chunk_len =~ /^([\da-fA-F]+)\s*$/) { # spent 12µs making 4 calls to Net::HTTP::Methods::CORE:match, avg 3µs/call | ||||
489 | die "Bad chunk-size in HTTP response: $line"; | ||||
490 | } | ||||
491 | $chunked = hex($1); | ||||
492 | 14 | 30µs | if ($chunked == 0) { | ||
493 | ${*$self}{'http_trailers'} = [$self->_read_header_lines]; # spent 48µs making 2 calls to Net::HTTP::Methods::_read_header_lines, avg 24µs/call | ||||
494 | $$buf_ref = ""; | ||||
495 | |||||
496 | my $n = 0; | ||||
497 | if (my $transforms = delete ${*$self}{'http_te2'}) { | ||||
498 | for (@$transforms) { | ||||
499 | $$buf_ref = &$_($$buf_ref, 1); | ||||
500 | } | ||||
501 | $n = length($$buf_ref); | ||||
502 | } | ||||
503 | |||||
504 | # in case somebody tries to read more, make sure we continue | ||||
505 | # to return EOF | ||||
506 | delete ${*$self}{'http_chunked'}; | ||||
507 | ${*$self}{'http_bytes'} = 0; | ||||
508 | |||||
509 | return $n; | ||||
510 | } | ||||
511 | } | ||||
512 | |||||
513 | my $n = $chunked; | ||||
514 | $n = $size if $size && $size < $n; | ||||
515 | $n = my_read($self, $$buf_ref, $n); # spent 24µs making 2 calls to Net::HTTP::Methods::my_read, avg 12µs/call | ||||
516 | return undef unless defined $n; | ||||
517 | |||||
518 | ${*$self}{'http_chunked'} = $chunked - $n; | ||||
519 | |||||
520 | 2 | 3µs | if ($n > 0) { | ||
521 | if (my $transforms = ${*$self}{'http_te2'}) { | ||||
522 | for (@$transforms) { | ||||
523 | $$buf_ref = &$_($$buf_ref, 0); | ||||
524 | } | ||||
525 | $n = length($$buf_ref); | ||||
526 | $n = -1 if $n == 0; | ||||
527 | } | ||||
528 | } | ||||
529 | return $n; | ||||
530 | } | ||||
531 | elsif (defined $bytes) { | ||||
532 | unless ($bytes) { | ||||
533 | $$buf_ref = ""; | ||||
534 | return 0; | ||||
535 | } | ||||
536 | my $n = $bytes; | ||||
537 | $n = $size if $size && $size < $n; | ||||
538 | $n = my_read($self, $$buf_ref, $n); | ||||
539 | return undef unless defined $n; | ||||
540 | ${*$self}{'http_bytes'} = $bytes - $n; | ||||
541 | return $n; | ||||
542 | } | ||||
543 | else { | ||||
544 | # read until eof | ||||
545 | $size ||= 8*1024; | ||||
546 | return my_read($self, $$buf_ref, $size); # spent 91µs making 3 calls to Net::HTTP::Methods::my_read, avg 30µs/call | ||||
547 | } | ||||
548 | } | ||||
549 | |||||
550 | # spent 14µs within Net::HTTP::Methods::get_trailers which was called 3 times, avg 5µs/call:
# 3 times (14µs+0s) by LWP::Protocol::http::request at line 397 of LWP/Protocol/http.pm, avg 5µs/call | ||||
551 | 6 | 18µs | my $self = shift; | ||
552 | @{${*$self}{'http_trailers'} || []}; | ||||
553 | } | ||||
554 | |||||
555 | # spent 7µs within Net::HTTP::Methods::BEGIN@555 which was called
# once (7µs+0s) by LWP::Protocol::implementor at line 591 | ||||
556 | 2 | 19µs | my $gunzip_ok; | ||
557 | my $inflate_ok; | ||||
558 | |||||
559 | # spent 37.6ms (1.21+36.4) within Net::HTTP::Methods::gunzip_ok which was called 3 times, avg 12.5ms/call:
# 3 times (1.21ms+36.4ms) by Net::HTTP::Methods::format_request at line 162, avg 12.5ms/call | ||||
560 | 8 | 21µs | return $gunzip_ok if defined $gunzip_ok; | ||
561 | |||||
562 | # Try to load IO::Uncompress::Gunzip. | ||||
563 | local $@; | ||||
564 | local $SIG{__DIE__}; | ||||
565 | $gunzip_ok = 0; | ||||
566 | |||||
567 | 2 | 103µs | eval { | ||
568 | require IO::Uncompress::Gunzip; | ||||
569 | $gunzip_ok++; | ||||
570 | }; | ||||
571 | |||||
572 | return $gunzip_ok; | ||||
573 | } | ||||
574 | |||||
575 | sub inflate_ok { | ||||
576 | return $inflate_ok if defined $inflate_ok; | ||||
577 | |||||
578 | # Try to load Compress::Raw::Zlib. | ||||
579 | local $@; | ||||
580 | local $SIG{__DIE__}; | ||||
581 | $inflate_ok = 0; | ||||
582 | |||||
583 | eval { | ||||
584 | require Compress::Raw::Zlib; | ||||
585 | $inflate_ok++; | ||||
586 | }; | ||||
587 | |||||
588 | return $inflate_ok; | ||||
589 | } | ||||
590 | |||||
591 | 1 | 57µs | 1 | 7µs | } # BEGIN # spent 7µs making 1 call to Net::HTTP::Methods::BEGIN@555 |
592 | |||||
593 | 1 | 20µs | 1; | ||
# spent 86µs within Net::HTTP::Methods::CORE:match which was called 28 times, avg 3µs/call:
# 12 times (60µs+0s) by Net::HTTP::Methods::_read_header_lines at line 316 of Net/HTTP/Methods.pm, avg 5µs/call
# 6 times (5µs+0s) by Net::HTTP::Methods::format_request at line 132 of Net/HTTP/Methods.pm, avg 800ns/call
# 4 times (12µs+0s) by Net::HTTP::Methods::read_entity_body at line 488 of Net/HTTP/Methods.pm, avg 3µs/call
# 3 times (7µs+0s) by Net::HTTP::Methods::read_response_headers at line 349 of Net/HTTP/Methods.pm, avg 2µs/call
# 2 times (1µs+0s) by Net::HTTP::Methods::http_configure at line 58 of Net/HTTP/Methods.pm, avg 700ns/call
# once (2µs+0s) by Net::HTTP::Methods::read_entity_body at line 410 of Net/HTTP/Methods.pm | |||||
# spent 135µs within Net::HTTP::Methods::CORE:subst which was called 41 times, avg 3µs/call:
# 26 times (114µs+0s) by Net::HTTP::Methods::my_readline at line 281 of Net/HTTP/Methods.pm, avg 4µs/call
# 4 times (3µs+0s) by Net::HTTP::Methods::read_entity_body at line 487 of Net/HTTP/Methods.pm, avg 650ns/call
# 3 times (8µs+0s) by Net::HTTP::Methods::read_response_headers at line 349 of Net/HTTP/Methods.pm, avg 3µs/call
# 2 times (3µs+0s) by Net::HTTP::Methods::read_response_headers at line 375 of Net/HTTP/Methods.pm, avg 2µs/call
# 2 times (3µs+0s) by Net::HTTP::Methods::http_configure at line 47 of Net/HTTP/Methods.pm, avg 2µs/call
# 2 times (3µs+0s) by Net::HTTP::Methods::read_response_headers at line 376 of Net/HTTP/Methods.pm, avg 1µs/call
# 2 times (1µs+0s) by Net::HTTP::Methods::http_configure at line 56 of Net/HTTP/Methods.pm, avg 600ns/call |