| 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 | Net::HTTP::Methods::gunzip_ok |
| 26 | 4 | 1 | 472µs | 175ms | Net::HTTP::Methods::my_readline |
| 3 | 1 | 1 | 297µs | 175ms | Net::HTTP::Methods::read_response_headers |
| 7 | 1 | 1 | 255µs | 646µs | Net::HTTP::Methods::read_entity_body |
| 3 | 1 | 1 | 240µs | 37.9ms | Net::HTTP::Methods::format_request |
| 5 | 2 | 1 | 229µs | 544µs | Net::HTTP::Methods::_read_header_lines |
| 2 | 1 | 1 | 192µs | 124ms | Net::HTTP::Methods::http_configure |
| 41 | 7 | 2 | 135µs | 135µs | Net::HTTP::Methods::CORE:subst (opcode) |
| 21 | 9 | 2 | 102µs | 102µs | Net::HTTP::Methods::__ANON__[:104] |
| 28 | 6 | 2 | 86µs | 86µs | Net::HTTP::Methods::CORE:match (opcode) |
| 5 | 2 | 1 | 50µs | 115µs | Net::HTTP::Methods::my_read |
| 3 | 1 | 1 | 23µs | 28µs | Net::HTTP::Methods::__ANON__[:19] |
| 2 | 1 | 1 | 18µs | 18µs | Net::HTTP::Methods::http_version |
| 1 | 1 | 1 | 14µs | 17µs | Net::HTTP::Methods::BEGIN@5 |
| 3 | 1 | 1 | 14µs | 14µs | Net::HTTP::Methods::get_trailers |
| 1 | 1 | 1 | 8µs | 21µs | Net::HTTP::Methods::BEGIN@98 |
| 1 | 1 | 1 | 7µs | 7µs | Net::HTTP::Methods::BEGIN@555 |
| 1 | 1 | 1 | 7µs | 27µs | Net::HTTP::Methods::BEGIN@6 |
| 2 | 1 | 1 | 4µs | 4µs | Net::HTTP::Methods::http_default_port |
| 0 | 0 | 0 | 0s | 0s | Net::HTTP::Methods::__ANON__[:23] |
| 0 | 0 | 0 | 0s | 0s | Net::HTTP::Methods::__ANON__[:424] |
| 0 | 0 | 0 | 0s | 0s | Net::HTTP::Methods::__ANON__[:437] |
| 0 | 0 | 0 | 0s | 0s | Net::HTTP::Methods::__ANON__[:440] |
| 0 | 0 | 0 | 0s | 0s | Net::HTTP::Methods::_rbuf |
| 0 | 0 | 0 | 0s | 0s | Net::HTTP::Methods::_rbuf_length |
| 0 | 0 | 0 | 0s | 0s | Net::HTTP::Methods::format_chunk |
| 0 | 0 | 0 | 0s | 0s | Net::HTTP::Methods::format_chunk_eof |
| 0 | 0 | 0 | 0s | 0s | Net::HTTP::Methods::inflate_ok |
| 0 | 0 | 0 | 0s | 0s | Net::HTTP::Methods::new |
| 0 | 0 | 0 | 0s | 0s | Net::HTTP::Methods::write_chunk |
| 0 | 0 | 0 | 0s | 0s | Net::HTTP::Methods::write_chunk_eof |
| 0 | 0 | 0 | 0s | 0s | Net::HTTP::Methods::write_request |
| 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 |