File | /usr/local/lib/perl5/site_perl/5.10.1/Net/HTTP/Methods.pm |
Statements Executed | 14156 |
Statement Execution Time | 26.1ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
406 | 4 | 1 | 6.46ms | 15.2s | my_readline | Net::HTTP::Methods::
98 | 1 | 1 | 3.87ms | 86.2ms | read_entity_body | Net::HTTP::Methods::
41 | 1 | 1 | 3.70ms | 15.1s | read_response_headers | Net::HTTP::Methods::
81 | 2 | 1 | 2.98ms | 7.00ms | _read_header_lines | Net::HTTP::Methods::
41 | 1 | 1 | 2.66ms | 31.9ms | format_request | Net::HTTP::Methods::
611 | 7 | 2 | 1.98ms | 1.98ms | CORE:subst (opcode) | Net::HTTP::Methods::
41 | 1 | 1 | 1.52ms | 28.5ms | gunzip_ok | Net::HTTP::Methods::
370 | 6 | 2 | 1.10ms | 1.10ms | CORE:match (opcode) | Net::HTTP::Methods::
135 | 9 | 2 | 657µs | 657µs | __ANON__[:104] | Net::HTTP::Methods::
58 | 2 | 1 | 637µs | 1.36ms | my_read | Net::HTTP::Methods::
41 | 1 | 1 | 319µs | 352µs | __ANON__[:19] | Net::HTTP::Methods::
2 | 1 | 1 | 219µs | 181ms | http_configure | Net::HTTP::Methods::
41 | 1 | 1 | 198µs | 198µs | get_trailers | Net::HTTP::Methods::
2 | 1 | 1 | 22µs | 22µs | http_version | Net::HTTP::Methods::
1 | 1 | 1 | 20µs | 24µs | BEGIN@5 | Net::HTTP::Methods::
1 | 1 | 1 | 9µs | 38µs | BEGIN@6 | Net::HTTP::Methods::
1 | 1 | 1 | 8µs | 25µs | BEGIN@98 | Net::HTTP::Methods::
1 | 1 | 1 | 4µs | 4µs | BEGIN@555 | Net::HTTP::Methods::
2 | 1 | 1 | 3µs | 3µ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 | 18µs | require 5.005; # 4-arg substr | ||
4 | |||||
5 | 3 | 26µs | 2 | 27µ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 # spent 24µs making 1 call to Net::HTTP::Methods::BEGIN@5
# spent 3µs making 1 call to strict::import |
6 | 3 | 410µs | 2 | 67µ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 # spent 38µs making 1 call to Net::HTTP::Methods::BEGIN@6
# spent 29µs making 1 call to vars::import |
7 | |||||
8 | 1 | 500ns | $VERSION = "5.834"; | ||
9 | |||||
10 | 1 | 300ns | my $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 | ||||
14 | 82 | 354µs | 41 | 33µ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]; | ||||
23 | 1 | 3µ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 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 | ||||
36 | 62 | 170µ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 | 4 | 8µs | 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 | 4 | 11µs | 2 | 3µs | 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 | ||||
92 | 2 | 7µs | 80; | ||
93 | } | ||||
94 | |||||
95 | # set up property accessors | ||||
96 | 1 | 900ns | for my $method (qw(host keep_alive send_te max_line_length max_header_lines peer_http_version)) { | ||
97 | 12 | 19µs | my $prop_name = "http_" . $method; | ||
98 | 3 | 2.08ms | 2 | 42µ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 # 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 | ||||
100 | 540 | 767µ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 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 | ||||
109 | 8 | 14µs | my $self = shift; | ||
110 | my $old = ${*$self}{'http_version'}; | ||||
111 | 8 | 10µ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 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 | ||||
124 | 779 | 1.37ms | my $self = shift; | ||
125 | my $method = shift; | ||||
126 | my $uri = shift; | ||||
127 | |||||
128 | my $content = (@_ % 2) ? pop : ""; | ||||
129 | |||||
130 | for ($method, $uri) { | ||||
131 | 164 | 313µs | 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 | 820 | 411µ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 | 82 | 74µs | 82 | 28.7ms | 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 | 41 | 123µs | unless (grep lc($_) eq "close", @connection) { | ||
173 | 41 | 20µs | 41 | 169µs | 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 | 4 | 5µ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 352µs making 41 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 | 232 | 182µs | die if @_ > 3; | ||
228 | my $self = shift; | ||||
229 | my $len = $_[1]; | ||||
230 | for (${*$self}{'http_buf'}) { | ||||
231 | 157 | 466µs | 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 | ||||
243 | 1218 | 810µs | my $self = shift; | ||
244 | my $what = shift; | ||||
245 | for (${*$self}{'http_buf'}) { | ||||
246 | 2842 | 6.04ms | my $max_line_length = ${*$self}{'http_max_line_length'}; | ||
247 | my $pos; | ||||
248 | while (1) { | ||||
249 | # find line ending | ||||
250 | 1148 | 715µ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 | 252 | 375µs | 84 | 15.2s | 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 | |||||
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 | # 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 | ||||
309 | 567 | 926µ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 | 328 | 1.64ms | 245 | 3.32ms | while (my $line = my_readline($self, 'Header')) { # spent 3.32ms making 245 calls to Net::HTTP::Methods::my_readline, avg 14µs/call |
316 | 1 | 482µs | 164 | 698µs | 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 | 328 | 99µ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 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 | ||||
340 | 861 | 3.02ms | 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 | 328 | 270µs | for (my $i = 0; $i < @headers; $i += 2) { | ||
372 | 1 | 100µs | my $h = lc($headers[$i]); | ||
373 | 160 | 458µs | 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 | ||||
396 | 784 | 337µ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 | 360 | 340µ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 | 240 | 384µ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 | 492 | 675µ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 | 640 | 1.24ms | 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 | 80 | 131µ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 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 | 280 | 535µs | 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 | 56 | 51µ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 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 | ||||
551 | 82 | 214µ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 | ||||
556 | 2 | 9µs | my $gunzip_ok; | ||
557 | my $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 | ||||
560 | 46 | 159µ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 | 180µ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 | 27µs | 1 | 4µs | } # BEGIN # spent 4µs making 1 call to Net::HTTP::Methods::BEGIN@555 |
592 | |||||
593 | 1 | 11µs | 1; | ||
# 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 | |||||
# 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 |