File | /usr/local/lib/perl5/site_perl/5.10.1/Net/HTTP/Methods.pm |
Statements Executed | 1097 |
Statement Execution Time | 5.05ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
3 | 1 | 1 | 1.21ms | 37.6ms | gunzip_ok | Net::HTTP::Methods::
26 | 4 | 1 | 472µs | 175ms | my_readline | Net::HTTP::Methods::
3 | 1 | 1 | 297µs | 175ms | read_response_headers | Net::HTTP::Methods::
7 | 1 | 1 | 255µs | 646µs | read_entity_body | Net::HTTP::Methods::
3 | 1 | 1 | 240µs | 37.9ms | format_request | Net::HTTP::Methods::
5 | 2 | 1 | 229µs | 544µs | _read_header_lines | Net::HTTP::Methods::
2 | 1 | 1 | 192µs | 124ms | http_configure | Net::HTTP::Methods::
41 | 7 | 2 | 135µs | 135µs | CORE:subst (opcode) | Net::HTTP::Methods::
21 | 9 | 2 | 102µs | 102µs | __ANON__[:104] | Net::HTTP::Methods::
28 | 6 | 2 | 86µs | 86µs | CORE:match (opcode) | Net::HTTP::Methods::
5 | 2 | 1 | 50µs | 115µs | my_read | Net::HTTP::Methods::
3 | 1 | 1 | 23µs | 28µs | __ANON__[:19] | Net::HTTP::Methods::
2 | 1 | 1 | 18µs | 18µs | http_version | Net::HTTP::Methods::
1 | 1 | 1 | 14µs | 17µs | BEGIN@5 | Net::HTTP::Methods::
3 | 1 | 1 | 14µs | 14µs | get_trailers | Net::HTTP::Methods::
1 | 1 | 1 | 8µs | 21µs | BEGIN@98 | Net::HTTP::Methods::
1 | 1 | 1 | 7µs | 7µs | BEGIN@555 | Net::HTTP::Methods::
1 | 1 | 1 | 7µs | 27µs | BEGIN@6 | Net::HTTP::Methods::
2 | 1 | 1 | 4µs | 4µs | http_default_port | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | __ANON__[:23] | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | __ANON__[:424] | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | __ANON__[:437] | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | __ANON__[:440] | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | _rbuf | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | _rbuf_length | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | format_chunk | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | format_chunk_eof | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | inflate_ok | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | new | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | write_chunk | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | write_chunk_eof | Net::HTTP::Methods::
0 | 0 | 0 | 0s | 0s | write_request | Net::HTTP::Methods::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Net::HTTP::Methods; | ||||
2 | |||||
3 | 1 | 154µs | require 5.005; # 4-arg substr | ||
4 | |||||
5 | 3 | 24µs | 2 | 21µs | # spent 17µs (14+3) within Net::HTTP::Methods::BEGIN@5 which was called
# once (14µs+3µs) by LWP::Protocol::implementor at line 5 # spent 17µs making 1 call to Net::HTTP::Methods::BEGIN@5
# spent 3µs making 1 call to strict::import |
6 | 3 | 386µs | 2 | 47µs | # spent 27µs (7+20) within Net::HTTP::Methods::BEGIN@6 which was called
# once (7µs+20µs) by LWP::Protocol::implementor at line 6 # spent 27µs making 1 call to Net::HTTP::Methods::BEGIN@6
# spent 20µs making 1 call to vars::import |
7 | |||||
8 | 1 | 1µs | $VERSION = "5.834"; | ||
9 | |||||
10 | 1 | 1µs | my $CRLF = "\015\012"; # "\r\n" is not portable | ||
11 | |||||
12 | *_bytes = defined(&utf8::downgrade) ? | ||||
13 | # spent 28µs (23+5) within Net::HTTP::Methods::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/Net/HTTP/Methods.pm:19] which was called 3 times, avg 9µs/call:
# 3 times (23µs+5µs) by Net::HTTP::Methods::format_request at line 190, avg 9µs/call | ||||
14 | 3 | 18µs | 3 | 5µs | unless (utf8::downgrade($_[0], 1)) { # spent 5µs making 3 calls to utf8::downgrade, avg 2µs/call |
15 | require Carp; | ||||
16 | Carp::croak("Wide character in HTTP request (bytes required)"); | ||||
17 | } | ||||
18 | 3 | 11µs | return $_[0]; | ||
19 | } | ||||
20 | : | ||||
21 | sub { | ||||
22 | return $_[0]; | ||||
23 | 1 | 10µs | }; | ||
24 | |||||
25 | |||||
26 | sub new { | ||||
27 | my $class = shift; | ||||
28 | unshift(@_, "Host") if @_ == 1; | ||||
29 | my %cnf = @_; | ||||
30 | require Symbol; | ||||
31 | my $self = bless Symbol::gensym(), $class; | ||||
32 | return $self->http_configure(\%cnf); | ||||
33 | } | ||||
34 | |||||
35 | # spent 124ms (192µs+124) within Net::HTTP::Methods::http_configure which was called 2 times, avg 62.1ms/call:
# 2 times (192µs+124ms) by Net::HTTP::configure at line 24 of Net/HTTP.pm, avg 62.1ms/call | ||||
36 | 2 | 2µs | my($self, $cnf) = @_; | ||
37 | |||||
38 | 2 | 2µs | die "Listen option not allowed" if $cnf->{Listen}; | ||
39 | 2 | 3µs | my $explict_host = (exists $cnf->{Host}); | ||
40 | 2 | 1µs | my $host = delete $cnf->{Host}; | ||
41 | 2 | 2µs | my $peer = $cnf->{PeerAddr} || $cnf->{PeerHost}; | ||
42 | 2 | 700ns | if (!$peer) { | ||
43 | die "No Host option provided" unless $host; | ||||
44 | $cnf->{PeerAddr} = $peer = $host; | ||||
45 | } | ||||
46 | |||||
47 | 2 | 14µs | 2 | 3µs | 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 | 2 | 1µs | if (!$cnf->{PeerPort}) { | ||
51 | $cnf->{PeerPort} = $self->http_default_port; | ||||
52 | } | ||||
53 | |||||
54 | 2 | 1µs | if (!$explict_host) { | ||
55 | 2 | 800ns | $host = $peer; | ||
56 | 2 | 6µs | 2 | 1µs | $host =~ s/:.*//; # spent 1µs making 2 calls to Net::HTTP::Methods::CORE:subst, avg 600ns/call |
57 | } | ||||
58 | 2 | 10µs | 2 | 1µs | if ($host && $host !~ /:/) { # spent 1µs making 2 calls to Net::HTTP::Methods::CORE:match, avg 700ns/call |
59 | 2 | 2µs | my $p = $cnf->{PeerPort}; | ||
60 | 2 | 11µs | 2 | 4µs | $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 | 2 | 2µs | $cnf->{Proto} = 'tcp'; | ||
64 | |||||
65 | 2 | 3µs | my $keep_alive = delete $cnf->{KeepAlive}; | ||
66 | 2 | 1µs | my $http_version = delete $cnf->{HTTPVersion}; | ||
67 | 2 | 1µs | $http_version = "1.1" unless defined $http_version; | ||
68 | 2 | 1µs | my $peer_http_version = delete $cnf->{PeerHTTPVersion}; | ||
69 | 2 | 2µs | $peer_http_version = "1.0" unless defined $peer_http_version; | ||
70 | 2 | 1µs | my $send_te = delete $cnf->{SendTE}; | ||
71 | 2 | 600ns | my $max_line_length = delete $cnf->{MaxLineLength}; | ||
72 | 2 | 300ns | $max_line_length = 8*1024 unless defined $max_line_length; | ||
73 | 2 | 600ns | my $max_header_lines = delete $cnf->{MaxHeaderLines}; | ||
74 | 2 | 200ns | $max_header_lines = 128 unless defined $max_header_lines; | ||
75 | |||||
76 | 2 | 9µs | 2 | 124ms | return undef unless $self->http_connect($cnf); # spent 124ms making 2 calls to Net::HTTP::http_connect, avg 61.9ms/call |
77 | |||||
78 | 2 | 24µs | 2 | 23µs | $self->host($host); # spent 23µs making 2 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:104], avg 12µs/call |
79 | 2 | 10µs | 2 | 10µs | $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 | 2 | 10µs | 2 | 7µs | $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 | 2 | 9µs | 2 | 18µs | $self->http_version($http_version); # spent 18µs making 2 calls to Net::HTTP::Methods::http_version, avg 9µs/call |
82 | 2 | 9µs | 2 | 8µs | $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 | 2 | 8µs | 2 | 6µs | $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 | 2 | 7µs | 2 | 6µs | $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 | 2 | 3µs | ${*$self}{'http_buf'} = ""; | ||
87 | |||||
88 | 2 | 9µs | return $self; | ||
89 | } | ||||
90 | |||||
91 | # spent 4µs within Net::HTTP::Methods::http_default_port which was called 2 times, avg 2µs/call:
# 2 times (4µs+0s) by Net::HTTP::Methods::http_configure at line 60, avg 2µs/call | ||||
92 | 2 | 7µs | 80; | ||
93 | } | ||||
94 | |||||
95 | # set up property accessors | ||||
96 | 1 | 4µs | for my $method (qw(host keep_alive send_te max_line_length max_header_lines peer_http_version)) { | ||
97 | 6 | 7µs | my $prop_name = "http_" . $method; | ||
98 | 3 | 2.19ms | 2 | 35µs | # spent 21µs (8+13) within Net::HTTP::Methods::BEGIN@98 which was called
# once (8µs+13µs) by LWP::Protocol::implementor at line 98 # spent 21µs making 1 call to Net::HTTP::Methods::BEGIN@98
# spent 13µs making 1 call to strict::unimport |
99 | # spent 102µs within Net::HTTP::Methods::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/Net/HTTP/Methods.pm:104] which was called 21 times, avg 5µs/call:
# 3 times (18µs+0s) by LWP::Protocol::http::request at line 358 of LWP/Protocol/http.pm, avg 6µs/call
# 3 times (14µs+0s) by Net::HTTP::Methods::format_request at line 173, avg 4µs/call
# 3 times (10µs+0s) by Net::HTTP::Methods::format_request at line 162, avg 3µs/call
# 2 times (23µs+0s) by Net::HTTP::Methods::http_configure at line 78, avg 12µs/call
# 2 times (10µs+0s) by Net::HTTP::Methods::http_configure at line 79, avg 5µs/call
# 2 times (8µs+0s) by Net::HTTP::Methods::http_configure at line 82, avg 4µs/call
# 2 times (7µs+0s) by Net::HTTP::Methods::http_configure at line 80, avg 4µs/call
# 2 times (6µs+0s) by Net::HTTP::Methods::http_configure at line 84, avg 3µs/call
# 2 times (6µs+0s) by Net::HTTP::Methods::http_configure at line 83, avg 3µs/call | ||||
100 | 21 | 8µs | my $self = shift; | ||
101 | 21 | 23µs | my $old = ${*$self}{$prop_name}; | ||
102 | 21 | 21µs | ${*$self}{$prop_name} = shift if @_; | ||
103 | 21 | 71µs | return $old; | ||
104 | 6 | 46µs | }; | ||
105 | } | ||||
106 | |||||
107 | # we want this one to be a bit smarter | ||||
108 | # spent 18µs within Net::HTTP::Methods::http_version which was called 2 times, avg 9µs/call:
# 2 times (18µs+0s) by Net::HTTP::Methods::http_configure at line 81, avg 9µs/call | ||||
109 | 2 | 1µs | my $self = shift; | ||
110 | 2 | 2µs | my $old = ${*$self}{'http_version'}; | ||
111 | 2 | 1µs | if (@_) { | ||
112 | 2 | 1µs | my $v = shift; | ||
113 | 2 | 1µs | $v = "1.0" if $v eq "1"; # float | ||
114 | 2 | 2µs | unless ($v eq "1.0" or $v eq "1.1") { | ||
115 | require Carp; | ||||
116 | Carp::croak("Unsupported HTTP version '$v'"); | ||||
117 | } | ||||
118 | 2 | 4µs | ${*$self}{'http_version'} = $v; | ||
119 | } | ||||
120 | 2 | 6µs | $old; | ||
121 | } | ||||
122 | |||||
123 | # spent 37.9ms (240µs+37.7) within Net::HTTP::Methods::format_request which was called 3 times, avg 12.6ms/call:
# 3 times (240µs+37.7ms) by LWP::Protocol::http::request at line 206 of LWP/Protocol/http.pm, avg 12.6ms/call | ||||
124 | 3 | 2µs | my $self = shift; | ||
125 | 3 | 2µs | my $method = shift; | ||
126 | 3 | 2µs | my $uri = shift; | ||
127 | |||||
128 | 3 | 8µs | my $content = (@_ % 2) ? pop : ""; | ||
129 | |||||
130 | 3 | 6µs | for ($method, $uri) { | ||
131 | 6 | 5µs | require Carp; | ||
132 | 6 | 29µs | 6 | 5µs | 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 | 3 | 7µs | push(@{${*$self}{'http_request_method'}}, $method); | ||
136 | 3 | 3µs | my $ver = ${*$self}{'http_version'}; | ||
137 | 3 | 2µs | my $peer_ver = ${*$self}{'http_peer_http_version'} || "1.0"; | ||
138 | |||||
139 | 3 | 1µs | my @h; | ||
140 | 3 | 500ns | my @connection; | ||
141 | 3 | 8µs | my %given = (host => 0, "content-length" => 0, "te" => 0); | ||
142 | 3 | 3µs | while (@_) { | ||
143 | 12 | 9µs | my($k, $v) = splice(@_, 0, 2); | ||
144 | 12 | 5µs | my $lc_k = lc($k); | ||
145 | 12 | 6µs | if ($lc_k eq "connection") { | ||
146 | $v =~ s/^\s+//; | ||||
147 | $v =~ s/\s+$//; | ||||
148 | push(@connection, split(/\s*,\s*/, $v)); | ||||
149 | next; | ||||
150 | } | ||||
151 | 12 | 6µs | if (exists $given{$lc_k}) { | ||
152 | $given{$lc_k}++; | ||||
153 | } | ||||
154 | 12 | 15µs | push(@h, "$k: $v"); | ||
155 | } | ||||
156 | |||||
157 | 3 | 1µs | if (length($content) && !$given{'content-length'}) { | ||
158 | push(@h, "Content-Length: " . length($content)); | ||||
159 | } | ||||
160 | |||||
161 | 3 | 600ns | my @h2; | ||
162 | 3 | 17µs | 6 | 37.6ms | if ($given{te}) { # spent 37.6ms making 3 calls to Net::HTTP::Methods::gunzip_ok, avg 12.5ms/call
# spent 10µs making 3 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:104], avg 3µs/call |
163 | push(@connection, "TE") unless grep lc($_) eq "te", @connection; | ||||
164 | } | ||||
165 | elsif ($self->send_te && gunzip_ok()) { | ||||
166 | # gzip is less wanted since the IO::Uncompress::Gunzip interface for | ||||
167 | # it does not really allow chunked decoding to take place easily. | ||||
168 | 3 | 4µs | push(@h2, "TE: deflate,gzip;q=0.3"); | ||
169 | 3 | 2µs | push(@connection, "TE"); | ||
170 | } | ||||
171 | |||||
172 | 3 | 8µs | unless (grep lc($_) eq "close", @connection) { | ||
173 | 3 | 10µs | 3 | 14µs | if ($self->keep_alive) { # spent 14µs making 3 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:104], avg 4µs/call |
174 | 3 | 2µs | if ($peer_ver eq "1.0") { | ||
175 | # from looking at Netscape's headers | ||||
176 | 2 | 1µs | push(@h2, "Keep-Alive: 300"); | ||
177 | 2 | 2µs | unshift(@connection, "Keep-Alive"); | ||
178 | } | ||||
179 | } | ||||
180 | else { | ||||
181 | push(@connection, "close") if $ver ge "1.1"; | ||||
182 | } | ||||
183 | } | ||||
184 | 3 | 9µs | push(@h2, "Connection: " . join(", ", @connection)) if @connection; | ||
185 | 3 | 2µs | unless ($given{host}) { | ||
186 | my $h = ${*$self}{'http_host'}; | ||||
187 | push(@h2, "Host: $h") if $h; | ||||
188 | } | ||||
189 | |||||
190 | 3 | 33µs | 3 | 28µs | return _bytes(join($CRLF, "$method $uri HTTP/$ver", @h2, @h, "", $content)); # spent 28µs making 3 calls to Net::HTTP::Methods::__ANON__[Net/HTTP/Methods.pm:19], avg 9µs/call |
191 | } | ||||
192 | |||||
193 | |||||
194 | sub write_request { | ||||
195 | my $self = shift; | ||||
196 | $self->print($self->format_request(@_)); | ||||
197 | } | ||||
198 | |||||
199 | sub format_chunk { | ||||
200 | my $self = shift; | ||||
201 | return $_[0] unless defined($_[0]) && length($_[0]); | ||||
202 | return _bytes(sprintf("%x", length($_[0])) . $CRLF . $_[0] . $CRLF); | ||||
203 | } | ||||
204 | |||||
205 | sub write_chunk { | ||||
206 | my $self = shift; | ||||
207 | return 1 unless defined($_[0]) && length($_[0]); | ||||
208 | $self->print(_bytes(sprintf("%x", length($_[0])) . $CRLF . $_[0] . $CRLF)); | ||||
209 | } | ||||
210 | |||||
211 | sub format_chunk_eof { | ||||
212 | my $self = shift; | ||||
213 | my @h; | ||||
214 | while (@_) { | ||||
215 | push(@h, sprintf "%s: %s$CRLF", splice(@_, 0, 2)); | ||||
216 | } | ||||
217 | return _bytes(join("", "0$CRLF", @h, $CRLF)); | ||||
218 | } | ||||
219 | |||||
220 | sub write_chunk_eof { | ||||
221 | my $self = shift; | ||||
222 | $self->print($self->format_chunk_eof(@_)); | ||||
223 | } | ||||
224 | |||||
225 | |||||
226 | sub my_read { | ||||
227 | 5 | 3µs | die if @_ > 3; | ||
228 | 5 | 2µs | my $self = shift; | ||
229 | 5 | 2µs | my $len = $_[1]; | ||
230 | 5 | 8µs | for (${*$self}{'http_buf'}) { | ||
231 | 5 | 2µs | if (length) { | ||
232 | 3 | 10µs | $_[0] = substr($_, 0, $len, ""); | ||
233 | 3 | 16µs | return length($_[0]); | ||
234 | } | ||||
235 | else { | ||||
236 | 2 | 8µs | 2 | 65µs | return $self->sysread($_[0], $len); # spent 65µs making 2 calls to LWP::Protocol::http::SocketMethods::sysread, avg 33µs/call |
237 | } | ||||
238 | } | ||||
239 | } | ||||
240 | |||||
241 | |||||
242 | # spent 175ms (472µs+175) within Net::HTTP::Methods::my_readline which was called 26 times, avg 6.73ms/call:
# 17 times (212µs+43µs) by Net::HTTP::Methods::_read_header_lines at line 315, avg 15µs/call
# 4 times (54µs+16µs) by Net::HTTP::Methods::read_entity_body at line 479, avg 17µs/call
# 3 times (166µs+174ms) by Net::HTTP::Methods::read_response_headers at line 343, avg 58.2ms/call
# 2 times (40µs+102µs) by Net::HTTP::Methods::read_entity_body at line 483, avg 71µs/call | ||||
243 | 26 | 12µs | my $self = shift; | ||
244 | 26 | 10µs | my $what = shift; | ||
245 | 26 | 34µs | for (${*$self}{'http_buf'}) { | ||
246 | 26 | 14µs | my $max_line_length = ${*$self}{'http_max_line_length'}; | ||
247 | 26 | 4µs | my $pos; | ||
248 | 26 | 4µs | while (1) { | ||
249 | # find line ending | ||||
250 | 31 | 20µs | $pos = index($_, "\012"); | ||
251 | 31 | 21µs | last if $pos >= 0; | ||
252 | 5 | 3µs | 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 | 5 | 19µs | 5 | 174ms | READ: # spent 174ms making 5 calls to LWP::Protocol::http::SocketMethods::sysread, avg 34.9ms/call |
257 | { | ||||
258 | 5 | 3µs | my $n = $self->sysread($_, 1024, length); | ||
259 | 5 | 4µs | 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 | 5 | 10µs | unless ($n) { | ||
272 | return undef unless length; | ||||
273 | return substr($_, 0, length, ""); | ||||
274 | } | ||||
275 | } | ||||
276 | } | ||||
277 | 26 | 10µs | die "$what line too long ($pos; limit is $max_line_length)" | ||
278 | if $max_line_length && $pos > $max_line_length; | ||||
279 | |||||
280 | 26 | 57µs | my $line = substr($_, 0, $pos+1, ""); | ||
281 | 26 | 216µs | 26 | 114µs | $line =~ s/(\015?\012)\z// || die "Assert"; # spent 114µs making 26 calls to Net::HTTP::Methods::CORE:subst, avg 4µs/call |
282 | 26 | 143µs | return wantarray ? ($line, $1) : $line; | ||
283 | } | ||||
284 | } | ||||
285 | |||||
286 | |||||
287 | sub _rbuf { | ||||
288 | my $self = shift; | ||||
289 | if (@_) { | ||||
290 | for (${*$self}{'http_buf'}) { | ||||
291 | my $old; | ||||
292 | $old = $_ if defined wantarray; | ||||
293 | $_ = shift; | ||||
294 | return $old; | ||||
295 | } | ||||
296 | } | ||||
297 | else { | ||||
298 | return ${*$self}{'http_buf'}; | ||||
299 | } | ||||
300 | } | ||||
301 | |||||
302 | sub _rbuf_length { | ||||
303 | my $self = shift; | ||||
304 | return length ${*$self}{'http_buf'}; | ||||
305 | } | ||||
306 | |||||
307 | |||||
308 | sub _read_header_lines { | ||||
309 | 5 | 6µs | my $self = shift; | ||
310 | 5 | 3µs | my $junk_out = shift; | ||
311 | |||||
312 | 5 | 3µs | my @headers; | ||
313 | 5 | 2µs | my $line_count = 0; | ||
314 | 5 | 6µs | my $max_header_lines = ${*$self}{'http_max_header_lines'}; | ||
315 | 5 | 48µs | 17 | 255µs | while (my $line = my_readline($self, 'Header')) { # spent 255µs making 17 calls to Net::HTTP::Methods::my_readline, avg 15µs/call |
316 | 12 | 130µs | 12 | 60µs | if ($line =~ /^(\S+?)\s*:\s*(.*)/s) { # spent 60µs making 12 calls to Net::HTTP::Methods::CORE:match, avg 5µs/call |
317 | push(@headers, $1, $2); | ||||
318 | } | ||||
319 | elsif (@headers && $line =~ s/^\s+//) { | ||||
320 | $headers[-1] .= " " . $line; | ||||
321 | } | ||||
322 | elsif ($junk_out) { | ||||
323 | push(@$junk_out, $line); | ||||
324 | } | ||||
325 | else { | ||||
326 | die "Bad header: '$line'\n"; | ||||
327 | } | ||||
328 | 12 | 8µs | if ($max_header_lines) { | ||
329 | 12 | 2µs | $line_count++; | ||
330 | 12 | 5µs | if ($line_count >= $max_header_lines) { | ||
331 | die "Too many header lines (limit is $max_header_lines)"; | ||||
332 | } | ||||
333 | } | ||||
334 | } | ||||
335 | 5 | 38µs | return @headers; | ||
336 | } | ||||
337 | |||||
338 | |||||
339 | # spent 175ms (297µs+175) within Net::HTTP::Methods::read_response_headers which was called 3 times, avg 58.4ms/call:
# 3 times (297µs+175ms) by LWP::Protocol::http::request at line 352 of LWP/Protocol/http.pm, avg 58.4ms/call | ||||
340 | 3 | 10µs | my($self, %opt) = @_; | ||
341 | 3 | 2µs | my $laxed = $opt{laxed}; | ||
342 | |||||
343 | 3 | 17µs | 3 | 175ms | my($status, $eol) = my_readline($self, 'Status'); # spent 175ms making 3 calls to Net::HTTP::Methods::my_readline, avg 58.2ms/call |
344 | 3 | 2µs | unless (defined $status) { | ||
345 | die "Server closed connection without sending any data back"; | ||||
346 | } | ||||
347 | |||||
348 | 3 | 16µs | my($peer_ver, $code, $message) = split(/\s+/, $status, 3); | ||
349 | 3 | 49µs | 6 | 15µs | 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 | 3 | 9µs | ${*$self}{'http_peer_http_version'} = $peer_ver; | ||
360 | 3 | 7µs | ${*$self}{'http_status'} = $code; | ||
361 | |||||
362 | 3 | 800ns | my $junk_out; | ||
363 | 3 | 5µs | if ($laxed) { | ||
364 | $junk_out = $opt{junk_out} || []; | ||||
365 | } | ||||
366 | 3 | 60µs | 3 | 496µs | 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 | 3 | 1µs | my @te; | ||
370 | 3 | 800ns | my $content_length; | ||
371 | 3 | 12µs | for (my $i = 0; $i < @headers; $i += 2) { | ||
372 | 12 | 10µs | my $h = lc($headers[$i]); | ||
373 | 12 | 8µs | if ($h eq 'transfer-encoding') { | ||
374 | 2 | 2µs | my $te = $headers[$i+1]; | ||
375 | 2 | 12µs | 2 | 3µs | $te =~ s/^\s+//; # spent 3µs making 2 calls to Net::HTTP::Methods::CORE:subst, avg 2µs/call |
376 | 2 | 10µs | 2 | 3µs | $te =~ s/\s+$//; # spent 3µs making 2 calls to Net::HTTP::Methods::CORE:subst, avg 1µs/call |
377 | 2 | 5µs | 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 | 3 | 2µs | } | ||
386 | 3 | 11µs | ${*$self}{'http_te'} = join(",", @te); | ||
387 | 3 | 7µs | ${*$self}{'http_content_length'} = $content_length; | ||
388 | 3 | 3µs | ${*$self}{'http_first_body'}++; | ||
389 | 3 | 5µs | delete ${*$self}{'http_trailers'}; | ||
390 | 3 | 1µs | return $code unless wantarray; | ||
391 | 3 | 37µs | return ($code, $message, @headers); | ||
392 | } | ||||
393 | |||||
394 | |||||
395 | # spent 646µs (255+390) within Net::HTTP::Methods::read_entity_body which was called 7 times, avg 92µs/call:
# 7 times (255µs+390µs) by LWP::Protocol::http::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/LWP/Protocol/http.pm:394] at line 383 of LWP/Protocol/http.pm, avg 92µs/call | ||||
396 | 7 | 3µs | my $self = shift; | ||
397 | 7 | 5µs | my $buf_ref = \$_[0]; | ||
398 | 7 | 2µs | my $size = $_[1]; | ||
399 | 7 | 1µs | die "Offset not supported yet" if $_[2]; | ||
400 | |||||
401 | 7 | 1µs | my $chunked; | ||
402 | 7 | 1µs | my $bytes; | ||
403 | |||||
404 | 7 | 6µs | if (${*$self}{'http_first_body'}) { | ||
405 | 3 | 2µs | ${*$self}{'http_first_body'} = 0; | ||
406 | 3 | 2µs | delete ${*$self}{'http_chunked'}; | ||
407 | 3 | 2µs | delete ${*$self}{'http_bytes'}; | ||
408 | 3 | 5µs | my $method = shift(@{${*$self}{'http_request_method'}}); | ||
409 | 3 | 3µs | my $status = ${*$self}{'http_status'}; | ||
410 | 3 | 13µ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 | 2 | 10µs | my @te = split(/\s*,\s*/, lc($te)); | ||
416 | 2 | 3µs | die "Chunked must be last Transfer-Encoding '$te'" | ||
417 | unless pop(@te) eq "chunked"; | ||||
418 | |||||
419 | 2 | 3µs | 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 | 2 | 2µs | @te = reverse(@te); | ||
448 | |||||
449 | 2 | 5µs | ${*$self}{'http_te2'} = @te ? \@te : ""; | ||
450 | 2 | 1µs | $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 | 4 | 3µs | $chunked = ${*$self}{'http_chunked'}; | ||
469 | 4 | 2µs | $bytes = ${*$self}{'http_bytes'}; | ||
470 | } | ||||
471 | |||||
472 | 7 | 4µ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 | 4 | 3µs | if ($chunked <= 0) { | ||
479 | 4 | 10µs | 4 | 70µs | my $line = my_readline($self, 'Entity body'); # spent 70µs making 4 calls to Net::HTTP::Methods::my_readline, avg 17µs/call |
480 | 4 | 3µs | if ($chunked == 0) { | ||
481 | 2 | 2µs | die "Missing newline after chunk data: '$line'" | ||
482 | if !defined($line) || $line ne ""; | ||||
483 | 2 | 5µs | 2 | 142µs | $line = my_readline($self, 'Entity body'); # spent 142µs making 2 calls to Net::HTTP::Methods::my_readline, avg 71µs/call |
484 | } | ||||
485 | 4 | 1µs | die "EOF when chunk header expected" unless defined($line); | ||
486 | 4 | 2µs | my $chunk_len = $line; | ||
487 | 4 | 16µs | 4 | 3µs | $chunk_len =~ s/;.*//; # ignore potential chunk parameters # spent 3µs making 4 calls to Net::HTTP::Methods::CORE:subst, avg 650ns/call |
488 | 4 | 24µs | 4 | 12µs | 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 | 4 | 10µs | $chunked = hex($1); | ||
492 | 4 | 3µs | if ($chunked == 0) { | ||
493 | 2 | 10µs | 2 | 48µs | ${*$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 | 2 | 2µs | $$buf_ref = ""; | ||
495 | |||||
496 | 2 | 700ns | my $n = 0; | ||
497 | 2 | 4µs | 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 | 2 | 2µs | delete ${*$self}{'http_chunked'}; | ||
507 | 2 | 2µs | ${*$self}{'http_bytes'} = 0; | ||
508 | |||||
509 | 2 | 9µs | return $n; | ||
510 | } | ||||
511 | } | ||||
512 | |||||
513 | 2 | 2µs | my $n = $chunked; | ||
514 | 2 | 1µs | $n = $size if $size && $size < $n; | ||
515 | 2 | 8µs | 2 | 24µs | $n = my_read($self, $$buf_ref, $n); # spent 24µs making 2 calls to Net::HTTP::Methods::my_read, avg 12µs/call |
516 | 2 | 1µs | return undef unless defined $n; | ||
517 | |||||
518 | 2 | 5µs | ${*$self}{'http_chunked'} = $chunked - $n; | ||
519 | |||||
520 | 2 | 2µs | if ($n > 0) { | ||
521 | 2 | 3µs | 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 | 2 | 10µs | 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 | 3 | 600ns | $size ||= 8*1024; | ||
546 | 3 | 13µs | 3 | 91µs | return my_read($self, $$buf_ref, $size); # spent 91µs making 3 calls to Net::HTTP::Methods::my_read, avg 30µs/call |
547 | } | ||||
548 | } | ||||
549 | |||||
550 | # spent 14µs within Net::HTTP::Methods::get_trailers which was called 3 times, avg 5µs/call:
# 3 times (14µs+0s) by LWP::Protocol::http::request at line 397 of LWP/Protocol/http.pm, avg 5µs/call | ||||
551 | 3 | 2µs | my $self = shift; | ||
552 | 3 | 16µs | @{${*$self}{'http_trailers'} || []}; | ||
553 | } | ||||
554 | |||||
555 | # spent 7µs within Net::HTTP::Methods::BEGIN@555 which was called
# once (7µs+0s) by LWP::Protocol::implementor at line 591 | ||||
556 | 1 | 600ns | my $gunzip_ok; | ||
557 | 1 | 18µs | my $inflate_ok; | ||
558 | |||||
559 | # spent 37.6ms (1.21+36.4) within Net::HTTP::Methods::gunzip_ok which was called 3 times, avg 12.5ms/call:
# 3 times (1.21ms+36.4ms) by Net::HTTP::Methods::format_request at line 162, avg 12.5ms/call | ||||
560 | 3 | 9µs | return $gunzip_ok if defined $gunzip_ok; | ||
561 | |||||
562 | # Try to load IO::Uncompress::Gunzip. | ||||
563 | 1 | 400ns | local $@; | ||
564 | 1 | 4µs | local $SIG{__DIE__}; | ||
565 | 1 | 500ns | $gunzip_ok = 0; | ||
566 | |||||
567 | 1 | 800ns | eval { | ||
568 | 1 | 102µs | require IO::Uncompress::Gunzip; | ||
569 | 1 | 800ns | $gunzip_ok++; | ||
570 | }; | ||||
571 | |||||
572 | 1 | 7µs | return $gunzip_ok; | ||
573 | } | ||||
574 | |||||
575 | sub inflate_ok { | ||||
576 | return $inflate_ok if defined $inflate_ok; | ||||
577 | |||||
578 | # Try to load Compress::Raw::Zlib. | ||||
579 | local $@; | ||||
580 | local $SIG{__DIE__}; | ||||
581 | $inflate_ok = 0; | ||||
582 | |||||
583 | eval { | ||||
584 | require Compress::Raw::Zlib; | ||||
585 | $inflate_ok++; | ||||
586 | }; | ||||
587 | |||||
588 | return $inflate_ok; | ||||
589 | } | ||||
590 | |||||
591 | 1 | 57µs | 1 | 7µs | } # BEGIN # spent 7µs making 1 call to Net::HTTP::Methods::BEGIN@555 |
592 | |||||
593 | 1 | 20µs | 1; | ||
# spent 86µs within Net::HTTP::Methods::CORE:match which was called 28 times, avg 3µs/call:
# 12 times (60µs+0s) by Net::HTTP::Methods::_read_header_lines at line 316 of Net/HTTP/Methods.pm, avg 5µs/call
# 6 times (5µs+0s) by Net::HTTP::Methods::format_request at line 132 of Net/HTTP/Methods.pm, avg 800ns/call
# 4 times (12µs+0s) by Net::HTTP::Methods::read_entity_body at line 488 of Net/HTTP/Methods.pm, avg 3µs/call
# 3 times (7µs+0s) by Net::HTTP::Methods::read_response_headers at line 349 of Net/HTTP/Methods.pm, avg 2µs/call
# 2 times (1µs+0s) by Net::HTTP::Methods::http_configure at line 58 of Net/HTTP/Methods.pm, avg 700ns/call
# once (2µs+0s) by Net::HTTP::Methods::read_entity_body at line 410 of Net/HTTP/Methods.pm | |||||
# spent 135µs within Net::HTTP::Methods::CORE:subst which was called 41 times, avg 3µs/call:
# 26 times (114µs+0s) by Net::HTTP::Methods::my_readline at line 281 of Net/HTTP/Methods.pm, avg 4µs/call
# 4 times (3µs+0s) by Net::HTTP::Methods::read_entity_body at line 487 of Net/HTTP/Methods.pm, avg 650ns/call
# 3 times (8µs+0s) by Net::HTTP::Methods::read_response_headers at line 349 of Net/HTTP/Methods.pm, avg 3µs/call
# 2 times (3µs+0s) by Net::HTTP::Methods::read_response_headers at line 375 of Net/HTTP/Methods.pm, avg 2µs/call
# 2 times (3µs+0s) by Net::HTTP::Methods::http_configure at line 47 of Net/HTTP/Methods.pm, avg 2µs/call
# 2 times (3µs+0s) by Net::HTTP::Methods::read_response_headers at line 376 of Net/HTTP/Methods.pm, avg 1µs/call
# 2 times (1µs+0s) by Net::HTTP::Methods::http_configure at line 56 of Net/HTTP/Methods.pm, avg 600ns/call |