← Index
NYTProf Performance Profile   « line view »
For /home/ss5/perl5/perlbrew/perls/perl-5.22.0/bin/benchmarkanything-storage
  Run on Mon Jan 29 16:55:34 2018
Reported on Mon Jan 29 16:57:07 2018

Filename/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/5.22.0/HTTP/Tiny.pm
StatementsExecuted 556813 statements in 18.6s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
50041117.3s17.3sHTTP::Tiny::Handle::::CORE:sselectHTTP::Tiny::Handle::CORE:sselect (opcode)
200211142ms19.3sHTTP::Tiny::::_request HTTP::Tiny::_request
200211104ms150msHTTP::Tiny::Handle::::read_header_linesHTTP::Tiny::Handle::read_header_lines
30022175.7ms195msHTTP::Tiny::Handle::::writeHTTP::Tiny::Handle::write
90082173.1ms17.4sHTTP::Tiny::Handle::::readlineHTTP::Tiny::Handle::readline
50042172.0ms17.3sHTTP::Tiny::Handle::::_do_timeoutHTTP::Tiny::Handle::_do_timeout
20021170.4ms953msHTTP::Tiny::Handle::::connectHTTP::Tiny::Handle::connect
30021153.7ms53.7msHTTP::Tiny::Handle::::CORE:syswriteHTTP::Tiny::Handle::CORE:syswrite (opcode)
20021144.4ms17.6sHTTP::Tiny::Handle::::read_response_headerHTTP::Tiny::Handle::read_response_header
20021142.6ms198msHTTP::Tiny::Handle::::write_header_linesHTTP::Tiny::Handle::write_header_lines
20021141.3ms42.8msHTTP::Tiny::::_prepare_headers_and_cb HTTP::Tiny::_prepare_headers_and_cb
20021138.6ms38.6msHTTP::Tiny::::__ANON__[:85] HTTP::Tiny::__ANON__[:85]
10001137.0ms82.5msHTTP::Tiny::Handle::::write_content_bodyHTTP::Tiny::Handle::write_content_body
20021136.7ms48.6msHTTP::Tiny::::_split_url HTTP::Tiny::_split_url
20021129.9ms1.00sHTTP::Tiny::::_open_handle HTTP::Tiny::_open_handle
20021129.7ms19.3sHTTP::Tiny::::request HTTP::Tiny::request
10011128.8ms65.8msHTTP::Tiny::::new HTTP::Tiny::new
20021127.7ms17.3sHTTP::Tiny::Handle::::can_readHTTP::Tiny::Handle::can_read
20021126.1ms27.3msHTTP::Tiny::::_maybe_redirect HTTP::Tiny::_maybe_redirect
10011125.8ms38.5msHTTP::Tiny::Handle::::read_content_bodyHTTP::Tiny::Handle::read_content_body
30021124.9ms64.9msHTTP::Tiny::Handle::::can_writeHTTP::Tiny::Handle::can_write
110142124.7ms24.7msHTTP::Tiny::Handle::::CORE:substHTTP::Tiny::Handle::CORE:subst (opcode)
160195122.4ms22.4msHTTP::Tiny::Handle::::CORE:matchHTTP::Tiny::Handle::CORE:match (opcode)
20021122.1ms22.1msHTTP::Tiny::Handle::::newHTTP::Tiny::Handle::new
20021120.7ms24.0msHTTP::Tiny::Handle::::_get_tidHTTP::Tiny::Handle::_get_tid
20021118.2ms18.2msHTTP::Tiny::Handle::::CORE:sysreadHTTP::Tiny::Handle::CORE:sysread (opcode)
10011116.3ms55.1msHTTP::Tiny::Handle::::read_bodyHTTP::Tiny::Handle::read_body
20021115.4ms312msHTTP::Tiny::Handle::::write_requestHTTP::Tiny::Handle::write_request
10011113.0ms13.0msHTTP::Tiny::::_set_proxies HTTP::Tiny::_set_proxies
20021110.7ms208msHTTP::Tiny::Handle::::write_request_headerHTTP::Tiny::Handle::write_request_header
80085110.1ms10.1msHTTP::Tiny::::CORE:match HTTP::Tiny::CORE:match (opcode)
1001119.88ms9.88msHTTP::Tiny::::_prepare_data_cb HTTP::Tiny::_prepare_data_cb
1001119.80ms9.80msHTTP::Tiny::Handle::::readHTTP::Tiny::Handle::read
1001119.16ms18.1msHTTP::Tiny::::_agent HTTP::Tiny::_agent
1000115.67ms88.1msHTTP::Tiny::Handle::::write_bodyHTTP::Tiny::Handle::write_body
3003215.55ms5.55msHTTP::Tiny::::CORE:subst HTTP::Tiny::CORE:subst (opcode)
1001115.40ms5.88msHTTP::Tiny::::agent HTTP::Tiny::agent
2000114.50ms4.50msHTTP::Tiny::::__ANON__[:692] HTTP::Tiny::__ANON__[:692]
1001112.92ms2.92msHTTP::Tiny::::__ANON__[:734] HTTP::Tiny::__ANON__[:734]
2002112.84ms2.84msHTTP::Tiny::Handle::::CORE:binmodeHTTP::Tiny::Handle::CORE:binmode (opcode)
1112.63ms13.6msHTTP::Tiny::Handle::::BEGIN@866HTTP::Tiny::Handle::BEGIN@866
111446µs710µsHTTP::Tiny::Handle::::BEGIN@865HTTP::Tiny::Handle::BEGIN@865
11128µs28µsHTTP::Tiny::::BEGIN@66 HTTP::Tiny::BEGIN@66
11124µs24µsHTTP::Tiny::Handle::::CORE:regcompHTTP::Tiny::Handle::CORE:regcomp (opcode)
11117µs34µsHTTP::Tiny::Handle::::BEGIN@1418HTTP::Tiny::Handle::BEGIN@1418
1119µs11µsHTTP::Tiny::::BEGIN@853 HTTP::Tiny::BEGIN@853
1118µs9µsHTTP::Tiny::::BEGIN@3 HTTP::Tiny::BEGIN@3
1117µs8µsHTTP::Tiny::Handle::::BEGIN@862HTTP::Tiny::Handle::BEGIN@862
11117µs7µsHTTP::Tiny::Handle::::CORE:substcontHTTP::Tiny::Handle::CORE:substcont (opcode)
1116µs29µsHTTP::Tiny::Handle::::BEGIN@863HTTP::Tiny::Handle::BEGIN@863
1115µs12µsHTTP::Tiny::::BEGIN@195 HTTP::Tiny::BEGIN@195
1114µs14µsHTTP::Tiny::::BEGIN@75 HTTP::Tiny::BEGIN@75
1114µs11µsHTTP::Tiny::::BEGIN@76 HTTP::Tiny::BEGIN@76
1114µs6µsHTTP::Tiny::::BEGIN@4 HTTP::Tiny::BEGIN@4
1112µs2µsHTTP::Tiny::::BEGIN@9 HTTP::Tiny::BEGIN@9
1112µs2µsHTTP::Tiny::::CORE:qr HTTP::Tiny::CORE:qr (opcode)
111900ns900nsHTTP::Tiny::Handle::::CORE:qrHTTP::Tiny::Handle::CORE:qr (opcode)
0000s0sHTTP::Tiny::Handle::::__ANON__[:885]HTTP::Tiny::Handle::__ANON__[:885]
0000s0sHTTP::Tiny::Handle::::__ANON__[:957]HTTP::Tiny::Handle::__ANON__[:957]
0000s0sHTTP::Tiny::Handle::::_assert_sslHTTP::Tiny::Handle::_assert_ssl
0000s0sHTTP::Tiny::Handle::::_find_CA_fileHTTP::Tiny::Handle::_find_CA_file
0000s0sHTTP::Tiny::Handle::::_ssl_argsHTTP::Tiny::Handle::_ssl_args
0000s0sHTTP::Tiny::Handle::::can_reuseHTTP::Tiny::Handle::can_reuse
0000s0sHTTP::Tiny::Handle::::closeHTTP::Tiny::Handle::close
0000s0sHTTP::Tiny::Handle::::read_chunked_bodyHTTP::Tiny::Handle::read_chunked_body
0000s0sHTTP::Tiny::Handle::::start_sslHTTP::Tiny::Handle::start_ssl
0000s0sHTTP::Tiny::Handle::::write_chunked_bodyHTTP::Tiny::Handle::write_chunked_body
0000s0sHTTP::Tiny::::__ANON__[:284] HTTP::Tiny::__ANON__[:284]
0000s0sHTTP::Tiny::::__ANON__[:731] HTTP::Tiny::__ANON__[:731]
0000s0sHTTP::Tiny::::_add_basic_auth_header HTTP::Tiny::_add_basic_auth_header
0000s0sHTTP::Tiny::::_create_proxy_tunnel HTTP::Tiny::_create_proxy_tunnel
0000s0sHTTP::Tiny::::_http_date HTTP::Tiny::_http_date
0000s0sHTTP::Tiny::::_parse_http_date HTTP::Tiny::_parse_http_date
0000s0sHTTP::Tiny::::_proxy_connect HTTP::Tiny::_proxy_connect
0000s0sHTTP::Tiny::::_split_proxy HTTP::Tiny::_split_proxy
0000s0sHTTP::Tiny::::_update_cookie_jar HTTP::Tiny::_update_cookie_jar
0000s0sHTTP::Tiny::::_uri_escape HTTP::Tiny::_uri_escape
0000s0sHTTP::Tiny::::_validate_cookie_jar HTTP::Tiny::_validate_cookie_jar
0000s0sHTTP::Tiny::::mirror HTTP::Tiny::mirror
0000s0sHTTP::Tiny::::post_form HTTP::Tiny::post_form
0000s0sHTTP::Tiny::::www_form_urlencode HTTP::Tiny::www_form_urlencode
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1# vim: ts=4 sts=4 sw=4 et:
2package HTTP::Tiny;
3213µs210µs
# spent 9µs (8+1) within HTTP::Tiny::BEGIN@3 which was called: # once (8µs+1µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 3
use strict;
# spent 9µs making 1 call to HTTP::Tiny::BEGIN@3 # spent 1µs making 1 call to strict::import
4219µs29µs
# spent 6µs (4+3) within HTTP::Tiny::BEGIN@4 which was called: # once (4µs+3µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 4
use warnings;
# spent 6µs making 1 call to HTTP::Tiny::BEGIN@4 # spent 3µs making 1 call to warnings::import
5# ABSTRACT: A small, simple, correct HTTP/1.1 client
6
71400nsour $VERSION = '0.054';
8
9256µs12µs
# spent 2µs within HTTP::Tiny::BEGIN@9 which was called: # once (2µs+0s) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 9
use Carp ();
# spent 2µs making 1 call to HTTP::Tiny::BEGIN@9
10
11#pod =method new
12#pod
13#pod $http = HTTP::Tiny->new( %attributes );
14#pod
15#pod This constructor returns a new HTTP::Tiny object. Valid attributes include:
16#pod
17#pod =for :list
18#pod * C<agent> —
19#pod A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If C<agent> — ends in a space character, the default user-agent string is appended.
20#pod * C<cookie_jar> —
21#pod An instance of L<HTTP::CookieJar> — or equivalent class that supports the C<add> and C<cookie_header> methods
22#pod * C<default_headers> —
23#pod A hashref of default headers to apply to requests
24#pod * C<local_address> —
25#pod The local IP address to bind to
26#pod * C<keep_alive> —
27#pod Whether to reuse the last connection (if for the same scheme, host and port) (defaults to 1)
28#pod * C<max_redirect> —
29#pod Maximum number of redirects allowed (defaults to 5)
30#pod * C<max_size> —
31#pod Maximum response size (only when not using a data callback). If defined, responses larger than this will return an exception.
32#pod * C<http_proxy> —
33#pod URL of a proxy server to use for HTTP connections (default is C<$ENV{http_proxy}> — if set)
34#pod * C<https_proxy> —
35#pod URL of a proxy server to use for HTTPS connections (default is C<$ENV{https_proxy}> — if set)
36#pod * C<proxy> —
37#pod URL of a generic proxy server for both HTTP and HTTPS connections (default is C<$ENV{all_proxy}> — if set)
38#pod * C<no_proxy> —
39#pod List of domain suffixes that should not be proxied. Must be a comma-separated string or an array reference. (default is C<$ENV{no_proxy}> —)
40#pod * C<timeout> —
41#pod Request timeout in seconds (default is 60)
42#pod * C<verify_SSL> —
43#pod A boolean that indicates whether to validate the SSL certificate of an C<https> —
44#pod connection (default is false)
45#pod * C<SSL_options> —
46#pod A hashref of C<SSL_*> — options to pass through to L<IO::Socket::SSL>
47#pod
48#pod Passing an explicit C<undef> for C<proxy>, C<http_proxy> or C<https_proxy> will
49#pod prevent getting the corresponding proxies from the environment.
50#pod
51#pod Exceptions from C<max_size>, C<timeout> or other errors will result in a
52#pod pseudo-HTTP status code of 599 and a reason of "Internal Exception". The
53#pod content field in the response will contain the text of the exception.
54#pod
55#pod The C<keep_alive> parameter enables a persistent connection, but only to a
56#pod single destination scheme, host and port. Also, if any connection-relevant
57#pod attributes are modified, or if the process ID or thread ID change, the
58#pod persistent connection will be dropped. If you want persistent connections
59#pod across multiple destinations, use multiple HTTP::Tiny objects.
60#pod
61#pod See L</SSL SUPPORT> for more on the C<verify_SSL> and C<SSL_options> attributes.
62#pod
63#pod =cut
64
651200nsmy @attributes;
66
# spent 28µs within HTTP::Tiny::BEGIN@66 which was called: # once (28µs+0s) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 87
BEGIN {
6711µs @attributes = qw(
68 cookie_jar default_headers http_proxy https_proxy keep_alive
69 local_address max_redirect max_size proxy no_proxy timeout
70 SSL_options verify_SSL
71 );
7213µs my %persist_ok = map {; $_ => 1 } qw(
73 cookie_jar default_headers max_redirect max_size
74 );
75215µs223µs
# spent 14µs (4+10) within HTTP::Tiny::BEGIN@75 which was called: # once (4µs+10µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 75
no strict 'refs';
# spent 14µs making 1 call to HTTP::Tiny::BEGIN@75 # spent 10µs making 1 call to strict::unimport
76260µs219µs
# spent 11µs (4+7) within HTTP::Tiny::BEGIN@76 which was called: # once (4µs+7µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 76
no warnings 'uninitialized';
# spent 11µs making 1 call to HTTP::Tiny::BEGIN@76 # spent 7µs making 1 call to warnings::unimport
7713µs for my $accessor ( @attributes ) {
78
# spent 38.6ms within HTTP::Tiny::__ANON__[/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/5.22.0/HTTP/Tiny.pm:85] which was called 2002 times, avg 19µs/call: # 2002 times (38.6ms+0s) by Search::Elasticsearch::Cxn::HTTPTiny::perform_request at line 32 of Search/Elasticsearch/Cxn/HTTPTiny.pm, avg 19µs/call
*{$accessor} = sub {
79 @_ > 1
80 ? do {
81200232.8ms delete $_[0]->{handle} if !$persist_ok{$accessor} && $_[1] ne $_[0]->{$accessor};
8220021.81ms $_[0]->{$accessor} = $_[1]
83 }
84200226.1ms : $_[0]->{$accessor};
851322µs };
86 }
871251µs128µs}
# spent 28µs making 1 call to HTTP::Tiny::BEGIN@66
88
89
# spent 5.88ms (5.40+481µs) within HTTP::Tiny::agent which was called 1001 times, avg 6µs/call: # 1001 times (5.40ms+481µs) by HTTP::Tiny::new at line 117, avg 6µs/call
sub agent {
901001508µs my($self, $agent) = @_;
911001821µs if( @_ > 1 ){
92 $self->{agent} =
9310013.15ms1001481µs (defined $agent && $agent =~ / $/) ? $agent . $self->_agent : $agent;
# spent 481µs making 1001 calls to HTTP::Tiny::CORE:match, avg 481ns/call
94 }
9510011.88ms return $self->{agent};
96}
97
98
# spent 65.8ms (28.8+37.0) within HTTP::Tiny::new which was called 1001 times, avg 66µs/call: # 1001 times (28.8ms+37.0ms) by Search::Elasticsearch::Cxn::HTTPTiny::_build_handle at line 69 of Search/Elasticsearch/Cxn/HTTPTiny.pm, avg 66µs/call
sub new {
991001889µs my($class, %args) = @_;
100
101 my $self = {
102 max_redirect => 5,
103 timeout => 60,
104 keep_alive => 1,
105 verify_SSL => $args{verify_SSL} || $args{verify_ssl} || 0, # no verification by default
106 no_proxy => $ENV{no_proxy},
10710014.53ms };
108
1091001572µs bless $self, $class;
110
1111001498µs $class->_validate_cookie_jar( $args{cookie_jar} ) if $args{cookie_jar};
112
1131001895µs for my $key ( @attributes ) {
114130134.96ms $self->{$key} = $args{$key} if exists $args{$key}
115 }
116
11710014.76ms200224.0ms $self->agent( exists $args{agent} ? $args{agent} : $class->_agent );
# spent 18.1ms making 1001 calls to HTTP::Tiny::_agent, avg 18µs/call # spent 5.88ms making 1001 calls to HTTP::Tiny::agent, avg 6µs/call
118
11910011.83ms100113.0ms $self->_set_proxies;
# spent 13.0ms making 1001 calls to HTTP::Tiny::_set_proxies, avg 13µs/call
120
12110018.16ms return $self;
122}
123
124
# spent 13.0ms within HTTP::Tiny::_set_proxies which was called 1001 times, avg 13µs/call: # 1001 times (13.0ms+0s) by HTTP::Tiny::new at line 119, avg 13µs/call
sub _set_proxies {
1251001432µs my ($self) = @_;
126
127 # get proxies from %ENV only if not provided; explicit undef will disable
128 # getting proxies from the environment
129
130 # generic proxy
13110012.41ms if (! exists $self->{proxy} ) {
132 $self->{proxy} = $ENV{all_proxy} || $ENV{ALL_PROXY};
133 }
134
1351001751µs if ( defined $self->{proxy} ) {
136 $self->_split_proxy( 'generic proxy' => $self->{proxy} ); # validate
137 }
138 else {
1391001597µs delete $self->{proxy};
140 }
141
142 # http proxy
1431001525µs if (! exists $self->{http_proxy} ) {
144 # under CGI, bypass HTTP_PROXY as request sets it from Proxy header
1451001699µs local $ENV{HTTP_PROXY} if $ENV{REQUEST_METHOD};
14610011.26ms $self->{http_proxy} = $ENV{http_proxy} || $ENV{HTTP_PROXY} || $self->{proxy};
147 }
148
1491001650µs if ( defined $self->{http_proxy} ) {
150 $self->_split_proxy( http_proxy => $self->{http_proxy} ); # validate
151 $self->{_has_proxy}{http} = 1;
152 }
153 else {
1541001280µs delete $self->{http_proxy};
155 }
156
157 # https proxy
15810011.65ms if (! exists $self->{https_proxy} ) {
159 $self->{https_proxy} = $ENV{https_proxy} || $ENV{HTTPS_PROXY} || $self->{proxy};
160 }
161
1621001509µs if ( $self->{https_proxy} ) {
163 $self->_split_proxy( https_proxy => $self->{https_proxy} ); # validate
164 $self->{_has_proxy}{https} = 1;
165 }
166 else {
1671001342µs delete $self->{https_proxy};
168 }
169
170 # Split no_proxy to array reference if not provided as such
1711001744µs unless ( ref $self->{no_proxy} eq 'ARRAY' ) {
172 $self->{no_proxy} =
17310011.00ms (defined $self->{no_proxy}) ? [ split /\s*,\s*/, $self->{no_proxy} ] : [];
174 }
175
17610012.24ms return;
177}
178
179#pod =method get|head|put|post|delete
180#pod
181#pod $response = $http->get($url);
182#pod $response = $http->get($url, \%options);
183#pod $response = $http->head($url);
184#pod
185#pod These methods are shorthand for calling C<request()> for the given method. The
186#pod URL must have unsafe characters escaped and international domain names encoded.
187#pod See C<request()> for valid options and a description of the response.
188#pod
189#pod The C<success> field of the response will be true if the status code is 2XX.
190#pod
191#pod =cut
192
1931500nsfor my $sub_name ( qw/get head put post delete/ ) {
19452µs my $req_method = uc $sub_name;
19521.69ms219µs
# spent 12µs (5+7) within HTTP::Tiny::BEGIN@195 which was called: # once (5µs+7µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 195
no strict 'refs';
# spent 12µs making 1 call to HTTP::Tiny::BEGIN@195 # spent 7µs making 1 call to strict::unimport
1965186µs eval <<"HERE"; ## no critic
197 sub $sub_name {
198 my (\$self, \$url, \$args) = \@_;
199 \@_ == 2 || (\@_ == 3 && ref \$args eq 'HASH')
200 or Carp::croak(q/Usage: \$http->$sub_name(URL, [HASHREF])/ . "\n");
201 return \$self->request('$req_method', \$url, \$args || {});
202 }
203HERE
204}
205
206#pod =method post_form
207#pod
208#pod $response = $http->post_form($url, $form_data);
209#pod $response = $http->post_form($url, $form_data, \%options);
210#pod
211#pod This method executes a C<POST> request and sends the key/value pairs from a
212#pod form data hash or array reference to the given URL with a C<content-type> of
213#pod C<application/x-www-form-urlencoded>. If data is provided as an array
214#pod reference, the order is preserved; if provided as a hash reference, the terms
215#pod are sorted on key and value for consistency. See documentation for the
216#pod C<www_form_urlencode> method for details on the encoding.
217#pod
218#pod The URL must have unsafe characters escaped and international domain names
219#pod encoded. See C<request()> for valid options and a description of the response.
220#pod Any C<content-type> header or content in the options hashref will be ignored.
221#pod
222#pod The C<success> field of the response will be true if the status code is 2XX.
223#pod
224#pod =cut
225
226sub post_form {
227 my ($self, $url, $data, $args) = @_;
228 (@_ == 3 || @_ == 4 && ref $args eq 'HASH')
229 or Carp::croak(q/Usage: $http->post_form(URL, DATAREF, [HASHREF])/ . "\n");
230
231 my $headers = {};
232 while ( my ($key, $value) = each %{$args->{headers} || {}} ) {
233 $headers->{lc $key} = $value;
234 }
235 delete $args->{headers};
236
237 return $self->request('POST', $url, {
238 %$args,
239 content => $self->www_form_urlencode($data),
240 headers => {
241 %$headers,
242 'content-type' => 'application/x-www-form-urlencoded'
243 },
244 }
245 );
246}
247
248#pod =method mirror
249#pod
250#pod $response = $http->mirror($url, $file, \%options)
251#pod if ( $response->{success} ) {
252#pod print "$file is up to date\n";
253#pod }
254#pod
255#pod Executes a C<GET> request for the URL and saves the response body to the file
256#pod name provided. The URL must have unsafe characters escaped and international
257#pod domain names encoded. If the file already exists, the request will include an
258#pod C<If-Modified-Since> header with the modification timestamp of the file. You
259#pod may specify a different C<If-Modified-Since> header yourself in the C<<
260#pod $options->{headers} >> hash.
261#pod
262#pod The C<success> field of the response will be true if the status code is 2XX
263#pod or if the status code is 304 (unmodified).
264#pod
265#pod If the file was modified and the server response includes a properly
266#pod formatted C<Last-Modified> header, the file modification time will
267#pod be updated accordingly.
268#pod
269#pod =cut
270
271sub mirror {
272 my ($self, $url, $file, $args) = @_;
273 @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
274 or Carp::croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/ . "\n");
275 if ( -e $file and my $mtime = (stat($file))[9] ) {
276 $args->{headers}{'if-modified-since'} ||= $self->_http_date($mtime);
277 }
278 my $tempfile = $file . int(rand(2**31));
279
280 require Fcntl;
281 sysopen my $fh, $tempfile, Fcntl::O_CREAT()|Fcntl::O_EXCL()|Fcntl::O_WRONLY()
282 or Carp::croak(qq/Error: Could not create temporary file $tempfile for downloading: $!\n/);
283 binmode $fh;
284 $args->{data_callback} = sub { print {$fh} $_[0] };
285 my $response = $self->request('GET', $url, $args);
286 close $fh
287 or Carp::croak(qq/Error: Caught error closing temporary file $tempfile: $!\n/);
288
289 if ( $response->{success} ) {
290 rename $tempfile, $file
291 or Carp::croak(qq/Error replacing $file with $tempfile: $!\n/);
292 my $lm = $response->{headers}{'last-modified'};
293 if ( $lm and my $mtime = $self->_parse_http_date($lm) ) {
294 utime $mtime, $mtime, $file;
295 }
296 }
297 $response->{success} ||= $response->{status} eq '304';
298 unlink $tempfile;
299 return $response;
300}
301
302#pod =method request
303#pod
304#pod $response = $http->request($method, $url);
305#pod $response = $http->request($method, $url, \%options);
306#pod
307#pod Executes an HTTP request of the given method type ('GET', 'HEAD', 'POST',
308#pod 'PUT', etc.) on the given URL. The URL must have unsafe characters escaped and
309#pod international domain names encoded.
310#pod
311#pod If the URL includes a "user:password" stanza, they will be used for Basic-style
312#pod authorization headers. (Authorization headers will not be included in a
313#pod redirected request.) For example:
314#pod
315#pod $http->request('GET', 'http://Aladdin:open sesame@example.com/');
316#pod
317#pod If the "user:password" stanza contains reserved characters, they must
318#pod be percent-escaped:
319#pod
320#pod $http->request('GET', 'http://john%40example.com:password@example.com/');
321#pod
322#pod A hashref of options may be appended to modify the request.
323#pod
324#pod Valid options are:
325#pod
326#pod =for :list
327#pod * C<headers> —
328#pod A hashref containing headers to include with the request. If the value for
329#pod a header is an array reference, the header will be output multiple times with
330#pod each value in the array. These headers over-write any default headers.
331#pod * C<content> —
332#pod A scalar to include as the body of the request OR a code reference
333#pod that will be called iteratively to produce the body of the request
334#pod * C<trailer_callback> —
335#pod A code reference that will be called if it exists to provide a hashref
336#pod of trailing headers (only used with chunked transfer-encoding)
337#pod * C<data_callback> —
338#pod A code reference that will be called for each chunks of the response
339#pod body received.
340#pod
341#pod The C<Host> header is generated from the URL in accordance with RFC 2616. It
342#pod is a fatal error to specify C<Host> in the C<headers> option. Other headers
343#pod may be ignored or overwritten if necessary for transport compliance.
344#pod
345#pod If the C<content> option is a code reference, it will be called iteratively
346#pod to provide the content body of the request. It should return the empty
347#pod string or undef when the iterator is exhausted.
348#pod
349#pod If the C<content> option is the empty string, no C<content-type> or
350#pod C<content-length> headers will be generated.
351#pod
352#pod If the C<data_callback> option is provided, it will be called iteratively until
353#pod the entire response body is received. The first argument will be a string
354#pod containing a chunk of the response body, the second argument will be the
355#pod in-progress response hash reference, as described below. (This allows
356#pod customizing the action of the callback based on the C<status> or C<headers>
357#pod received prior to the content body.)
358#pod
359#pod The C<request> method returns a hashref containing the response. The hashref
360#pod will have the following keys:
361#pod
362#pod =for :list
363#pod * C<success> —
364#pod Boolean indicating whether the operation returned a 2XX status code
365#pod * C<url> —
366#pod URL that provided the response. This is the URL of the request unless
367#pod there were redirections, in which case it is the last URL queried
368#pod in a redirection chain
369#pod * C<status> —
370#pod The HTTP status code of the response
371#pod * C<reason> —
372#pod The response phrase returned by the server
373#pod * C<content> —
374#pod The body of the response. If the response does not have any content
375#pod or if a data callback is provided to consume the response body,
376#pod this will be the empty string
377#pod * C<headers> —
378#pod A hashref of header fields. All header field names will be normalized
379#pod to be lower case. If a header is repeated, the value will be an arrayref;
380#pod it will otherwise be a scalar string containing the value
381#pod
382#pod On an exception during the execution of the request, the C<status> field will
383#pod contain 599, and the C<content> field will contain the text of the exception.
384#pod
385#pod =cut
386
38716µsmy %idempotent = map { $_ => 1 } qw/GET HEAD PUT DELETE OPTIONS TRACE/;
388
389
# spent 19.3s (29.7ms+19.3) within HTTP::Tiny::request which was called 2002 times, avg 9.63ms/call: # 2002 times (29.7ms+19.3s) by Search::Elasticsearch::Cxn::HTTPTiny::perform_request at line 34 of Search/Elasticsearch/Cxn/HTTPTiny.pm, avg 9.63ms/call
sub request {
39020021.40ms my ($self, $method, $url, $args) = @_;
39120022.94ms @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
392 or Carp::croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/ . "\n");
3932002570µs $args ||= {}; # we keep some state in this during _request
394
395 # RFC 2616 Section 8.1.4 mandates a single retry on broken socket
3962002339µs my $response;
39720022.88ms for ( 0 .. 1 ) {
39840046.33ms200219.3s $response = eval { $self->_request($method, $url, $args) };
# spent 19.3s making 2002 calls to HTTP::Tiny::_request, avg 9.62ms/call
39920021.86ms last unless $@ && $idempotent{$method}
400 && $@ =~ m{^(?:Socket closed|Unexpected end)};
401 }
402
40320021.38ms if (my $e = $@) {
404 # maybe we got a response hash thrown from somewhere deep
405 if ( ref $e eq 'HASH' && exists $e->{status} ) {
406 return $e;
407 }
408
409 # otherwise, stringify it
410 $e = "$e";
411 $response = {
412 url => $url,
413 success => q{},
414 status => 599,
415 reason => 'Internal Exception',
416 content => $e,
417 headers => {
418 'content-type' => 'text/plain',
419 'content-length' => length $e,
420 }
421 };
422 }
423200218.5ms return $response;
424}
425
426#pod =method www_form_urlencode
427#pod
428#pod $params = $http->www_form_urlencode( $data );
429#pod $response = $http->get("http://example.com/query?$params");
430#pod
431#pod This method converts the key/value pairs from a data hash or array reference
432#pod into a C<x-www-form-urlencoded> string. The keys and values from the data
433#pod reference will be UTF-8 encoded and escaped per RFC 3986. If a value is an
434#pod array reference, the key will be repeated with each of the values of the array
435#pod reference. If data is provided as a hash reference, the key/value pairs in the
436#pod resulting string will be sorted by key and value for consistent ordering.
437#pod
438#pod =cut
439
440sub www_form_urlencode {
441 my ($self, $data) = @_;
442 (@_ == 2 && ref $data)
443 or Carp::croak(q/Usage: $http->www_form_urlencode(DATAREF)/ . "\n");
444 (ref $data eq 'HASH' || ref $data eq 'ARRAY')
445 or Carp::croak("form data must be a hash or array reference\n");
446
447 my @params = ref $data eq 'HASH' ? %$data : @$data;
448 @params % 2 == 0
449 or Carp::croak("form data reference must have an even number of terms\n");
450
451 my @terms;
452 while( @params ) {
453 my ($key, $value) = splice(@params, 0, 2);
454 if ( ref $value eq 'ARRAY' ) {
455 unshift @params, map { $key => $_ } @$value;
456 }
457 else {
458 push @terms, join("=", map { $self->_uri_escape($_) } $key, $value);
459 }
460 }
461
462 return join("&", (ref $data eq 'ARRAY') ? (@terms) : (sort @terms) );
463}
464
465#--------------------------------------------------------------------------#
466# private methods
467#--------------------------------------------------------------------------#
468
46911µsmy %DefaultPort = (
470 http => 80,
471 https => 443,
472);
473
474
# spent 18.1ms (9.16+8.98) within HTTP::Tiny::_agent which was called 1001 times, avg 18µs/call: # 1001 times (9.16ms+8.98ms) by HTTP::Tiny::new at line 117, avg 18µs/call
sub _agent {
4751001757µs my $class = ref($_[0]) || $_[0];
47610014.18ms10011.58ms (my $default_agent = $class) =~ s{::}{-}g;
# spent 1.58ms making 1001 calls to HTTP::Tiny::CORE:subst, avg 2µs/call
477100119.7ms10017.39ms return $default_agent . "/" . $class->VERSION;
# spent 7.39ms making 1001 calls to UNIVERSAL::VERSION, avg 7µs/call
478}
479
480
# spent 19.3s (142ms+19.1) within HTTP::Tiny::_request which was called 2002 times, avg 9.62ms/call: # 2002 times (142ms+19.1s) by HTTP::Tiny::request at line 398, avg 9.62ms/call
sub _request {
4812002962µs my ($self, $method, $url, $args) = @_;
482
48320025.87ms200248.6ms my ($scheme, $host, $port, $path_query, $auth) = $self->_split_url($url);
# spent 48.6ms making 2002 calls to HTTP::Tiny::_split_url, avg 24µs/call
484
485 my $request = {
486 method => $method,
487 scheme => $scheme,
488 host => $host,
489 port => $port,
490200211.5ms host_port => ($port == $DefaultPort{$scheme} ? $host : "$host:$port"),
491 uri => $path_query,
492 headers => {},
493 };
494
495 # We remove the cached handle so it is not reused in the case of redirect.
496 # If all is well, it will be recached at the end of _request. We only
497 # reuse for the same scheme, host and port
49820021.31ms my $handle = delete $self->{handle};
4992002831µs if ( $handle ) {
500 unless ( $handle->can_reuse( $scheme, $host, $port ) ) {
501 $handle->close;
502 undef $handle;
503 }
504 }
50520024.55ms20021.00s $handle ||= $self->_open_handle( $request, $scheme, $host, $port );
# spent 1.00s making 2002 calls to HTTP::Tiny::_open_handle, avg 502µs/call
506
50720024.93ms200242.8ms $self->_prepare_headers_and_cb($request, $args, $url, $auth);
# spent 42.8ms making 2002 calls to HTTP::Tiny::_prepare_headers_and_cb, avg 21µs/call
50820024.00ms2002312ms $handle->write_request($request);
# spent 312ms making 2002 calls to HTTP::Tiny::Handle::write_request, avg 156µs/call
509
5102002483µs my $response;
511 do { $response = $handle->read_response_header }
51220029.56ms200217.6s until (substr($response->{status},0,1) ne '1');
# spent 17.6s making 2002 calls to HTTP::Tiny::Handle::read_response_header, avg 8.80ms/call
513
51420021.47ms $self->_update_cookie_jar( $url, $response ) if $self->{cookie_jar};
515
51620028.24ms200227.3ms if ( my @redir_args = $self->_maybe_redirect($request, $response, $args) ) {
# spent 27.3ms making 2002 calls to HTTP::Tiny::_maybe_redirect, avg 14µs/call
517 $handle->close;
518 return $self->_request(@redir_args, $args);
519 }
520
5212002577µs my $known_message_length;
52220024.47ms1001618µs if ($method eq 'HEAD' || $response->{status} =~ /^[23]04/) {
# spent 618µs making 1001 calls to HTTP::Tiny::CORE:match, avg 617ns/call
523 # response has no message body
524 $known_message_length = 1;
525 }
526 else {
52710012.64ms10019.88ms my $data_cb = $self->_prepare_data_cb($response, $args);
# spent 9.88ms making 1001 calls to HTTP::Tiny::_prepare_data_cb, avg 10µs/call
52810015.05ms100155.1ms $known_message_length = $handle->read_body($data_cb, $response);
# spent 55.1ms making 1001 calls to HTTP::Tiny::Handle::read_body, avg 55µs/call
529 }
530
53120025.66ms if ( $self->{keep_alive}
532 && $known_message_length
533 && $response->{protocol} eq 'HTTP/1.1'
534 && ($response->{headers}{connection} || '') ne 'close'
535 ) {
536 $self->{handle} = $handle;
537 }
538 else {
539 $handle->close;
540 }
541
54220022.94ms $response->{success} = substr( $response->{status}, 0, 1 ) eq '2';
54320021.17ms $response->{url} = $url;
544200221.7ms return $response;
545}
546
547
# spent 1.00s (29.9ms+975ms) within HTTP::Tiny::_open_handle which was called 2002 times, avg 502µs/call: # 2002 times (29.9ms+975ms) by HTTP::Tiny::_request at line 505, avg 502µs/call
sub _open_handle {
54820021.39ms my ($self, $request, $scheme, $host, $port) = @_;
549
550 my $handle = HTTP::Tiny::Handle->new(
551 timeout => $self->{timeout},
552 SSL_options => $self->{SSL_options},
553 verify_SSL => $self->{verify_SSL},
554 local_address => $self->{local_address},
555 keep_alive => $self->{keep_alive}
556200215.7ms200222.1ms );
# spent 22.1ms making 2002 calls to HTTP::Tiny::Handle::new, avg 11µs/call
557
55820021.99ms if ($self->{_has_proxy}{$scheme} && ! grep { $host =~ /\Q$_\E$/ } @{$self->{no_proxy}}) {
559 return $self->_proxy_connect( $request, $handle );
560 }
561 else {
562200216.7ms2002953ms return $handle->connect($scheme, $host, $port);
# spent 953ms making 2002 calls to HTTP::Tiny::Handle::connect, avg 476µs/call
563 }
564}
565
566sub _proxy_connect {
567 my ($self, $request, $handle) = @_;
568
569 my @proxy_vars;
570 if ( $request->{scheme} eq 'https' ) {
571 Carp::croak(qq{No https_proxy defined}) unless $self->{https_proxy};
572 @proxy_vars = $self->_split_proxy( https_proxy => $self->{https_proxy} );
573 if ( $proxy_vars[0] eq 'https' ) {
574 Carp::croak(qq{Can't proxy https over https: $request->{uri} via $self->{https_proxy}});
575 }
576 }
577 else {
578 Carp::croak(qq{No http_proxy defined}) unless $self->{http_proxy};
579 @proxy_vars = $self->_split_proxy( http_proxy => $self->{http_proxy} );
580 }
581
582 my ($p_scheme, $p_host, $p_port, $p_auth) = @proxy_vars;
583
584 if ( length $p_auth && ! defined $request->{headers}{'proxy-authorization'} ) {
585 $self->_add_basic_auth_header( $request, 'proxy-authorization' => $p_auth );
586 }
587
588 $handle->connect($p_scheme, $p_host, $p_port);
589
590 if ($request->{scheme} eq 'https') {
591 $self->_create_proxy_tunnel( $request, $handle );
592 }
593 else {
594 # non-tunneled proxy requires absolute URI
595 $request->{uri} = "$request->{scheme}://$request->{host_port}$request->{uri}";
596 }
597
598 return $handle;
599}
600
601sub _split_proxy {
602 my ($self, $type, $proxy) = @_;
603
604 my ($scheme, $host, $port, $path_query, $auth) = eval { $self->_split_url($proxy) };
605
606 unless(
607 defined($scheme) && length($scheme) && length($host) && length($port)
608 && $path_query eq '/'
609 ) {
610 Carp::croak(qq{$type URL must be in format http[s]://[auth@]<host>:<port>/\n});
611 }
612
613 return ($scheme, $host, $port, $auth);
614}
615
616sub _create_proxy_tunnel {
617 my ($self, $request, $handle) = @_;
618
619 $handle->_assert_ssl;
620
621 my $agent = exists($request->{headers}{'user-agent'})
622 ? $request->{headers}{'user-agent'} : $self->{agent};
623
624 my $connect_request = {
625 method => 'CONNECT',
626 uri => "$request->{host}:$request->{port}",
627 headers => {
628 host => "$request->{host}:$request->{port}",
629 'user-agent' => $agent,
630 }
631 };
632
633 if ( $request->{headers}{'proxy-authorization'} ) {
634 $connect_request->{headers}{'proxy-authorization'} =
635 delete $request->{headers}{'proxy-authorization'};
636 }
637
638 $handle->write_request($connect_request);
639 my $response;
640 do { $response = $handle->read_response_header }
641 until (substr($response->{status},0,1) ne '1');
642
643 # if CONNECT failed, throw the response so it will be
644 # returned from the original request() method;
645 unless (substr($response->{status},0,1) eq '2') {
646 die $response;
647 }
648
649 # tunnel established, so start SSL handshake
650 $handle->start_ssl( $request->{host} );
651
652 return;
653}
654
655
# spent 42.8ms (41.3+1.48) within HTTP::Tiny::_prepare_headers_and_cb which was called 2002 times, avg 21µs/call: # 2002 times (41.3ms+1.48ms) by HTTP::Tiny::_request at line 507, avg 21µs/call
sub _prepare_headers_and_cb {
65620021.56ms my ($self, $request, $args, $url, $auth) = @_;
657
65820023.65ms for ($self->{default_headers}, $args->{headers}) {
65940041.51ms next unless defined;
66030028.45ms while (my ($k, $v) = each %$_) {
661 $request->{headers}{lc $k} = $v;
662 }
663 }
664
66520021.03ms if (exists $request->{headers}{'host'}) {
666 die(qq/The 'Host' header must not be provided as header option\n/);
667 }
668
66920021.96ms $request->{headers}{'host'} = $request->{host_port};
67020022.11ms $request->{headers}{'user-agent'} ||= $self->{agent};
671 $request->{headers}{'connection'} = "close"
6722002884µs unless $self->{keep_alive};
673
67420021.17ms if ( defined $args->{content} ) {
67510002.96ms if (ref $args->{content} eq 'CODE') {
676 $request->{headers}{'content-type'} ||= "application/octet-stream";
677 $request->{headers}{'transfer-encoding'} = 'chunked'
678 unless $request->{headers}{'content-length'}
679 || $request->{headers}{'transfer-encoding'};
680 $request->{cb} = $args->{content};
681 }
682 elsif ( length $args->{content} ) {
6831000679µs my $content = $args->{content};
68410001.09ms if ( $] ge '5.008' ) {
68510004.34ms10001.48ms utf8::downgrade($content, 1)
# spent 1.48ms making 1000 calls to utf8::downgrade, avg 1µs/call
686 or die(qq/Wide character in request message body\n/);
687 }
6881000616µs $request->{headers}{'content-type'} ||= "application/octet-stream";
689 $request->{headers}{'content-length'} = length $content
690 unless $request->{headers}{'content-length'}
69110001.51ms || $request->{headers}{'transfer-encoding'};
692300023.7ms
# spent 4.50ms within HTTP::Tiny::__ANON__[/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/5.22.0/HTTP/Tiny.pm:692] which was called 2000 times, avg 2µs/call: # 2000 times (4.50ms+0s) by HTTP::Tiny::Handle::write_content_body at line 1217, avg 2µs/call
$request->{cb} = sub { substr $content, 0, length $content, '' };
693 }
694 $request->{trailer_cb} = $args->{trailer_callback}
6951000641µs if ref $args->{trailer_callback} eq 'CODE';
696 }
697
698 ### If we have a cookie jar, then maybe add relevant cookies
6992002836µs if ( $self->{cookie_jar} ) {
700 my $cookies = $self->cookie_jar->cookie_header( $url );
701 $request->{headers}{cookie} = $cookies if length $cookies;
702 }
703
704 # if we have Basic auth parameters, add them
7052002998µs if ( length $auth && ! defined $request->{headers}{authorization} ) {
706 $self->_add_basic_auth_header( $request, 'authorization' => $auth );
707 }
708
709200216.6ms return;
710}
711
712sub _add_basic_auth_header {
713 my ($self, $request, $header, $auth) = @_;
714 require MIME::Base64;
715 $request->{headers}{$header} =
716 "Basic " . MIME::Base64::encode_base64($auth, "");
717 return;
718}
719
720
# spent 9.88ms within HTTP::Tiny::_prepare_data_cb which was called 1001 times, avg 10µs/call: # 1001 times (9.88ms+0s) by HTTP::Tiny::_request at line 527, avg 10µs/call
sub _prepare_data_cb {
7211001502µs my ($self, $response, $args) = @_;
7221001807µs my $data_cb = $args->{data_callback};
7231001969µs $response->{content} = '';
724
7251001758µs if (!$data_cb || $response->{status} !~ /^2/) {
7261001942µs if (defined $self->{max_size}) {
727 $data_cb = sub {
728 $_[1]->{content} .= $_[0];
729 die(qq/Size of response body exceeds the maximum allowed of $self->{max_size}\n/)
730 if length $_[1]->{content} > $self->{max_size};
731 };
732 }
733 else {
734200213.8ms
# spent 2.92ms within HTTP::Tiny::__ANON__[/home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/5.22.0/HTTP/Tiny.pm:734] which was called 1001 times, avg 3µs/call: # 1001 times (2.92ms+0s) by HTTP::Tiny::Handle::read_content_body at line 1199, avg 3µs/call
$data_cb = sub { $_[1]->{content} .= $_[0] };
735 }
736 }
73710012.15ms return $data_cb;
738}
739
740sub _update_cookie_jar {
741 my ($self, $url, $response) = @_;
742
743 my $cookies = $response->{headers}->{'set-cookie'};
744 return unless defined $cookies;
745
746 my @cookies = ref $cookies ? @$cookies : $cookies;
747
748 $self->cookie_jar->add( $url, $_ ) for @cookies;
749
750 return;
751}
752
753sub _validate_cookie_jar {
754 my ($class, $jar) = @_;
755
756 # duck typing
757 for my $method ( qw/add cookie_header/ ) {
758 Carp::croak(qq/Cookie jar must provide the '$method' method\n/)
759 unless ref($jar) && ref($jar)->can($method);
760 }
761
762 return;
763}
764
765
# spent 27.3ms (26.1+1.18) within HTTP::Tiny::_maybe_redirect which was called 2002 times, avg 14µs/call: # 2002 times (26.1ms+1.18ms) by HTTP::Tiny::_request at line 516, avg 14µs/call
sub _maybe_redirect {
76620021.42ms my ($self, $request, $response, $args) = @_;
76720021.30ms my $headers = $response->{headers};
76820022.81ms my ($status, $method) = ($response->{status}, $request->{method});
769200218.2ms20021.18ms if (($status eq '303' or ($status =~ /^30[127]/ && $method =~ /^GET|HEAD$/))
# spent 1.18ms making 2002 calls to HTTP::Tiny::CORE:match, avg 588ns/call
770 and $headers->{location}
771 and ++$args->{redirects} <= $self->{max_redirect}
772 ) {
773 my $location = ($headers->{location} =~ /^\//)
774 ? "$request->{scheme}://$request->{host_port}$headers->{location}"
775 : $headers->{location} ;
776 return (($status eq '303' ? 'GET' : $method), $location);
777 }
778200220.4ms return;
779}
780
781
# spent 48.6ms (36.7+11.8) within HTTP::Tiny::_split_url which was called 2002 times, avg 24µs/call: # 2002 times (36.7ms+11.8ms) by HTTP::Tiny::_request at line 483, avg 24µs/call
sub _split_url {
7822002843µs my $url = pop;
783
784 # URI regex adapted from the URI module
785200217.5ms20026.15ms my ($scheme, $host, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)>
# spent 6.15ms making 2002 calls to HTTP::Tiny::CORE:match, avg 3µs/call
786 or die(qq/Cannot parse URL: '$url'\n/);
787
78820021.76ms $scheme = lc $scheme;
78920029.64ms20021.70ms $path_query = "/$path_query" unless $path_query =~ m<\A/>;
# spent 1.70ms making 2002 calls to HTTP::Tiny::CORE:match, avg 851ns/call
790
7912002770µs my $auth = '';
79220022.44ms if ( (my $i = index $host, '@') != -1 ) {
793 # user:pass@host
794 $auth = substr $host, 0, $i, ''; # take up to the @ for auth
795 substr $host, 0, 1, ''; # knock the @ off the host
796
797 # userinfo might be percent escaped, so recover real auth info
798 $auth =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
799 }
80020029.84ms20023.97ms my $port = $host =~ s/:(\d*)\z// && length $1 ? $1
# spent 3.97ms making 2002 calls to HTTP::Tiny::CORE:subst, avg 2µs/call
801 : $scheme eq 'http' ? 80
802 : $scheme eq 'https' ? 443
803 : undef;
804
805200214.8ms return ($scheme, (length $host ? lc $host : "localhost") , $port, $path_query, $auth);
806}
807
808# Date conversions adapted from HTTP::Date
8091300nsmy $DoW = "Sun|Mon|Tue|Wed|Thu|Fri|Sat";
8101200nsmy $MoY = "Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec";
811sub _http_date {
812 my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($_[1]);
813 return sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
814 substr($DoW,$wday*4,3),
815 $mday, substr($MoY,$mon*4,3), $year+1900,
816 $hour, $min, $sec
817 );
818}
819
820sub _parse_http_date {
821 my ($self, $str) = @_;
822 require Time::Local;
823 my @tl_parts;
824 if ($str =~ /^[SMTWF][a-z]+, +(\d{1,2}) ($MoY) +(\d\d\d\d) +(\d\d):(\d\d):(\d\d) +GMT$/) {
825 @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
826 }
827 elsif ($str =~ /^[SMTWF][a-z]+, +(\d\d)-($MoY)-(\d{2,4}) +(\d\d):(\d\d):(\d\d) +GMT$/ ) {
828 @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
829 }
830 elsif ($str =~ /^[SMTWF][a-z]+ +($MoY) +(\d{1,2}) +(\d\d):(\d\d):(\d\d) +(?:[^0-9]+ +)?(\d\d\d\d)$/ ) {
831 @tl_parts = ($5, $4, $3, $2, (index($MoY,$1)/4), $6);
832 }
833 return eval {
834 my $t = @tl_parts ? Time::Local::timegm(@tl_parts) : -1;
835 $t < 0 ? undef : $t;
836 };
837}
838
839# URI escaping adapted from URI::Escape
840# c.f. http://www.w3.org/TR/html4/interact/forms.html#h-17.13.4.1
841# perl 5.6 ready UTF-8 encoding adapted from JSON::PP
842257207µsmy %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255;
8431400ns$escapes{' '}="+";
84418µs12µsmy $unsafe_char = qr/[^A-Za-z0-9\-\._~]/;
# spent 2µs making 1 call to HTTP::Tiny::CORE:qr
845
846sub _uri_escape {
847 my ($self, $str) = @_;
848 if ( $] ge '5.008' ) {
849 utf8::encode($str);
850 }
851 else {
852 $str = pack("U*", unpack("C*", $str)) # UTF-8 encode a byte string
853253µs213µs
# spent 11µs (9+2) within HTTP::Tiny::BEGIN@853 which was called: # once (9µs+2µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 853
if ( length $str == do { use bytes; length $str } );
# spent 11µs making 1 call to HTTP::Tiny::BEGIN@853 # spent 2µs making 1 call to bytes::import
854 $str = pack("C*", unpack("C*", $str)); # clear UTF-8 flag
855 }
856 $str =~ s/($unsafe_char)/$escapes{$1}/ge;
857 return $str;
858}
859
860package
861 HTTP::Tiny::Handle; # hide from PAUSE/indexers
862217µs29µs
# spent 8µs (7+1) within HTTP::Tiny::Handle::BEGIN@862 which was called: # once (7µs+1µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 862
use strict;
# spent 8µs making 1 call to HTTP::Tiny::Handle::BEGIN@862 # spent 1µs making 1 call to strict::import
863226µs251µs
# spent 29µs (6+23) within HTTP::Tiny::Handle::BEGIN@863 which was called: # once (6µs+23µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 863
use warnings;
# spent 29µs making 1 call to HTTP::Tiny::Handle::BEGIN@863 # spent 23µs making 1 call to warnings::import
864
865268µs2838µs
# spent 710µs (446+265) within HTTP::Tiny::Handle::BEGIN@865 which was called: # once (446µs+265µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 865
use Errno qw[EINTR EPIPE];
# spent 710µs making 1 call to HTTP::Tiny::Handle::BEGIN@865 # spent 127µs making 1 call to Exporter::import
86621.96ms218.3ms
# spent 13.6ms (2.63+11.0) within HTTP::Tiny::Handle::BEGIN@866 which was called: # once (2.63ms+11.0ms) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 866
use IO::Socket qw[SOCK_STREAM];
# spent 13.6ms making 1 call to HTTP::Tiny::Handle::BEGIN@866 # spent 4.69ms making 1 call to IO::Socket::import
867
868# PERL_HTTP_TINY_IPV4_ONLY is a private environment variable to force old
869# behavior if someone is unable to boostrap CPAN from a new perl install; it is
870# not intended for general, per-client use and may be removed in the future
871my $SOCKET_CLASS =
872 $ENV{PERL_HTTP_TINY_IPV4_ONLY} ? 'IO::Socket::INET' :
873376µs17µs eval { require IO::Socket::IP; IO::Socket::IP->VERSION(0.25) } ? 'IO::Socket::IP' :
# spent 7µs making 1 call to UNIVERSAL::VERSION
874 'IO::Socket::INET';
875
876sub BUFSIZE () { 32768 } ## no critic
877
878my $Printable = sub {
879 local $_ = shift;
880 s/\r/\\r/g;
881 s/\n/\\n/g;
882 s/\t/\\t/g;
883 s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
884 $_;
88512µs};
886
88714µs1900nsmy $Token = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]/;
# spent 900ns making 1 call to HTTP::Tiny::Handle::CORE:qr
888
889
# spent 22.1ms within HTTP::Tiny::Handle::new which was called 2002 times, avg 11µs/call: # 2002 times (22.1ms+0s) by HTTP::Tiny::_open_handle at line 556, avg 11µs/call
sub new {
89020026.38ms my ($class, %args) = @_;
891200217.2ms return bless {
892 rbuf => '',
893 timeout => 60,
894 max_line_size => 16384,
895 max_header_lines => 64,
896 verify_SSL => 0,
897 SSL_options => {},
898 %args
899 }, $class;
900}
901
902
# spent 953ms (70.4+882) within HTTP::Tiny::Handle::connect which was called 2002 times, avg 476µs/call: # 2002 times (70.4ms+882ms) by HTTP::Tiny::_open_handle at line 562, avg 476µs/call
sub connect {
90320021.03ms @_ == 4 || die(q/Usage: $handle->connect(scheme, host, port)/ . "\n");
90420021.20ms my ($self, $scheme, $host, $port) = @_;
905
90620022.02ms if ( $scheme eq 'https' ) {
907 $self->_assert_ssl;
908 }
909 elsif ( $scheme ne 'http' ) {
910 die(qq/Unsupported URL scheme '$scheme'\n/);
911 }
912 $self->{fh} = $SOCKET_CLASS->new(
913 PeerHost => $host,
914 PeerPort => $port,
915 $self->{local_address} ?
916 ( LocalAddr => $self->{local_address} ) : (),
917 Proto => 'tcp',
918 Type => SOCK_STREAM,
919 Timeout => $self->{timeout},
920 KeepAlive => !!$self->{keep_alive}
921200218.1ms2002856ms ) or die(qq/Could not connect to '$host:$port': $@\n/);
# spent 856ms making 2002 calls to IO::Socket::IP::new, avg 427µs/call
922
923 binmode($self->{fh})
924200220.4ms20022.84ms or die(qq/Could not binmode() socket: '$!'\n/);
# spent 2.84ms making 2002 calls to HTTP::Tiny::Handle::CORE:binmode, avg 1µs/call
925
92620021.24ms $self->start_ssl($host) if $scheme eq 'https';
927
92820021.83ms $self->{scheme} = $scheme;
92920021.07ms $self->{host} = $host;
93020021.72ms $self->{port} = $port;
93120022.24ms $self->{pid} = $$;
93220024.11ms200224.0ms $self->{tid} = _get_tid();
# spent 24.0ms making 2002 calls to HTTP::Tiny::Handle::_get_tid, avg 12µs/call
933
93420025.26ms return $self;
935}
936
937sub start_ssl {
938 my ($self, $host) = @_;
939
940 # As this might be used via CONNECT after an SSL session
941 # to a proxy, we shut down any existing SSL before attempting
942 # the handshake
943 if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
944 unless ( $self->{fh}->stop_SSL ) {
945 my $ssl_err = IO::Socket::SSL->errstr;
946 die(qq/Error halting prior SSL connection: $ssl_err/);
947 }
948 }
949
950 my $ssl_args = $self->_ssl_args($host);
951 IO::Socket::SSL->start_SSL(
952 $self->{fh},
953 %$ssl_args,
954 SSL_create_ctx_callback => sub {
955 my $ctx = shift;
956 Net::SSLeay::CTX_set_mode($ctx, Net::SSLeay::MODE_AUTO_RETRY());
957 },
958 );
959
960 unless ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
961 my $ssl_err = IO::Socket::SSL->errstr;
962 die(qq/SSL connection failed for $host: $ssl_err\n/);
963 }
964}
965
966sub close {
967 @_ == 1 || die(q/Usage: $handle->close()/ . "\n");
968 my ($self) = @_;
969 CORE::close($self->{fh})
970 or die(qq/Could not close socket: '$!'\n/);
971}
972
973
# spent 195ms (75.7+120) within HTTP::Tiny::Handle::write which was called 3002 times, avg 65µs/call: # 2002 times (57.8ms+97.1ms) by HTTP::Tiny::Handle::write_header_lines at line 1163, avg 77µs/call # 1000 times (17.8ms+22.7ms) by HTTP::Tiny::Handle::write_content_body at line 1227, avg 40µs/call
sub write {
9743002996µs @_ == 2 || die(q/Usage: $handle->write(buf)/ . "\n");
97530021.39ms my ($self, $buf) = @_;
976
97730021.95ms if ( $] ge '5.008' ) {
978300212.1ms30021.05ms utf8::downgrade($buf, 1)
# spent 1.05ms making 3002 calls to utf8::downgrade, avg 350ns/call
979 or die(qq/Wide character in write()\n/);
980 }
981
9823002907µs my $len = length $buf;
9833002904µs my $off = 0;
984
985300215.2ms local $SIG{PIPE} = 'IGNORE';
986
9873002539µs while () {
98830024.63ms300264.9ms $self->can_write
# spent 64.9ms making 3002 calls to HTTP::Tiny::Handle::can_write, avg 22µs/call
989 or die(qq/Timed out while waiting for socket to become ready for writing\n/);
990300266.8ms300253.7ms my $r = syswrite($self->{fh}, $buf, $len, $off);
# spent 53.7ms making 3002 calls to HTTP::Tiny::Handle::CORE:syswrite, avg 18µs/call
99130021.30ms if (defined $r) {
99230021.72ms $len -= $r;
9933002948µs $off += $r;
99430022.57ms last unless $len > 0;
995 }
996 elsif ($! == EPIPE) {
997 die(qq/Socket closed by remote server: $!\n/);
998 }
999 elsif ($! != EINTR) {
1000 if ($self->{fh}->can('errstr')){
1001 my $err = $self->{fh}->errstr();
1002 die (qq/Could not write to SSL socket: '$err'\n /);
1003 }
1004 else {
1005 die(qq/Could not write to socket: '$!'\n/);
1006 }
1007
1008 }
1009 }
1010300226.2ms return $off;
1011}
1012
1013
# spent 9.80ms within HTTP::Tiny::Handle::read which was called 1001 times, avg 10µs/call: # 1001 times (9.80ms+0s) by HTTP::Tiny::Handle::read_content_body at line 1199, avg 10µs/call
sub read {
10141001941µs @_ == 2 || @_ == 3 || die(q/Usage: $handle->read(len [, allow_partial])/ . "\n");
10151001575µs my ($self, $len, $allow_partial) = @_;
1016
10171001389µs my $buf = '';
10181001713µs my $got = length $self->{rbuf};
1019
10201001650µs if ($got) {
10211001592µs my $take = ($got < $len) ? $got : $len;
102210012.09ms $buf = substr($self->{rbuf}, 0, $take, '');
10231001776µs $len -= $take;
1024 }
1025
10261001905µs while ($len > 0) {
1027 $self->can_read
1028 or die(q/Timed out while waiting for socket to become ready for reading/ . "\n");
1029 my $r = sysread($self->{fh}, $buf, $len, length $buf);
1030 if (defined $r) {
1031 last unless $r;
1032 $len -= $r;
1033 }
1034 elsif ($! != EINTR) {
1035 if ($self->{fh}->can('errstr')){
1036 my $err = $self->{fh}->errstr();
1037 die (qq/Could not read from SSL socket: '$err'\n /);
1038 }
1039 else {
1040 die(qq/Could not read from socket: '$!'\n/);
1041 }
1042 }
1043 }
10441001342µs if ($len && !$allow_partial) {
1045 die(qq/Unexpected end of stream\n/);
1046 }
104710018.19ms return $buf;
1048}
1049
1050
# spent 17.4s (73.1ms+17.4) within HTTP::Tiny::Handle::readline which was called 9008 times, avg 1.94ms/call: # 7006 times (25.8ms+9.96ms) by HTTP::Tiny::Handle::read_header_lines at line 1088, avg 5µs/call # 2002 times (47.4ms+17.4s) by HTTP::Tiny::Handle::read_response_header at line 1293, avg 8.69ms/call
sub readline {
105190082.04ms @_ == 1 || die(q/Usage: $handle->readline()/ . "\n");
105290082.06ms my ($self) = @_;
1053
105490081.11ms while () {
10551101088.5ms1101024.7ms if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
# spent 24.7ms making 11010 calls to HTTP::Tiny::Handle::CORE:subst, avg 2µs/call
1056 return $1;
1057 }
105820021.65ms if (length $self->{rbuf} >= $self->{max_line_size}) {
1059 die(qq/Line size exceeds the maximum allowed size of $self->{max_line_size}\n/);
1060 }
1061 $self->can_read
106220024.08ms200217.3s or die(qq/Timed out while waiting for socket to become ready for reading\n/);
# spent 17.3s making 2002 calls to HTTP::Tiny::Handle::can_read, avg 8.65ms/call
1063200229.8ms200218.2ms my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
# spent 18.2ms making 2002 calls to HTTP::Tiny::Handle::CORE:sysread, avg 9µs/call
106420022.69ms if (defined $r) {
10652002896µs last unless $r;
1066 }
1067 elsif ($! != EINTR) {
1068 if ($self->{fh}->can('errstr')){
1069 my $err = $self->{fh}->errstr();
1070 die (qq/Could not read from SSL socket: '$err'\n /);
1071 }
1072 else {
1073 die(qq/Could not read from socket: '$!'\n/);
1074 }
1075 }
1076 }
1077 die(qq/Unexpected end of stream while looking for line\n/);
1078}
1079
1080
# spent 150ms (104+46.5) within HTTP::Tiny::Handle::read_header_lines which was called 2002 times, avg 75µs/call: # 2002 times (104ms+46.5ms) by HTTP::Tiny::Handle::read_response_header at line 1304, avg 75µs/call
sub read_header_lines {
108120021.78ms @_ == 1 || @_ == 2 || die(q/Usage: $handle->read_header_lines([headers])/ . "\n");
108220021.42ms my ($self, $headers) = @_;
108320021.83ms $headers ||= {};
10842002722µs my $lines = 0;
10852002437µs my $val;
1086
10872002739µs while () {
108870067.68ms700635.8ms my $line = $self->readline;
# spent 35.8ms making 7006 calls to HTTP::Tiny::Handle::readline, avg 5µs/call
1089
1090700661.4ms1101010.7ms if (++$lines >= $self->{max_header_lines}) {
# spent 10.7ms making 11010 calls to HTTP::Tiny::Handle::CORE:match, avg 972ns/call
1091 die(qq/Header lines exceeds maximum number allowed of $self->{max_header_lines}\n/);
1092 }
1093 elsif ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
109450044.51ms my ($field_name) = lc $1;
109550042.88ms if (exists $headers->{$field_name}) {
1096 for ($headers->{$field_name}) {
1097 $_ = [$_] unless ref $_ eq "ARRAY";
1098 push @$_, $2;
1099 $val = \$_->[-1];
1100 }
1101 }
1102 else {
110350047.93ms $val = \($headers->{$field_name} = $2);
1104 }
1105 }
1106 elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
1107 $val
1108 or die(qq/Unexpected header continuation line\n/);
1109 next unless length $1;
1110 $$val .= ' ' if length $$val;
1111 $$val .= $1;
1112 }
1113 elsif ($line =~ /\A \x0D?\x0A \z/x) {
111420021.28ms last;
1115 }
1116 else {
1117 die(q/Malformed header line: / . $Printable->($line) . "\n");
1118 }
1119 }
112020023.91ms return $headers;
1121}
1122
1123
# spent 312ms (15.4+296) within HTTP::Tiny::Handle::write_request which was called 2002 times, avg 156µs/call: # 2002 times (15.4ms+296ms) by HTTP::Tiny::_request at line 508, avg 156µs/call
sub write_request {
112420021.04ms @_ == 2 || die(q/Usage: $handle->write_request(request)/ . "\n");
11252002886µs my($self, $request) = @_;
112620025.34ms2002208ms $self->write_request_header(@{$request}{qw/method uri headers/});
# spent 208ms making 2002 calls to HTTP::Tiny::Handle::write_request_header, avg 104µs/call
112720023.53ms100088.1ms $self->write_body($request) if $request->{cb};
# spent 88.1ms making 1000 calls to HTTP::Tiny::Handle::write_body, avg 88µs/call
112820023.76ms return;
1129}
1130
113112µsmy %HeaderCase = (
1132 'content-md5' => 'Content-MD5',
1133 'etag' => 'ETag',
1134 'te' => 'TE',
1135 'www-authenticate' => 'WWW-Authenticate',
1136 'x-xss-protection' => 'X-XSS-Protection',
1137);
1138
1139# to avoid multiple small writes and hence nagle, you can pass the method line or anything else to
1140# combine writes.
1141
# spent 198ms (42.6+155) within HTTP::Tiny::Handle::write_header_lines which was called 2002 times, avg 99µs/call: # 2002 times (42.6ms+155ms) by HTTP::Tiny::Handle::write_request_header at line 1315, avg 99µs/call
sub write_header_lines {
114220022.77ms (@_ == 2 || @_ == 3 && ref $_[1] eq 'HASH') || die(q/Usage: $handle->write_header_lines(headers[,prefix])/ . "\n");
11432002916µs my($self, $headers, $prefix_data) = @_;
1144
11452002997µs my $buf = (defined $prefix_data ? $prefix_data : '');
114620027.95ms while (my ($k, $v) = each %$headers) {
114760042.08ms my $field_name = lc $k;
114860044.88ms if (exists $HeaderCase{$field_name}) {
1149 $field_name = $HeaderCase{$field_name};
1150 }
1151 else {
1152439µs529µs $field_name =~ /\A $Token+ \z/xo
# spent 24µs making 1 call to HTTP::Tiny::Handle::CORE:regcomp # spent 5µs making 4 calls to HTTP::Tiny::Handle::CORE:match, avg 1µs/call
1153 or die(q/Invalid HTTP header field name: / . $Printable->($field_name) . "\n");
1154440µs1511µs $field_name =~ s/\b(\w)/\u$1/g;
# spent 7µs making 11 calls to HTTP::Tiny::Handle::CORE:substcont, avg 618ns/call # spent 4µs making 4 calls to HTTP::Tiny::Handle::CORE:subst, avg 975ns/call
115544µs $HeaderCase{lc $field_name} = $field_name;
1156 }
115760043.75ms for (ref $v eq 'ARRAY' ? @$v : $v) {
11586004852µs $_ = '' unless defined $_;
115960043.88ms $buf .= "$field_name: $_\x0D\x0A";
1160 }
1161 }
11622002840µs $buf .= "\x0D\x0A";
116320027.69ms2002155ms return $self->write($buf);
# spent 155ms making 2002 calls to HTTP::Tiny::Handle::write, avg 77µs/call
1164}
1165
1166# return value indicates whether message length was defined; this is generally
1167# true unless there was no content-length header and we just read until EOF.
1168# Other message length errors are thrown as exceptions
1169
# spent 55.1ms (16.3+38.9) within HTTP::Tiny::Handle::read_body which was called 1001 times, avg 55µs/call: # 1001 times (16.3ms+38.9ms) by HTTP::Tiny::_request at line 528, avg 55µs/call
sub read_body {
11701001549µs @_ == 3 || die(q/Usage: $handle->read_body(callback, response)/ . "\n");
11711001503µs my ($self, $cb, $response) = @_;
117210011.08ms my $te = $response->{headers}{'transfer-encoding'} || '';
117320025.15ms1001332µs my $chunked = grep { /chunked/i } ( ref $te eq 'ARRAY' ? @$te : $te ) ;
# spent 332µs making 1001 calls to HTTP::Tiny::Handle::CORE:match, avg 332ns/call
117410014.46ms100138.5ms return $chunked
# spent 38.5ms making 1001 calls to HTTP::Tiny::Handle::read_content_body, avg 38µs/call
1175 ? $self->read_chunked_body($cb, $response)
1176 : $self->read_content_body($cb, $response);
1177}
1178
1179
# spent 88.1ms (5.67+82.5) within HTTP::Tiny::Handle::write_body which was called 1000 times, avg 88µs/call: # 1000 times (5.67ms+82.5ms) by HTTP::Tiny::Handle::write_request at line 1127, avg 88µs/call
sub write_body {
11801000560µs @_ == 2 || die(q/Usage: $handle->write_body(request)/ . "\n");
11811000543µs my ($self, $request) = @_;
118210004.47ms100082.5ms if ($request->{headers}{'content-length'}) {
# spent 82.5ms making 1000 calls to HTTP::Tiny::Handle::write_content_body, avg 82µs/call
1183 return $self->write_content_body($request);
1184 }
1185 else {
1186 return $self->write_chunked_body($request);
1187 }
1188}
1189
1190
# spent 38.5ms (25.8+12.7) within HTTP::Tiny::Handle::read_content_body which was called 1001 times, avg 38µs/call: # 1001 times (25.8ms+12.7ms) by HTTP::Tiny::Handle::read_body at line 1174, avg 38µs/call
sub read_content_body {
11911001543µs @_ == 3 || @_ == 4 || die(q/Usage: $handle->read_content_body(callback, response, [read_length])/ . "\n");
11921001554µs my ($self, $cb, $response, $content_length) = @_;
119310011.09ms $content_length ||= $response->{headers}{'content-length'};
1194
11951001574µs if ( defined $content_length ) {
11961001368µs my $len = $content_length;
119710011.65ms while ($len > 0) {
11981001630µs my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
119910013.95ms200212.7ms $cb->($self->read($read, 0), $response);
# spent 9.80ms making 1001 calls to HTTP::Tiny::Handle::read, avg 10µs/call # spent 2.92ms making 1001 calls to HTTP::Tiny::__ANON__[HTTP/Tiny.pm:734], avg 3µs/call
12001001750µs $len -= $read;
1201 }
120210018.04ms return length($self->{rbuf}) == 0;
1203 }
1204
1205 my $chunk;
1206 $cb->($chunk, $response) while length( $chunk = $self->read(BUFSIZE, 1) );
1207
1208 return;
1209}
1210
1211
# spent 82.5ms (37.0+45.4) within HTTP::Tiny::Handle::write_content_body which was called 1000 times, avg 82µs/call: # 1000 times (37.0ms+45.4ms) by HTTP::Tiny::Handle::write_body at line 1182, avg 82µs/call
sub write_content_body {
12121000618µs @_ == 2 || die(q/Usage: $handle->write_content_body(request)/ . "\n");
12131000437µs my ($self, $request) = @_;
1214
121510001.04ms my ($len, $content_length) = (0, $request->{headers}{'content-length'});
12161000258µs while () {
121720003.27ms20004.50ms my $data = $request->{cb}->();
# spent 4.50ms making 2000 calls to HTTP::Tiny::__ANON__[HTTP/Tiny.pm:692], avg 2µs/call
1218
121920001.44ms defined $data && length $data
1220 or last;
1221
12221000749µs if ( $] ge '5.008' ) {
122310002.35ms1000448µs utf8::downgrade($data, 1)
# spent 448µs making 1000 calls to utf8::downgrade, avg 448ns/call
1224 or die(qq/Wide character in write_content()\n/);
1225 }
1226
122710001.51ms100040.5ms $len += $self->write($data);
# spent 40.5ms making 1000 calls to HTTP::Tiny::Handle::write, avg 40µs/call
1228 }
1229
12301000494µs $len == $content_length
1231 or die(qq/Content-Length mismatch (got: $len expected: $content_length)\n/);
1232
123310002.01ms return $len;
1234}
1235
1236sub read_chunked_body {
1237 @_ == 3 || die(q/Usage: $handle->read_chunked_body(callback, $response)/ . "\n");
1238 my ($self, $cb, $response) = @_;
1239
1240 while () {
1241 my $head = $self->readline;
1242
1243 $head =~ /\A ([A-Fa-f0-9]+)/x
1244 or die(q/Malformed chunk head: / . $Printable->($head) . "\n");
1245
1246 my $len = hex($1)
1247 or last;
1248
1249 $self->read_content_body($cb, $response, $len);
1250
1251 $self->read(2) eq "\x0D\x0A"
1252 or die(qq/Malformed chunk: missing CRLF after chunk data\n/);
1253 }
1254 $self->read_header_lines($response->{headers});
1255 return 1;
1256}
1257
1258sub write_chunked_body {
1259 @_ == 2 || die(q/Usage: $handle->write_chunked_body(request)/ . "\n");
1260 my ($self, $request) = @_;
1261
1262 my $len = 0;
1263 while () {
1264 my $data = $request->{cb}->();
1265
1266 defined $data && length $data
1267 or last;
1268
1269 if ( $] ge '5.008' ) {
1270 utf8::downgrade($data, 1)
1271 or die(qq/Wide character in write_chunked_body()\n/);
1272 }
1273
1274 $len += length $data;
1275
1276 my $chunk = sprintf '%X', length $data;
1277 $chunk .= "\x0D\x0A";
1278 $chunk .= $data;
1279 $chunk .= "\x0D\x0A";
1280
1281 $self->write($chunk);
1282 }
1283 $self->write("0\x0D\x0A");
1284 $self->write_header_lines($request->{trailer_cb}->())
1285 if ref $request->{trailer_cb} eq 'CODE';
1286 return $len;
1287}
1288
1289
# spent 17.6s (44.4ms+17.6) within HTTP::Tiny::Handle::read_response_header which was called 2002 times, avg 8.80ms/call: # 2002 times (44.4ms+17.6s) by HTTP::Tiny::_request at line 512, avg 8.80ms/call
sub read_response_header {
12902002979µs @_ == 1 || die(q/Usage: $handle->read_response_header()/ . "\n");
12912002965µs my ($self) = @_;
1292
129320024.62ms200217.4s my $line = $self->readline;
# spent 17.4s making 2002 calls to HTTP::Tiny::Handle::readline, avg 8.69ms/call
1294
1295200217.6ms20026.89ms $line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
# spent 6.89ms making 2002 calls to HTTP::Tiny::Handle::CORE:match, avg 3µs/call
1296 or die(q/Malformed Status-Line: / . $Printable->($line). "\n");
1297
129820026.43ms my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
1299
130020028.49ms20024.50ms die (qq/Unsupported HTTP protocol: $protocol\n/)
# spent 4.50ms making 2002 calls to HTTP::Tiny::Handle::CORE:match, avg 2µs/call
1301 unless $version =~ /0*1\.0*[01]/;
1302
1303 return {
1304200216.5ms2002150ms status => $status,
# spent 150ms making 2002 calls to HTTP::Tiny::Handle::read_header_lines, avg 75µs/call
1305 reason => $reason,
1306 headers => $self->read_header_lines,
1307 protocol => $protocol,
1308 };
1309}
1310
1311
# spent 208ms (10.7+198) within HTTP::Tiny::Handle::write_request_header which was called 2002 times, avg 104µs/call: # 2002 times (10.7ms+198ms) by HTTP::Tiny::Handle::write_request at line 1126, avg 104µs/call
sub write_request_header {
13122002993µs @_ == 4 || die(q/Usage: $handle->write_request_header(method, request_uri, headers)/ . "\n");
131320021.17ms my ($self, $method, $request_uri, $headers) = @_;
1314
131520028.65ms2002198ms return $self->write_header_lines($headers, "$method $request_uri HTTP/1.1\x0D\x0A");
# spent 198ms making 2002 calls to HTTP::Tiny::Handle::write_header_lines, avg 99µs/call
1316}
1317
1318
# spent 17.3s (72.0ms+17.3) within HTTP::Tiny::Handle::_do_timeout which was called 5004 times, avg 3.46ms/call: # 3002 times (34.0ms+5.96ms) by HTTP::Tiny::Handle::can_write at line 1361, avg 13µs/call # 2002 times (38.0ms+17.3s) by HTTP::Tiny::Handle::can_read at line 1355, avg 8.64ms/call
sub _do_timeout {
131950042.19ms my ($self, $type, $timeout) = @_;
1320 $timeout = $self->{timeout}
132150042.86ms unless defined $timeout && $timeout >= 0;
1322
132350042.35ms my $fd = fileno $self->{fh};
132450041.56ms defined $fd && $fd >= 0
1325 or die(qq/select(2): 'Bad file descriptor'\n/);
1326
132750041.50ms my $initial = time;
132850041.12ms my $pending = $timeout;
13295004668µs my $nfound;
1330
133150045.96ms vec(my $fdset = '', $fd, 1) = 1;
1332
13335004586µs while () {
1334500417.3s500417.3s $nfound = ($type eq 'read')
# spent 17.3s making 5004 calls to HTTP::Tiny::Handle::CORE:sselect, avg 3.45ms/call
1335 ? select($fdset, undef, undef, $pending)
1336 : select(undef, $fdset, undef, $pending) ;
133750041.96ms if ($nfound == -1) {
1338 $! == EINTR
1339 or die(qq/select(2): '$!'\n/);
1340 redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
1341 $nfound = 0;
1342 }
134350043.86ms last;
1344 }
134550044.49ms $! = 0;
1346500441.7ms return $nfound;
1347}
1348
1349
# spent 17.3s (27.7ms+17.3) within HTTP::Tiny::Handle::can_read which was called 2002 times, avg 8.65ms/call: # 2002 times (27.7ms+17.3s) by HTTP::Tiny::Handle::readline at line 1062, avg 8.65ms/call
sub can_read {
135020021.00ms @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_read([timeout])/ . "\n");
13512002960µs my $self = shift;
135220022.02ms if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
1353 return 1 if $self->{fh}->pending;
1354 }
135520028.15ms200217.3s return $self->_do_timeout('read', @_)
# spent 17.3s making 2002 calls to HTTP::Tiny::Handle::_do_timeout, avg 8.64ms/call
1356}
1357
1358
# spent 64.9ms (24.9+40.0) within HTTP::Tiny::Handle::can_write which was called 3002 times, avg 22µs/call: # 3002 times (24.9ms+40.0ms) by HTTP::Tiny::Handle::write at line 988, avg 22µs/call
sub can_write {
135930021.04ms @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_write([timeout])/ . "\n");
136030021.12ms my $self = shift;
1361300214.5ms300240.0ms return $self->_do_timeout('write', @_)
# spent 40.0ms making 3002 calls to HTTP::Tiny::Handle::_do_timeout, avg 13µs/call
1362}
1363
1364sub _assert_ssl {
1365 # Need IO::Socket::SSL 1.42 for SSL_create_ctx_callback
1366 die(qq/IO::Socket::SSL 1.42 must be installed for https support\n/)
1367 unless eval {require IO::Socket::SSL; IO::Socket::SSL->VERSION(1.42)};
1368 # Need Net::SSLeay 1.49 for MODE_AUTO_RETRY
1369 die(qq/Net::SSLeay 1.49 must be installed for https support\n/)
1370 unless eval {require Net::SSLeay; Net::SSLeay->VERSION(1.49)};
1371}
1372
1373sub can_reuse {
1374 my ($self,$scheme,$host,$port) = @_;
1375 return 0 if
1376 $self->{pid} != $$
1377 || $self->{tid} != _get_tid()
1378 || length($self->{rbuf})
1379 || $scheme ne $self->{scheme}
1380 || $host ne $self->{host}
1381 || $port ne $self->{port}
1382 || eval { $self->can_read(0) }
1383 || $@ ;
1384 return 1;
1385}
1386
1387# Try to find a CA bundle to validate the SSL cert,
1388# prefer Mozilla::CA or fallback to a system file
1389sub _find_CA_file {
1390 my $self = shift();
1391
1392 return $self->{SSL_options}->{SSL_ca_file}
1393 if $self->{SSL_options}->{SSL_ca_file} and -e $self->{SSL_options}->{SSL_ca_file};
1394
1395 return Mozilla::CA::SSL_ca_file()
1396 if eval { require Mozilla::CA };
1397
1398 # cert list copied from golang src/crypto/x509/root_unix.go
1399 foreach my $ca_bundle (
1400 "/etc/ssl/certs/ca-certificates.crt", # Debian/Ubuntu/Gentoo etc.
1401 "/etc/pki/tls/certs/ca-bundle.crt", # Fedora/RHEL
1402 "/etc/ssl/ca-bundle.pem", # OpenSUSE
1403 "/etc/openssl/certs/ca-certificates.crt", # NetBSD
1404 "/etc/ssl/cert.pem", # OpenBSD
1405 "/usr/local/share/certs/ca-root-nss.crt", # FreeBSD/DragonFly
1406 "/etc/pki/tls/cacert.pem", # OpenELEC
1407 "/etc/certs/ca-certificates.crt", # Solaris 11.2+
1408 ) {
1409 return $ca_bundle if -e $ca_bundle;
1410 }
1411
1412 die qq/Couldn't find a CA bundle with which to verify the SSL certificate.\n/
1413 . qq/Try installing Mozilla::CA from CPAN\n/;
1414}
1415
1416# for thread safety, we need to know thread id if threads are loaded
1417
# spent 24.0ms (20.7+3.24) within HTTP::Tiny::Handle::_get_tid which was called 2002 times, avg 12µs/call: # 2002 times (20.7ms+3.24ms) by HTTP::Tiny::Handle::connect at line 932, avg 12µs/call
sub _get_tid {
14182143µs252µs
# spent 34µs (17+17) within HTTP::Tiny::Handle::BEGIN@1418 which was called: # once (17µs+17µs) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 1418
no warnings 'reserved'; # for 'threads'
# spent 34µs making 1 call to HTTP::Tiny::Handle::BEGIN@1418 # spent 17µs making 1 call to warnings::unimport
1419200231.3ms20023.24ms return threads->can("tid") ? threads->tid : 0;
# spent 3.24ms making 2002 calls to UNIVERSAL::can, avg 2µs/call
1420}
1421
1422sub _ssl_args {
1423 my ($self, $host) = @_;
1424
1425 my %ssl_args;
1426
1427 # This test reimplements IO::Socket::SSL::can_client_sni(), which wasn't
1428 # added until IO::Socket::SSL 1.84
1429 if ( Net::SSLeay::OPENSSL_VERSION_NUMBER() >= 0x01000000 ) {
1430 $ssl_args{SSL_hostname} = $host, # Sane SNI support
1431 }
1432
1433 if ($self->{verify_SSL}) {
1434 $ssl_args{SSL_verifycn_scheme} = 'http'; # enable CN validation
1435 $ssl_args{SSL_verifycn_name} = $host; # set validation hostname
1436 $ssl_args{SSL_verify_mode} = 0x01; # enable cert validation
1437 $ssl_args{SSL_ca_file} = $self->_find_CA_file;
1438 }
1439 else {
1440 $ssl_args{SSL_verifycn_scheme} = 'none'; # disable CN validation
1441 $ssl_args{SSL_verify_mode} = 0x00; # disable cert validation
1442 }
1443
1444 # user options override settings from verify_SSL
1445 for my $k ( keys %{$self->{SSL_options}} ) {
1446 $ssl_args{$k} = $self->{SSL_options}{$k} if $k =~ m/^SSL_/;
1447 }
1448
1449 return \%ssl_args;
1450}
1451
1452114µs1;
1453
1454__END__
 
# spent 10.1ms within HTTP::Tiny::CORE:match which was called 8008 times, avg 1µs/call: # 2002 times (6.15ms+0s) by HTTP::Tiny::_split_url at line 785, avg 3µs/call # 2002 times (1.70ms+0s) by HTTP::Tiny::_split_url at line 789, avg 851ns/call # 2002 times (1.18ms+0s) by HTTP::Tiny::_maybe_redirect at line 769, avg 588ns/call # 1001 times (618µs+0s) by HTTP::Tiny::_request at line 522, avg 617ns/call # 1001 times (481µs+0s) by HTTP::Tiny::agent at line 93, avg 481ns/call
sub HTTP::Tiny::CORE:match; # opcode
# spent 2µs within HTTP::Tiny::CORE:qr which was called: # once (2µs+0s) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 844
sub HTTP::Tiny::CORE:qr; # opcode
# spent 5.55ms within HTTP::Tiny::CORE:subst which was called 3003 times, avg 2µs/call: # 2002 times (3.97ms+0s) by HTTP::Tiny::_split_url at line 800, avg 2µs/call # 1001 times (1.58ms+0s) by HTTP::Tiny::_agent at line 476, avg 2µs/call
sub HTTP::Tiny::CORE:subst; # opcode
# spent 2.84ms within HTTP::Tiny::Handle::CORE:binmode which was called 2002 times, avg 1µs/call: # 2002 times (2.84ms+0s) by HTTP::Tiny::Handle::connect at line 924, avg 1µs/call
sub HTTP::Tiny::Handle::CORE:binmode; # opcode
# spent 22.4ms within HTTP::Tiny::Handle::CORE:match which was called 16019 times, avg 1µs/call: # 11010 times (10.7ms+0s) by HTTP::Tiny::Handle::read_header_lines at line 1090, avg 972ns/call # 2002 times (6.89ms+0s) by HTTP::Tiny::Handle::read_response_header at line 1295, avg 3µs/call # 2002 times (4.50ms+0s) by HTTP::Tiny::Handle::read_response_header at line 1300, avg 2µs/call # 1001 times (332µs+0s) by HTTP::Tiny::Handle::read_body at line 1173, avg 332ns/call # 4 times (5µs+0s) by HTTP::Tiny::Handle::write_header_lines at line 1152, avg 1µs/call
sub HTTP::Tiny::Handle::CORE:match; # opcode
# spent 900ns within HTTP::Tiny::Handle::CORE:qr which was called: # once (900ns+0s) by Search::Elasticsearch::Cxn::HTTPTiny::BEGIN@6 at line 887
sub HTTP::Tiny::Handle::CORE:qr; # opcode
# spent 24µs within HTTP::Tiny::Handle::CORE:regcomp which was called: # once (24µs+0s) by HTTP::Tiny::Handle::write_header_lines at line 1152
sub HTTP::Tiny::Handle::CORE:regcomp; # opcode
# spent 17.3s within HTTP::Tiny::Handle::CORE:sselect which was called 5004 times, avg 3.45ms/call: # 5004 times (17.3s+0s) by HTTP::Tiny::Handle::_do_timeout at line 1334, avg 3.45ms/call
sub HTTP::Tiny::Handle::CORE:sselect; # opcode
# spent 24.7ms within HTTP::Tiny::Handle::CORE:subst which was called 11014 times, avg 2µs/call: # 11010 times (24.7ms+0s) by HTTP::Tiny::Handle::readline at line 1055, avg 2µs/call # 4 times (4µs+0s) by HTTP::Tiny::Handle::write_header_lines at line 1154, avg 975ns/call
sub HTTP::Tiny::Handle::CORE:subst; # opcode
# spent 7µs within HTTP::Tiny::Handle::CORE:substcont which was called 11 times, avg 618ns/call: # 11 times (7µs+0s) by HTTP::Tiny::Handle::write_header_lines at line 1154, avg 618ns/call
sub HTTP::Tiny::Handle::CORE:substcont; # opcode
# spent 18.2ms within HTTP::Tiny::Handle::CORE:sysread which was called 2002 times, avg 9µs/call: # 2002 times (18.2ms+0s) by HTTP::Tiny::Handle::readline at line 1063, avg 9µs/call
sub HTTP::Tiny::Handle::CORE:sysread; # opcode
# spent 53.7ms within HTTP::Tiny::Handle::CORE:syswrite which was called 3002 times, avg 18µs/call: # 3002 times (53.7ms+0s) by HTTP::Tiny::Handle::write at line 990, avg 18µs/call
sub HTTP::Tiny::Handle::CORE:syswrite; # opcode