← Index
NYTProf Performance Profile   « block view • line view • sub view »
For ddd2.pl
  Run on Tue May 25 16:52:24 2010
Reported on Tue May 25 16:57:03 2010

File /project/perl/lib/Net/HTTP/Methods.pm
Statements Executed 166499
Statement Execution Time 1.56s
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
552531429ms92.6sNet::HTTP::Methods::::my_readlineNet::HTTP::Methods::my_readline
46111272ms714msNet::HTTP::Methods::::_read_header_linesNet::HTTP::Methods::_read_header_lines
46111197ms93.1sNet::HTTP::Methods::::read_response_headersNet::HTTP::Methods::read_response_headers
46111160ms49.3sNet::HTTP::Methods::::http_configureNet::HTTP::Methods::http_configure
46111157ms350msNet::HTTP::Methods::::format_requestNet::HTTP::Methods::format_request
414992117ms117msNet::HTTP::Methods::::__ANON__[:81]Net::HTTP::Methods::__ANON__[:81]
4611199.8ms162msNet::HTTP::Methods::::zlib_okNet::HTTP::Methods::zlib_ok
73626259.8ms59.8msNet::HTTP::Methods::::CORE:matchNet::HTTP::Methods::CORE:match (opcode)
64473254.1ms54.1msNet::HTTP::Methods::::CORE:substNet::HTTP::Methods::CORE:subst (opcode)
4681153.9ms59.1msNet::HTTP::Methods::::read_entity_bodyNet::HTTP::Methods::read_entity_body
4611124.8ms24.8msNet::HTTP::Methods::::http_versionNet::HTTP::Methods::http_version
461119.99ms9.99msNet::HTTP::Methods::::get_trailersNet::HTTP::Methods::get_trailers
461115.38ms5.38msNet::HTTP::Methods::::http_default_portNet::HTTP::Methods::http_default_port
1411727µs1.84msNet::HTTP::Methods::::my_readNet::HTTP::Methods::my_read
0000s0sNet::HTTP::Methods::::BEGINNet::HTTP::Methods::BEGIN
0000s0sNet::HTTP::Methods::::__ANON__[:385]Net::HTTP::Methods::__ANON__[:385]
0000s0sNet::HTTP::Methods::::__ANON__[:394]Net::HTTP::Methods::__ANON__[:394]
0000s0sNet::HTTP::Methods::::__ANON__[:397]Net::HTTP::Methods::__ANON__[:397]
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::::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
3# $Id: Methods.pm,v 1.22 2005/12/07 10:01:37 gisle Exp $
4
519µsrequire 5.005; # 4-arg substr
6
73109µs126µsuse strict;
# spent 26µs making 1 call to strict::import
83856µs1156µsuse vars qw($VERSION);
# spent 156µs making 1 call to vars::import
9
1016µs$VERSION = "1.02";
11
1215µsmy $CRLF = "\015\012"; # "\r\n" is not portable
13
14sub new {
15 my($class, %cnf) = @_;
16 require Symbol;
17 my $self = bless Symbol::gensym(), $class;
18 return $self->http_configure(\%cnf);
19}
20
21
# spent 49.3s (160ms+49.1) within Net::HTTP::Methods::http_configure which was called 461 times, avg 107ms/call: # 461 times (160ms+49.1s) by Net::HTTP::configure at line 16 of Net/HTTP.pm, avg 107ms/call
sub http_configure {
224612.47ms my($self, $cnf) = @_;
23
244612.53ms die "Listen option not allowed" if $cnf->{Listen};
254612.55ms my $explict_host = (exists $cnf->{Host});
264612.19ms my $host = delete $cnf->{Host};
274612.60ms my $peer = $cnf->{PeerAddr} || $cnf->{PeerHost};
284614.50ms if ($host) {
29 $cnf->{PeerAddr} = $host unless $peer;
30 }
31 elsif (!$explict_host) {
324612.20ms $host = $peer;
3346110.5ms4613.04ms $host =~ s/:.*//;
# spent 3.04ms making 461 calls to Net::HTTP::Methods::CORE:subst, avg 7µs/call
34 }
354612.31ms $cnf->{PeerPort} = $self->http_default_port unless $cnf->{PeerPort};
364612.45ms $cnf->{Proto} = 'tcp';
37
384613.23ms my $keep_alive = delete $cnf->{KeepAlive};
394612.27ms my $http_version = delete $cnf->{HTTPVersion};
404612.29ms $http_version = "1.1" unless defined $http_version;
414612.25ms my $peer_http_version = delete $cnf->{PeerHTTPVersion};
424612.15ms $peer_http_version = "1.0" unless defined $peer_http_version;
434612.57ms my $send_te = delete $cnf->{SendTE};
444612.03ms my $max_line_length = delete $cnf->{MaxLineLength};
454611.99ms $max_line_length = 4*1024 unless defined $max_line_length;
464612.13ms my $max_header_lines = delete $cnf->{MaxHeaderLines};
474611.98ms $max_header_lines = 128 unless defined $max_header_lines;
48
494618.58ms46148.9s return undef unless $self->http_connect($cnf);
# spent 48.9s making 461 calls to Net::HTTP::http_connect, avg 106ms/call
50
5146112.6ms4613.73ms if ($host && $host !~ /:/) {
# spent 3.73ms making 461 calls to Net::HTTP::Methods::CORE:match, avg 8µs/call
524619.19ms46165.2ms my $p = $self->peerport;
# spent 65.2ms making 461 calls to IO::Socket::INET::peerport, avg 142µs/call
534618.73ms4615.38ms $host .= ":$p" if $p != $self->http_default_port;
# spent 5.38ms making 461 calls to Net::HTTP::Methods::http_default_port, avg 12µs/call
54 }
554617.82ms46114.9ms $self->host($host);
# spent 14.9ms making 461 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:81], avg 32µs/call
564617.53ms46112.9ms $self->keep_alive($keep_alive);
# spent 12.9ms making 461 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:81], avg 28µs/call
574617.35ms46112.7ms $self->send_te($send_te);
# spent 12.7ms making 461 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:81], avg 28µs/call
584617.48ms46124.8ms $self->http_version($http_version);
# spent 24.8ms making 461 calls to Net::HTTP::Methods::http_version, avg 54µs/call
594617.75ms46112.8ms $self->peer_http_version($peer_http_version);
# spent 12.8ms making 461 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:81], avg 28µs/call
604617.08ms46111.7ms $self->max_line_length($max_line_length);
# spent 11.7ms making 461 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:81], avg 25µs/call
614617.07ms46111.9ms $self->max_header_lines($max_header_lines);
# spent 11.9ms making 461 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:81], avg 26µs/call
62
634612.94ms ${*$self}{'http_buf'} = "";
64
654617.03ms return $self;
66}
67
68
# spent 5.38ms within Net::HTTP::Methods::http_default_port which was called 461 times, avg 12µs/call: # 461 times (5.38ms+0s) by Net::HTTP::Methods::http_configure at line 53, avg 12µs/call
sub http_default_port {
694616.37ms 80;
70}
71
72# set up property accessors
73112µsfor my $method (qw(host keep_alive send_te max_line_length max_header_lines peer_http_version)) {
74636µs my $prop_name = "http_" . $method;
7535.24ms1117µs no strict 'refs';
# spent 117µs making 1 call to strict::unimport
76
# spent 117ms within Net::HTTP::Methods::__ANON__[/project/perl/lib/Net/HTTP/Methods.pm:81] which was called 4149 times, avg 28µs/call: # 461 times (14.9ms+0s) by Net::HTTP::Methods::http_configure at line 55, avg 32µs/call # 461 times (13.8ms+0s) by LWP::Protocol::http::request at line 319 of LWP/Protocol/http.pm, avg 30µs/call # 461 times (13.5ms+0s) by Net::HTTP::Methods::format_request at line 139, avg 29µs/call # 461 times (12.9ms+0s) by Net::HTTP::Methods::http_configure at line 56, avg 28µs/call # 461 times (12.8ms+0s) by Net::HTTP::Methods::http_configure at line 59, avg 28µs/call # 461 times (12.7ms+0s) by Net::HTTP::Methods::http_configure at line 57, avg 28µs/call # 461 times (12.4ms+0s) by Net::HTTP::Methods::format_request at line 150, avg 27µs/call # 461 times (11.9ms+0s) by Net::HTTP::Methods::http_configure at line 61, avg 26µs/call # 461 times (11.7ms+0s) by Net::HTTP::Methods::http_configure at line 60, avg 25µs/call
*$method = sub {
77414919.9ms my $self = shift;
78414923.7ms my $old = ${*$self}{$prop_name};
79414924.6ms ${*$self}{$prop_name} = shift if @_;
80414958.8ms return $old;
816101µs };
82}
83
84# we want this one to be a bit smarter
85
# spent 24.8ms within Net::HTTP::Methods::http_version which was called 461 times, avg 54µs/call: # 461 times (24.8ms+0s) by Net::HTTP::Methods::http_configure at line 58, avg 54µs/call
sub http_version {
864612.24ms my $self = shift;
874612.53ms my $old = ${*$self}{'http_version'};
884614.13ms if (@_) {
894612.20ms my $v = shift;
904612.48ms $v = "1.0" if $v eq "1"; # float
914612.22ms unless ($v eq "1.0" or $v eq "1.1") {
92 require Carp;
93 Carp::croak("Unsupported HTTP version '$v'");
94 }
954613.73ms ${*$self}{'http_version'} = $v;
96 }
974616.52ms $old;
98}
99
100
# spent 350ms (157+193) within Net::HTTP::Methods::format_request which was called 461 times, avg 759µs/call: # 461 times (157ms+193ms) by LWP::Protocol::http::request at line 205 of LWP/Protocol/http.pm, avg 759µs/call
sub format_request {
1014612.40ms my $self = shift;
1024612.26ms my $method = shift;
1034612.39ms my $uri = shift;
104
1054612.97ms my $content = (@_ % 2) ? pop : "";
106
1074615.21ms for ($method, $uri) {
1089225.24ms require Carp;
10992222.8ms9225.55ms Carp::croak("Bad method or uri") if /\s/ || !length;
# spent 5.55ms making 922 calls to Net::HTTP::Methods::CORE:match, avg 6µs/call
110 }
111
1124614.46ms push(@{${*$self}{'http_request_method'}}, $method);
1134612.58ms my $ver = ${*$self}{'http_version'};
1144612.62ms my $peer_ver = ${*$self}{'http_peer_http_version'} || "1.0";
115
1164612.01ms my @h;
1174612.04ms my @connection;
1184614.45ms my %given = (host => 0, "content-length" => 0, "te" => 0);
1194614.26ms while (@_) {
1209225.73ms my($k, $v) = splice(@_, 0, 2);
1219224.54ms my $lc_k = lc($k);
1229224.25ms if ($lc_k eq "connection") {
123 $v =~ s/^\s+//;
124 $v =~ s/\s+$//;
125 push(@connection, split(/\s*,\s*/, $v));
126 next;
127 }
1289224.72ms if (exists $given{$lc_k}) {
129 $given{$lc_k}++;
130 }
13192210.8ms push(@h, "$k: $v");
132 }
133
1344612.15ms if (length($content) && !$given{'content-length'}) {
135 push(@h, "Content-Length: " . length($content));
136 }
137
1384612.02ms my @h2;
13946116.6ms922175ms if ($given{te}) {
# spent 162ms making 461 calls to Net::HTTP::Methods::zlib_ok, avg 351µs/call # spent 13.5ms making 461 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:81], avg 29µs/call
140 push(@connection, "TE") unless grep lc($_) eq "te", @connection;
141 }
142 elsif ($self->send_te && zlib_ok()) {
143 # gzip is less wanted since the Compress::Zlib interface for
144 # it does not really allow chunked decoding to take place easily.
1454612.66ms push(@h2, "TE: deflate,gzip;q=0.3");
1464612.32ms push(@connection, "TE");
147 }
148
1494615.19ms unless (grep lc($_) eq "close", @connection) {
1504619.83ms46112.4ms if ($self->keep_alive) {
# spent 12.4ms making 461 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:81], avg 27µs/call
151 if ($peer_ver eq "1.0") {
152 # from looking at Netscape's headers
153 push(@h2, "Keep-Alive: 300");
154 unshift(@connection, "Keep-Alive");
155 }
156 }
157 else {
1584613.23ms push(@connection, "close") if $ver ge "1.1";
159 }
160 }
1614614.13ms push(@h2, "Connection: " . join(", ", @connection)) if @connection;
1624612.26ms unless ($given{host}) {
163 my $h = ${*$self}{'http_host'};
164 push(@h2, "Host: $h") if $h;
165 }
166
16746112.2ms return join($CRLF, "$method $uri HTTP/$ver", @h2, @h, "", $content);
168}
169
170
171sub write_request {
172 my $self = shift;
173 $self->print($self->format_request(@_));
174}
175
176sub format_chunk {
177 my $self = shift;
178 return $_[0] unless defined($_[0]) && length($_[0]);
179 return sprintf("%x", length($_[0])) . $CRLF . $_[0] . $CRLF;
180}
181
182sub write_chunk {
183 my $self = shift;
184 return 1 unless defined($_[0]) && length($_[0]);
185 $self->print(sprintf("%x", length($_[0])) . $CRLF . $_[0] . $CRLF);
186}
187
188sub format_chunk_eof {
189 my $self = shift;
190 my @h;
191 while (@_) {
192 push(@h, sprintf "%s: %s$CRLF", splice(@_, 0, 2));
193 }
194 return join("", "0$CRLF", @h, $CRLF);
195}
196
197sub write_chunk_eof {
198 my $self = shift;
199 $self->print($self->format_chunk_eof(@_));
200}
201
202
203
# spent 1.84ms (727µs+1.11) within Net::HTTP::Methods::my_read which was called 14 times, avg 131µs/call: # 14 times (727µs+1.11ms) by Net::HTTP::Methods::read_entity_body at line 498, avg 131µs/call
sub my_read {
2041470µs die if @_ > 3;
2051465µs my $self = shift;
2061466µs my $len = $_[1];
20714109µs for (${*$self}{'http_buf'}) {
2081463µs if (length) {
209752µs $_[0] = substr($_, 0, $len, "");
2107115µs return length($_[0]);
211 }
212 else {
2137189µs71.11ms return $self->sysread($_[0], $len);
# spent 1.11ms making 7 calls to LWP::Protocol::http::SocketMethods::sysread, avg 159µs/call
214 }
215 }
216}
217
218
219
# spent 92.6s (429ms+92.1) within Net::HTTP::Methods::my_readline which was called 5525 times, avg 16.8ms/call: # 4603 times (328ms+35.1ms) by Net::HTTP::Methods::_read_header_lines at line 289, avg 79µs/call # 461 times (66.5ms+92.1s) by Net::HTTP::Methods::read_response_headers at line 304, avg 200ms/call # 461 times (34.6ms+4.34ms) by Net::HTTP::Methods::_read_header_lines at line 276, avg 84µs/call
sub my_readline {
220552527.0ms my $self = shift;
221552536.1ms for (${*$self}{'http_buf'}) {
222552525.9ms my $max_line_length = ${*$self}{'http_max_line_length'};
223552523.6ms my $pos;
224552524.2ms while (1) {
225 # find line ending
226598631.7ms $pos = index($_, "\012");
227598629.8ms last if $pos >= 0;
2284612.85ms die "Line too long (limit is $max_line_length)"
229 if $max_line_length && length($_) > $max_line_length;
230
231 # need to read more data to find a line ending
23246110.1ms46192.1s my $n = $self->sysread($_, 1024, length);
# spent 92.1s making 461 calls to LWP::Protocol::http::SocketMethods::sysread, avg 200ms/call
2334615.38ms if (!$n) {
234 return undef unless length;
235 return substr($_, 0, length, "");
236 }
237 }
238552524.4ms die "Line too long ($pos; limit is $max_line_length)"
239 if $max_line_length && $pos > $max_line_length;
240
241552533.2ms my $line = substr($_, 0, $pos+1, "");
2425525122ms552547.8ms $line =~ s/(\015?\012)\z// || die "Assert";
# spent 47.8ms making 5525 calls to Net::HTTP::Methods::CORE:subst, avg 9µs/call
243552586.4ms return wantarray ? ($line, $1) : $line;
244 }
245}
246
247
248sub _rbuf {
249 my $self = shift;
250 if (@_) {
251 for (${*$self}{'http_buf'}) {
252 my $old;
253 $old = $_ if defined wantarray;
254 $_ = shift;
255 return $old;
256 }
257 }
258 else {
259 return ${*$self}{'http_buf'};
260 }
261}
262
263sub _rbuf_length {
264 my $self = shift;
265 return length ${*$self}{'http_buf'};
266}
267
268
269
# spent 714ms (272+442) within Net::HTTP::Methods::_read_header_lines which was called 461 times, avg 1.55ms/call: # 461 times (272ms+442ms) by Net::HTTP::Methods::read_response_headers at line 327, avg 1.55ms/call
sub _read_header_lines {
2704612.58ms my $self = shift;
2714612.04ms my $junk_out = shift;
272
2734612.13ms my @headers;
2744612.02ms my $line_count = 0;
2754612.43ms my $max_header_lines = ${*$self}{'http_max_header_lines'};
2764619.70ms46139.0ms while (my $line = my_readline($self)) {
# spent 39.0ms making 461 calls to Net::HTTP::Methods::my_readline, avg 84µs/call
2774603113ms460339.6ms if ($line =~ /^(\S+)\s*:\s*(.*)/s) {
# spent 39.6ms making 4603 calls to Net::HTTP::Methods::CORE:match, avg 9µs/call
278 push(@headers, $1, $2);
279 }
280 elsif (@headers && $line =~ s/^\s+//) {
281 $headers[-1] .= " " . $line;
282 }
283 elsif ($junk_out) {
284 push(@$junk_out, $line);
285 }
286 else {
287 die "Bad header: '$line'\n";
288 }
2894603119ms4603363ms if ($max_header_lines) {
# spent 363ms making 4603 calls to Net::HTTP::Methods::my_readline, avg 79µs/call
290460319.7ms $line_count++;
291460321.0ms if ($line_count >= $max_header_lines) {
292 die "Too many header lines (limit is $max_header_lines)";
293 }
294 }
295 }
29646112.9ms return @headers;
297}
298
299
300
# spent 93.1s (197ms+92.9) within Net::HTTP::Methods::read_response_headers which was called 461 times, avg 202ms/call: # 461 times (197ms+92.9s) by LWP::Protocol::http::request at line 313 of LWP/Protocol/http.pm, avg 202ms/call
sub read_response_headers {
3014615.09ms my($self, %opt) = @_;
3024612.43ms my $laxed = $opt{laxed};
303
3044619.35ms46192.2s my($status, $eol) = my_readline($self);
# spent 92.2s making 461 calls to Net::HTTP::Methods::my_readline, avg 200ms/call
3054612.11ms unless (defined $status) {
306 die "Server closed connection without sending any data back";
307 }
308
3094614.70ms my($peer_ver, $code, $message) = split(/\s+/, $status, 3);
31046116.8ms9226.59ms if (!$peer_ver || $peer_ver !~ s,^HTTP/,, || $code !~ /^[1-5]\d\d$/) {
# spent 3.32ms making 461 calls to Net::HTTP::Methods::CORE:subst, avg 7µs/call # spent 3.27ms making 461 calls to Net::HTTP::Methods::CORE:match, avg 7µs/call
311 die "Bad response status line: '$status'" unless $laxed;
312 # assume HTTP/0.9
313 ${*$self}{'http_peer_http_version'} = "0.9";
314 ${*$self}{'http_status'} = "200";
315 substr(${*$self}{'http_buf'}, 0, 0) = $status . ($eol || "");
316 return 200 unless wantarray;
317 return (200, "Assumed OK");
318 };
319
3204613.45ms ${*$self}{'http_peer_http_version'} = $peer_ver;
3214613.21ms ${*$self}{'http_status'} = $code;
322
3234612.04ms my $junk_out;
3244612.86ms if ($laxed) {
325 $junk_out = $opt{junk_out} || [];
326 }
32746115.5ms461714ms my @headers = $self->_read_header_lines($junk_out);
# spent 714ms making 461 calls to Net::HTTP::Methods::_read_header_lines, avg 1.55ms/call
328
329 # pick out headers that read_entity_body might need
3304612.00ms my @te;
3314612.03ms my $content_length;
33246145.3ms for (my $i = 0; $i < @headers; $i += 2) {
333460322.1ms my $h = lc($headers[$i]);
334460323.2ms if ($h eq 'transfer-encoding') {
335 my $te = $headers[$i+1];
336 $te =~ s/^\s+//;
337 $te =~ s/\s+$//;
338 push(@te, $te) if length($te);
339 }
340 elsif ($h eq 'content-length') {
341 # ignore bogus and overflow values
34245411.9ms4544.24ms if ($headers[$i+1] =~ /^\s*(\d{1,15})(?:\s|$)/) {
# spent 4.24ms making 454 calls to Net::HTTP::Methods::CORE:match, avg 9µs/call
343 $content_length = $1;
344 }
345 }
3464612.14ms }
3474614.29ms ${*$self}{'http_te'} = join(",", @te);
3484614.44ms ${*$self}{'http_content_length'} = $content_length;
3494612.58ms ${*$self}{'http_first_body'}++;
3504612.51ms delete ${*$self}{'http_trailers'};
3514612.05ms return $code unless wantarray;
35246115.9ms return ($code, $message, @headers);
353}
354
355
356
# spent 59.1ms (53.9+5.22) within Net::HTTP::Methods::read_entity_body which was called 468 times, avg 126µs/call: # 468 times (53.9ms+5.22ms) by LWP::Protocol::http::__ANON__[/project/perl/lib/LWP/Protocol/http.pm:352] at line 344 of LWP/Protocol/http.pm, avg 126µs/call
sub read_entity_body {
3574682.63ms my $self = shift;
3584682.58ms my $buf_ref = \$_[0];
3594682.12ms my $size = $_[1];
3604682.11ms die "Offset not supported yet" if $_[2];
361
3624681.97ms my $chunked;
3634682.04ms my $bytes;
364
3654685.02ms if (${*$self}{'http_first_body'}) {
3664612.23ms ${*$self}{'http_first_body'} = 0;
3674612.34ms delete ${*$self}{'http_chunked'};
3684612.12ms delete ${*$self}{'http_bytes'};
3694613.10ms my $method = shift(@{${*$self}{'http_request_method'}});
3704612.70ms my $status = ${*$self}{'http_status'};
37146113.0ms4613.38ms if ($method eq "HEAD" || $status =~ /^(?:1|[23]04)/) {
# spent 3.38ms making 461 calls to Net::HTTP::Methods::CORE:match, avg 7µs/call
372 # these responses are always empty
373 $bytes = 0;
374 }
375 elsif (my $te = ${*$self}{'http_te'}) {
376 my @te = split(/\s*,\s*/, lc($te));
377 die "Chunked must be last Transfer-Encoding '$te'"
378 unless pop(@te) eq "chunked";
379
380 for (@te) {
381 if ($_ eq "deflate" && zlib_ok()) {
382 #require Compress::Zlib;
383 my $i = Compress::Zlib::inflateInit();
384 die "Can't make inflator" unless $i;
385 $_ = sub { scalar($i->inflate($_[0])) }
386 }
387 elsif ($_ eq "gzip" && zlib_ok()) {
388 #require Compress::Zlib;
389 my @buf;
390 $_ = sub {
391 push(@buf, $_[0]);
392 return Compress::Zlib::memGunzip(join("", @buf)) if $_[1];
393 return "";
394 };
395 }
396 elsif ($_ eq "identity") {
397 $_ = sub { $_[0] };
398 }
399 else {
400 die "Can't handle transfer encoding '$te'";
401 }
402 }
403
404 @te = reverse(@te);
405
406 ${*$self}{'http_te2'} = @te ? \@te : "";
407 $chunked = -1;
408 }
409 elsif (defined(my $content_length = ${*$self}{'http_content_length'})) {
410 $bytes = $content_length;
411 }
412 else {
413 # XXX Multi-Part types are self delimiting, but RFC 2616 says we
414 # only has to deal with 'multipart/byteranges'
415
416 # Read until EOF
417 }
418 }
419 else {
420734µs $chunked = ${*$self}{'http_chunked'};
421735µs $bytes = ${*$self}{'http_bytes'};
422 }
423
4244682.46ms if (defined $chunked) {
425 # The state encoded in $chunked is:
426 # $chunked == 0: read CRLF after chunk, then chunk header
427 # $chunked == -1: read chunk header
428 # $chunked > 0: bytes left in current chunk to read
429
430 if ($chunked <= 0) {
431 my $line = my_readline($self);
432 if ($chunked == 0) {
433 die "Missing newline after chunk data: '$line'"
434 if !defined($line) || $line ne "";
435 $line = my_readline($self);
436 }
437 die "EOF when chunk header expected" unless defined($line);
438 my $chunk_len = $line;
439 $chunk_len =~ s/;.*//; # ignore potential chunk parameters
440 unless ($chunk_len =~ /^([\da-fA-F]+)\s*$/) {
441 die "Bad chunk-size in HTTP response: $line";
442 }
443 $chunked = hex($1);
444 if ($chunked == 0) {
445 ${*$self}{'http_trailers'} = [$self->_read_header_lines];
446 $$buf_ref = "";
447
448 my $n = 0;
449 if (my $transforms = delete ${*$self}{'http_te2'}) {
450 for (@$transforms) {
451 $$buf_ref = &$_($$buf_ref, 1);
452 }
453 $n = length($$buf_ref);
454 }
455
456 # in case somebody tries to read more, make sure we continue
457 # to return EOF
458 delete ${*$self}{'http_chunked'};
459 ${*$self}{'http_bytes'} = 0;
460
461 return $n;
462 }
463 }
464
465 my $n = $chunked;
466 $n = $size if $size && $size < $n;
467 $n = my_read($self, $$buf_ref, $n);
468 return undef unless defined $n;
469
470 ${*$self}{'http_chunked'} = $chunked - $n;
471
472 if ($n > 0) {
473 if (my $transforms = ${*$self}{'http_te2'}) {
474 for (@$transforms) {
475 $$buf_ref = &$_($$buf_ref, 0);
476 }
477 $n = length($$buf_ref);
478 $n = -1 if $n == 0;
479 }
480 }
481 return $n;
482 }
483 elsif (defined $bytes) {
4844541.97ms unless ($bytes) {
4854542.36ms $$buf_ref = "";
4864546.91ms return 0;
487 }
488 my $n = $bytes;
489 $n = $size if $size && $size < $n;
490 $n = my_read($self, $$buf_ref, $n);
491 return undef unless defined $n;
492 ${*$self}{'http_bytes'} = $bytes - $n;
493 return $n;
494 }
495 else {
496 # read until eof
4971462µs $size ||= 8*1024;
49814368µs141.84ms return my_read($self, $$buf_ref, $size);
# spent 1.84ms making 14 calls to Net::HTTP::Methods::my_read, avg 131µs/call
499 }
500}
501
502
# spent 9.99ms within Net::HTTP::Methods::get_trailers which was called 461 times, avg 22µs/call: # 461 times (9.99ms+0s) by LWP::Protocol::http::request at line 355 of LWP/Protocol/http.pm, avg 22µs/call
sub get_trailers {
5034612.55ms my $self = shift;
5044618.11ms @{${*$self}{'http_trailers'} || []};
505}
506
507BEGIN {
50817µsmy $zlib_ok;
509
510
# spent 162ms (99.8+61.8) within Net::HTTP::Methods::zlib_ok which was called 461 times, avg 351µs/call: # 461 times (99.8ms+61.8ms) by Net::HTTP::Methods::format_request at line 139, avg 351µs/call
sub zlib_ok {
5114616.88ms return $zlib_ok if defined $zlib_ok;
512
513 # Try to load Compress::Zlib.
51415µs local $@;
515115µs local $SIG{__DIE__};
51614µs $zlib_ok = 0;
517
51819µs eval {
5191295µs require Compress::Zlib;
5201273µs1229µs Compress::Zlib->VERSION(1.10);
# spent 229µs making 1 call to UNIVERSAL::VERSION
521119µs $zlib_ok++;
522 };
523
524126µs return $zlib_ok;
525}
526
527163µs} # BEGIN
528
529120µs1;
# spent 59.8ms within Net::HTTP::Methods::CORE:match which was called 7362 times, avg 8µs/call: # 4603 times (39.6ms+0s) by Net::HTTP::Methods::_read_header_lines at line 277 of Net/HTTP/Methods.pm, avg 9µs/call # 922 times (5.55ms+0s) by Net::HTTP::Methods::format_request at line 109 of Net/HTTP/Methods.pm, avg 6µs/call # 461 times (3.73ms+0s) by Net::HTTP::Methods::http_configure at line 51 of Net/HTTP/Methods.pm, avg 8µs/call # 461 times (3.38ms+0s) by Net::HTTP::Methods::read_entity_body at line 371 of Net/HTTP/Methods.pm, avg 7µs/call # 461 times (3.27ms+0s) by Net::HTTP::Methods::read_response_headers at line 310 of Net/HTTP/Methods.pm, avg 7µs/call # 454 times (4.24ms+0s) by Net::HTTP::Methods::read_response_headers at line 342 of Net/HTTP/Methods.pm, avg 9µs/call
sub Net::HTTP::Methods::CORE:match; # xsub
# spent 54.1ms within Net::HTTP::Methods::CORE:subst which was called 6447 times, avg 8µs/call: # 5525 times (47.8ms+0s) by Net::HTTP::Methods::my_readline at line 242 of Net/HTTP/Methods.pm, avg 9µs/call # 461 times (3.32ms+0s) by Net::HTTP::Methods::read_response_headers at line 310 of Net/HTTP/Methods.pm, avg 7µs/call # 461 times (3.04ms+0s) by Net::HTTP::Methods::http_configure at line 33 of Net/HTTP/Methods.pm, avg 7µs/call
sub Net::HTTP::Methods::CORE:subst; # xsub
Report produced by the NYTProf 3.11 Perl profiler, developed by Tim Bunce and Adam Kaplan.