← Index
NYTProf Performance Profile   « block view • line view • sub view »
For 05.Domain_and_Item.t
  Run on Tue May 4 17:21:41 2010
Reported on Tue May 4 17:22:20 2010

File /usr/local/lib/perl5/site_perl/5.10.1/Net/HTTP/Methods.pm
Statements Executed 14154
Statement Execution Time 26.1ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
406416.46ms15.2sNet::HTTP::Methods::::my_readlineNet::HTTP::Methods::my_readline
98113.87ms86.2msNet::HTTP::Methods::::read_entity_bodyNet::HTTP::Methods::read_entity_body
41113.70ms15.1sNet::HTTP::Methods::::read_response_headersNet::HTTP::Methods::read_response_headers
81212.98ms7.00msNet::HTTP::Methods::::_read_header_linesNet::HTTP::Methods::_read_header_lines
41112.66ms31.9msNet::HTTP::Methods::::format_requestNet::HTTP::Methods::format_request
611721.98ms1.98msNet::HTTP::Methods::::CORE:substNet::HTTP::Methods::CORE:subst (opcode)
41111.52ms28.5msNet::HTTP::Methods::::gunzip_okNet::HTTP::Methods::gunzip_ok
370621.10ms1.10msNet::HTTP::Methods::::CORE:matchNet::HTTP::Methods::CORE:match (opcode)
13592657µs657µsNet::HTTP::Methods::::__ANON__[:104]Net::HTTP::Methods::__ANON__[:104]
5821637µs1.36msNet::HTTP::Methods::::my_readNet::HTTP::Methods::my_read
4111319µs352µsNet::HTTP::Methods::::__ANON__[:19]Net::HTTP::Methods::__ANON__[:19]
211219µs181msNet::HTTP::Methods::::http_configureNet::HTTP::Methods::http_configure
4111198µs198µsNet::HTTP::Methods::::get_trailersNet::HTTP::Methods::get_trailers
21122µs22µsNet::HTTP::Methods::::http_versionNet::HTTP::Methods::http_version
11120µs24µsNet::HTTP::Methods::::BEGIN@5Net::HTTP::Methods::BEGIN@5
1119µs38µsNet::HTTP::Methods::::BEGIN@6Net::HTTP::Methods::BEGIN@6
1118µs25µsNet::HTTP::Methods::::BEGIN@98Net::HTTP::Methods::BEGIN@98
1114µs4µsNet::HTTP::Methods::::BEGIN@555Net::HTTP::Methods::BEGIN@555
2113µs3µsNet::HTTP::Methods::::http_default_portNet::HTTP::Methods::http_default_port
0000s0sNet::HTTP::Methods::::__ANON__[:23]Net::HTTP::Methods::__ANON__[:23]
0000s0sNet::HTTP::Methods::::__ANON__[:424]Net::HTTP::Methods::__ANON__[:424]
0000s0sNet::HTTP::Methods::::__ANON__[:437]Net::HTTP::Methods::__ANON__[:437]
0000s0sNet::HTTP::Methods::::__ANON__[:440]Net::HTTP::Methods::__ANON__[:440]
0000s0sNet::HTTP::Methods::::_rbufNet::HTTP::Methods::_rbuf
0000s0sNet::HTTP::Methods::::_rbuf_lengthNet::HTTP::Methods::_rbuf_length
0000s0sNet::HTTP::Methods::::format_chunkNet::HTTP::Methods::format_chunk
0000s0sNet::HTTP::Methods::::format_chunk_eofNet::HTTP::Methods::format_chunk_eof
0000s0sNet::HTTP::Methods::::inflate_okNet::HTTP::Methods::inflate_ok
0000s0sNet::HTTP::Methods::::newNet::HTTP::Methods::new
0000s0sNet::HTTP::Methods::::write_chunkNet::HTTP::Methods::write_chunk
0000s0sNet::HTTP::Methods::::write_chunk_eofNet::HTTP::Methods::write_chunk_eof
0000s0sNet::HTTP::Methods::::write_requestNet::HTTP::Methods::write_request
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Net::HTTP::Methods;
2
3118µsrequire 5.005; # 4-arg substr
4
5326µs227µs
# spent 24µs (20+3) within Net::HTTP::Methods::BEGIN@5 which was called # once (20µs+3µs) by LWP::Protocol::implementor at line 5
use strict;
# spent 24µs making 1 call to Net::HTTP::Methods::BEGIN@5 # spent 3µs making 1 call to strict::import
63410µs267µs
# spent 38µs (9+29) within Net::HTTP::Methods::BEGIN@6 which was called # once (9µs+29µs) by LWP::Protocol::implementor at line 6
use vars qw($VERSION);
# spent 38µs making 1 call to Net::HTTP::Methods::BEGIN@6 # spent 29µs making 1 call to vars::import
7
81500ns$VERSION = "5.834";
9
101300nsmy $CRLF = "\015\012"; # "\r\n" is not portable
11
12*_bytes = defined(&utf8::downgrade) ?
13
# spent 352µs (319+33) within Net::HTTP::Methods::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/Net/HTTP/Methods.pm:19] which was called 41 times, avg 9µs/call: # 41 times (319µs+33µs) by Net::HTTP::Methods::format_request at line 190, avg 9µs/call
sub {
1482354µs4133µs unless (utf8::downgrade($_[0], 1)) {
# spent 33µs making 41 calls to utf8::downgrade, avg 798ns/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];
2313µs };
24
25
26sub 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 181ms (219µs+181) within Net::HTTP::Methods::http_configure which was called 2 times, avg 90.6ms/call: # 2 times (219µs+181ms) by Net::HTTP::configure at line 24 of Net/HTTP.pm, avg 90.6ms/call
sub http_configure {
3670188µ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 2µs making 2 calls to Net::HTTP::Methods::CORE:subst, avg 1µs/call
48 $cnf->{PeerPort} = int($1); # always override
49 }
50 if (!$cnf->{PeerPort}) {
51 $cnf->{PeerPort} = $self->http_default_port;
52 }
53
54 if (!$explict_host) {
55 $host = $peer;
56 $host =~ s/:.*//;
# spent 1µs making 2 calls to Net::HTTP::Methods::CORE:subst, avg 550ns/call
57 }
58 if ($host && $host !~ /:/) {
# spent 3µs making 2 calls to Net::HTTP::Methods::CORE:match, avg 2µs/call
59 my $p = $cnf->{PeerPort};
60 $host .= ":$p" if $p != $self->http_default_port;
# spent 3µ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 181ms making 2 calls to Net::HTTP::http_connect, avg 90.4ms/call
77
78 $self->host($host);
# spent 18µs making 2 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:104], avg 9µs/call
79 $self->keep_alive($keep_alive);
# spent 11µs making 2 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:104], avg 6µs/call
80 $self->send_te($send_te);
# spent 9µ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 22µs making 2 calls to Net::HTTP::Methods::http_version, avg 11µs/call
82 $self->peer_http_version($peer_http_version);
# spent 10µs making 2 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:104], avg 5µs/call
83 $self->max_line_length($max_line_length);
# spent 8µs making 2 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:104], avg 4µs/call
84 $self->max_header_lines($max_header_lines);
# spent 8µs making 2 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:104], avg 4µs/call
85
86 ${*$self}{'http_buf'} = "";
87
88 return $self;
89}
90
91
# spent 3µs within Net::HTTP::Methods::http_default_port which was called 2 times, avg 2µs/call: # 2 times (3µs+0s) by Net::HTTP::Methods::http_configure at line 60, avg 2µs/call
sub http_default_port {
9227µs 80;
93}
94
95# set up property accessors
961900nsfor my $method (qw(host keep_alive send_te max_line_length max_header_lines peer_http_version)) {
9763µs my $prop_name = "http_" . $method;
9832.08ms242µs
# spent 25µs (8+17) within Net::HTTP::Methods::BEGIN@98 which was called # once (8µs+17µs) by LWP::Protocol::implementor at line 98
no strict 'refs';
# spent 25µs making 1 call to Net::HTTP::Methods::BEGIN@98 # spent 17µs making 1 call to strict::unimport
99
# spent 657µs within Net::HTTP::Methods::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/Net/HTTP/Methods.pm:104] which was called 135 times, avg 5µs/call: # 41 times (245µs+0s) by LWP::Protocol::http::request at line 358 of LWP/Protocol/http.pm, avg 6µs/call # 41 times (179µs+0s) by Net::HTTP::Methods::format_request at line 162, avg 4µs/call # 41 times (169µs+0s) by Net::HTTP::Methods::format_request at line 173, avg 4µs/call # 2 times (18µs+0s) by Net::HTTP::Methods::http_configure at line 78, avg 9µs/call # 2 times (11µs+0s) by Net::HTTP::Methods::http_configure at line 79, avg 6µs/call # 2 times (10µs+0s) by Net::HTTP::Methods::http_configure at line 82, avg 5µs/call # 2 times (9µs+0s) by Net::HTTP::Methods::http_configure at line 80, avg 4µs/call # 2 times (8µs+0s) by Net::HTTP::Methods::http_configure at line 83, avg 4µs/call # 2 times (8µs+0s) by Net::HTTP::Methods::http_configure at line 84, avg 4µs/call
*$method = sub {
100540767µs my $self = shift;
101 my $old = ${*$self}{$prop_name};
102 ${*$self}{$prop_name} = shift if @_;
103 return $old;
104616µs };
105}
106
107# we want this one to be a bit smarter
108
# spent 22µs within Net::HTTP::Methods::http_version which was called 2 times, avg 11µs/call: # 2 times (22µs+0s) by Net::HTTP::Methods::http_configure at line 81, avg 11µs/call
sub http_version {
1091624µs my $self = shift;
110 my $old = ${*$self}{'http_version'};
111 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 31.9ms (2.66+29.2) within Net::HTTP::Methods::format_request which was called 41 times, avg 778µs/call: # 41 times (2.66ms+29.2ms) by LWP::Protocol::http::request at line 206 of LWP/Protocol/http.pm, avg 778µs/call
sub format_request {
12419312.31ms my $self = shift;
125 my $method = shift;
126 my $uri = shift;
127
128 my $content = (@_ % 2) ? pop : "";
129
130 for ($method, $uri) {
131 require Carp;
132 Carp::croak("Bad method or uri") if /\s/ || !length;
# spent 47µs making 82 calls to Net::HTTP::Methods::CORE:match, avg 571ns/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 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 if ($given{te}) {
# spent 28.5ms making 41 calls to Net::HTTP::Methods::gunzip_ok, avg 695µs/call # spent 179µs making 41 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:104], avg 4µ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 unless (grep lc($_) eq "close", @connection) {
173 if ($self->keep_alive) {
# spent 169µs making 41 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:104], avg 4µs/call
174 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 352µs making 41 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:19], avg 9µs/call
191}
192
193
194sub write_request {
195 my $self = shift;
196 $self->print($self->format_request(@_));
197}
198
199sub 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
205sub 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
211sub 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
220sub write_chunk_eof {
221 my $self = shift;
222 $self->print($self->format_chunk_eof(@_));
223}
224
225
226
# spent 1.36ms (637µs+720µs) within Net::HTTP::Methods::my_read which was called 58 times, avg 23µs/call: # 56 times (619µs+683µs) by Net::HTTP::Methods::read_entity_body at line 515, avg 23µs/call # 2 times (18µs+37µs) by Net::HTTP::Methods::read_entity_body at line 546, avg 28µs/call
sub my_read {
227389648µs die if @_ > 3;
228 my $self = shift;
229 my $len = $_[1];
230 for (${*$self}{'http_buf'}) {
231 if (length) {
232 $_[0] = substr($_, 0, $len, "");
233 return length($_[0]);
234 }
235 else {
236 return $self->sysread($_[0], $len);
# spent 720µs making 17 calls to LWP::Protocol::http::SocketMethods::sysread, avg 42µs/call
237 }
238 }
239}
240
241
242
# spent 15.2s (6.46ms+15.2) within Net::HTTP::Methods::my_readline which was called 406 times, avg 37.4ms/call: # 245 times (2.76ms+566µs) by Net::HTTP::Methods::_read_header_lines at line 315, avg 14µs/call # 80 times (1.02ms+722µs) by Net::HTTP::Methods::read_entity_body at line 479, avg 22µs/call # 41 times (2.01ms+15.1s) by Net::HTTP::Methods::read_response_headers at line 343, avg 368ms/call # 40 times (675µs+77.5ms) by Net::HTTP::Methods::read_entity_body at line 483, avg 1.95ms/call
sub my_readline {
24354607.94ms my $self = shift;
244 my $what = shift;
245 for (${*$self}{'http_buf'}) {
246 my $max_line_length = ${*$self}{'http_max_line_length'};
247 my $pos;
248 while (1) {
249 # find line ending
250 $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 READ:
# spent 15.2s making 84 calls to LWP::Protocol::http::SocketMethods::sysread, avg 181ms/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 1.70ms making 406 calls to Net::HTTP::Methods::CORE:subst, avg 4µs/call
282 return wantarray ? ($line, $1) : $line;
283 }
284}
285
286
287sub _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
302sub _rbuf_length {
303 my $self = shift;
304 return length ${*$self}{'http_buf'};
305}
306
307
308
# spent 7.00ms (2.98+4.02) within Net::HTTP::Methods::_read_header_lines which was called 81 times, avg 86µs/call: # 41 times (2.64ms+3.54ms) by Net::HTTP::Methods::read_response_headers at line 366, avg 151µs/call # 40 times (344µs+478µs) by Net::HTTP::Methods::read_entity_body at line 493, avg 21µs/call
sub _read_header_lines {
30912233.15ms 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 while (my $line = my_readline($self, 'Header')) {
# spent 3.32ms making 245 calls to Net::HTTP::Methods::my_readline, avg 14µs/call
316 if ($line =~ /^(\S+?)\s*:\s*(.*)/s) {
# spent 698µs making 164 calls to Net::HTTP::Methods::CORE:match, avg 4µ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 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 15.1s (3.70ms+15.1) within Net::HTTP::Methods::read_response_headers which was called 41 times, avg 368ms/call: # 41 times (3.70ms+15.1s) by LWP::Protocol::http::request at line 352 of LWP/Protocol/http.pm, avg 368ms/call
sub read_response_headers {
34013493.85ms my($self, %opt) = @_;
341 my $laxed = $opt{laxed};
342
343 my($status, $eol) = my_readline($self, 'Status');
# spent 15.1s making 41 calls to Net::HTTP::Methods::my_readline, avg 368ms/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 108µs making 41 calls to Net::HTTP::Methods::CORE:match, avg 3µs/call # spent 107µs making 41 calls to Net::HTTP::Methods::CORE:subst, avg 3µ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 6.18ms making 41 calls to Net::HTTP::Methods::_read_header_lines, avg 151µs/call
367
368 # pick out headers that read_entity_body might need
369 my @te;
370 my $content_length;
371 for (my $i = 0; $i < @headers; $i += 2) {
372 my $h = lc($headers[$i]);
373 if ($h eq 'transfer-encoding') {
374 my $te = $headers[$i+1];
375 $te =~ s/^\s+//;
# spent 65µs making 40 calls to Net::HTTP::Methods::CORE:subst, avg 2µs/call
376 $te =~ s/\s+$//;
# spent 51µs making 40 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 86.2ms (3.87+82.3) within Net::HTTP::Methods::read_entity_body which was called 98 times, avg 880µs/call: # 98 times (3.87ms+82.3ms) 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 880µs/call
sub read_entity_body {
39629323.69ms 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 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 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 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 if ($chunked <= 0) {
479 my $line = my_readline($self, 'Entity body');
# spent 1.74ms making 80 calls to Net::HTTP::Methods::my_readline, avg 22µs/call
480 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 78.1ms making 40 calls to Net::HTTP::Methods::my_readline, avg 1.95ms/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 47µs making 80 calls to Net::HTTP::Methods::CORE:subst, avg 592ns/call
488 unless ($chunk_len =~ /^([\da-fA-F]+)\s*$/) {
# spent 238µs making 80 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 if ($chunked == 0) {
493 ${*$self}{'http_trailers'} = [$self->_read_header_lines];
# spent 821µs making 40 calls to Net::HTTP::Methods::_read_header_lines, avg 21µ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 1.30ms making 56 calls to Net::HTTP::Methods::my_read, avg 23µs/call
516 return undef unless defined $n;
517
518 ${*$self}{'http_chunked'} = $chunked - $n;
519
520 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 55µs making 2 calls to Net::HTTP::Methods::my_read, avg 28µs/call
547 }
548}
549
550
# spent 198µs within Net::HTTP::Methods::get_trailers which was called 41 times, avg 5µs/call: # 41 times (198µs+0s) by LWP::Protocol::http::request at line 397 of LWP/Protocol/http.pm, avg 5µs/call
sub get_trailers {
55182214µs my $self = shift;
552 @{${*$self}{'http_trailers'} || []};
553}
554
555
# spent 4µs within Net::HTTP::Methods::BEGIN@555 which was called # once (4µs+0s) by LWP::Protocol::implementor at line 591
BEGIN {
55629µsmy $gunzip_ok;
557my $inflate_ok;
558
559
# spent 28.5ms (1.52+27.0) within Net::HTTP::Methods::gunzip_ok which was called 41 times, avg 695µs/call: # 41 times (1.52ms+27.0ms) by Net::HTTP::Methods::format_request at line 162, avg 695µs/call
sub gunzip_ok {
56048339µ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 eval {
568 require IO::Uncompress::Gunzip;
569 $gunzip_ok++;
570 };
571
572 return $gunzip_ok;
573}
574
575sub 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
591127µs14µs} # BEGIN
# spent 4µs making 1 call to Net::HTTP::Methods::BEGIN@555
592
593111µs1;
# spent 1.10ms within Net::HTTP::Methods::CORE:match which was called 370 times, avg 3µs/call: # 164 times (698µs+0s) by Net::HTTP::Methods::_read_header_lines at line 316 of Net/HTTP/Methods.pm, avg 4µs/call # 82 times (47µs+0s) by Net::HTTP::Methods::format_request at line 132 of Net/HTTP/Methods.pm, avg 571ns/call # 80 times (238µs+0s) by Net::HTTP::Methods::read_entity_body at line 488 of Net/HTTP/Methods.pm, avg 3µs/call # 41 times (108µ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::http_configure at line 58 of Net/HTTP/Methods.pm, avg 2µs/call # once (2µs+0s) by Net::HTTP::Methods::read_entity_body at line 410 of Net/HTTP/Methods.pm
sub Net::HTTP::Methods::CORE:match; # xsub
# spent 1.98ms within Net::HTTP::Methods::CORE:subst which was called 611 times, avg 3µs/call: # 406 times (1.70ms+0s) by Net::HTTP::Methods::my_readline at line 281 of Net/HTTP/Methods.pm, avg 4µs/call # 80 times (47µs+0s) by Net::HTTP::Methods::read_entity_body at line 487 of Net/HTTP/Methods.pm, avg 592ns/call # 41 times (107µs+0s) by Net::HTTP::Methods::read_response_headers at line 349 of Net/HTTP/Methods.pm, avg 3µs/call # 40 times (65µs+0s) by Net::HTTP::Methods::read_response_headers at line 375 of Net/HTTP/Methods.pm, avg 2µs/call # 40 times (51µs+0s) by Net::HTTP::Methods::read_response_headers at line 376 of Net/HTTP/Methods.pm, avg 1µs/call # 2 times (2µs+0s) by Net::HTTP::Methods::http_configure at line 47 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 550ns/call
sub Net::HTTP::Methods::CORE:subst; # xsub