← Index
NYTProf Performance Profile   « block view • line view • sub view »
For 01.HTTP.t
  Run on Tue May 4 15:25:55 2010
Reported on Tue May 4 15:26:08 2010

File /usr/local/lib/perl5/site_perl/5.10.1/Net/HTTP/Methods.pm
Statements Executed 1099
Statement Execution Time 5.05ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
3111.21ms37.6msNet::HTTP::Methods::::gunzip_okNet::HTTP::Methods::gunzip_ok
2641472µs175msNet::HTTP::Methods::::my_readlineNet::HTTP::Methods::my_readline
311297µs175msNet::HTTP::Methods::::read_response_headersNet::HTTP::Methods::read_response_headers
711255µs646µsNet::HTTP::Methods::::read_entity_bodyNet::HTTP::Methods::read_entity_body
311240µs37.9msNet::HTTP::Methods::::format_requestNet::HTTP::Methods::format_request
521229µs544µsNet::HTTP::Methods::::_read_header_linesNet::HTTP::Methods::_read_header_lines
211192µs124msNet::HTTP::Methods::::http_configureNet::HTTP::Methods::http_configure
4172135µs135µsNet::HTTP::Methods::::CORE:substNet::HTTP::Methods::CORE:subst (opcode)
2192102µs102µsNet::HTTP::Methods::::__ANON__[:104]Net::HTTP::Methods::__ANON__[:104]
286286µs86µsNet::HTTP::Methods::::CORE:matchNet::HTTP::Methods::CORE:match (opcode)
52150µs115µsNet::HTTP::Methods::::my_readNet::HTTP::Methods::my_read
31123µs28µsNet::HTTP::Methods::::__ANON__[:19]Net::HTTP::Methods::__ANON__[:19]
21118µs18µsNet::HTTP::Methods::::http_versionNet::HTTP::Methods::http_version
11114µs17µsNet::HTTP::Methods::::BEGIN@5Net::HTTP::Methods::BEGIN@5
31114µs14µsNet::HTTP::Methods::::get_trailersNet::HTTP::Methods::get_trailers
1118µs21µsNet::HTTP::Methods::::BEGIN@98Net::HTTP::Methods::BEGIN@98
1117µs7µsNet::HTTP::Methods::::BEGIN@555Net::HTTP::Methods::BEGIN@555
1117µs27µsNet::HTTP::Methods::::BEGIN@6Net::HTTP::Methods::BEGIN@6
2114µs4µ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
31154µsrequire 5.005; # 4-arg substr
4
5324µs221µ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
use strict;
# spent 17µs making 1 call to Net::HTTP::Methods::BEGIN@5 # spent 3µs making 1 call to strict::import
63386µs247µ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
use vars qw($VERSION);
# spent 27µs making 1 call to Net::HTTP::Methods::BEGIN@6 # spent 20µs making 1 call to vars::import
7
811µs$VERSION = "5.834";
9
1011µsmy $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
sub {
14629µs35µ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];
23110µ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 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
sub http_configure {
3662147µ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
5447µ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 }
58413µs21µ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
sub http_default_port {
9227µs 80;
93}
94
95# set up property accessors
9614µsfor my $method (qw(host keep_alive send_te max_line_length max_header_lines peer_http_version)) {
971253µs my $prop_name = "http_" . $method;
9832.19ms235µ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
no strict 'refs';
# 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
*$method = sub {
10084123µ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
sub http_version {
109810µs my $self = shift;
110 my $old = ${*$self}{'http_version'};
11188µ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
sub format_request {
12457115µs my $self = shift;
125 my $method = shift;
126 my $uri = shift;
127
128 my $content = (@_ % 2) ? pop : "";
129
130 for ($method, $uri) {
1311234µ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 (@_) {
1436041µ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;
16266µs637.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
172310µs unless (grep lc($_) eq "close", @connection) {
17332µs314µ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
17444µ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
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 115µs (50+65) within Net::HTTP::Methods::my_read which was called 5 times, avg 23µs/call: # 3 times (26µs+65µs) by Net::HTTP::Methods::read_entity_body at line 546, avg 30µs/call # 2 times (24µs+0s) by Net::HTTP::Methods::read_entity_body at line 515, avg 12µs/call
sub my_read {
2272014µs die if @_ > 3;
228 my $self = shift;
229 my $len = $_[1];
230 for (${*$self}{'http_buf'}) {
2311336µ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
sub my_readline {
2437856µs my $self = shift;
244 my $what = shift;
245 for (${*$self}{'http_buf'}) {
246182449µs my $max_line_length = ${*$self}{'http_max_line_length'};
247 my $pos;
248 while (1) {
249 # find line ending
2507247µ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
2561533µs5174ms 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
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 544µs (229+315) within Net::HTTP::Methods::_read_header_lines which was called 5 times, avg 109µs/call: # 3 times (209µs+286µs) by Net::HTTP::Methods::read_response_headers at line 366, avg 165µs/call # 2 times (20µs+28µs) by Net::HTTP::Methods::read_entity_body at line 493, avg 24µs/call
sub _read_header_lines {
3093571µ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'};
31524138µs17255µs while (my $line = my_readline($self, 'Header')) {
# spent 255µs making 17 calls to Net::HTTP::Methods::my_readline, avg 15µs/call
316135µs1260µ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 }
328247µ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
sub read_response_headers {
34063250µ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;
3712418µs for (my $i = 0; $i < @headers; $i += 2) {
37217µs my $h = lc($headers[$i]);
373828µ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
sub read_entity_body {
3965624µ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
4042632µ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'};
4101225µs12µ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
4722445µ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
4783271µ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
48047µ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);
4921430µ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
52023µ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
sub get_trailers {
551618µ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
BEGIN {
556219µsmy $gunzip_ok;
557my $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
sub gunzip_ok {
560821µ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
5672103µs 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
591157µs17µs} # BEGIN
# spent 7µs making 1 call to Net::HTTP::Methods::BEGIN@555
592
593120µs1;
# 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
sub Net::HTTP::Methods::CORE:match; # xsub
# 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
sub Net::HTTP::Methods::CORE:subst; # xsub