← 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/x86_64-linux/IO/Socket.pm
StatementsExecuted 40078 statements in 115ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
20021139.4ms836msIO::Socket::::newIO::Socket::new
20021118.9ms18.9msIO::Socket::::CORE:socketIO::Socket::CORE:socket (opcode)
40042116.7ms22.9msIO::Socket::::blockingIO::Socket::blocking
20021115.9ms22.6msIO::Socket::::getsockoptIO::Socket::getsockopt
20021114.2ms33.1msIO::Socket::::socketIO::Socket::socket
2002113.39ms3.39msIO::Socket::::CORE:unpackIO::Socket::CORE:unpack (opcode)
2002113.34ms3.34msIO::Socket::::CORE:gsockoptIO::Socket::CORE:gsockopt (opcode)
1111.57ms2.47msIO::Socket::::BEGIN@13IO::Socket::BEGIN@13
1111.23ms2.36msIO::Socket::::BEGIN@12IO::Socket::BEGIN@12
33319µs5.45msIO::Socket::::importIO::Socket::import
11110µs19µsIO::Socket::::BEGIN@18IO::Socket::BEGIN@18
1117µs8µsIO::Socket::::BEGIN@15IO::Socket::BEGIN@15
1116µs26µsIO::Socket::::BEGIN@14IO::Socket::BEGIN@14
1115µs20µsIO::Socket::::BEGIN@17IO::Socket::BEGIN@17
2224µs4µsIO::Socket::::register_domainIO::Socket::register_domain
0000s0sIO::Socket::::acceptIO::Socket::accept
0000s0sIO::Socket::::atmarkIO::Socket::atmark
0000s0sIO::Socket::::bindIO::Socket::bind
0000s0sIO::Socket::::closeIO::Socket::close
0000s0sIO::Socket::::configureIO::Socket::configure
0000s0sIO::Socket::::connectIO::Socket::connect
0000s0sIO::Socket::::connectedIO::Socket::connected
0000s0sIO::Socket::::listenIO::Socket::listen
0000s0sIO::Socket::::peernameIO::Socket::peername
0000s0sIO::Socket::::protocolIO::Socket::protocol
0000s0sIO::Socket::::recvIO::Socket::recv
0000s0sIO::Socket::::sendIO::Socket::send
0000s0sIO::Socket::::setsockoptIO::Socket::setsockopt
0000s0sIO::Socket::::shutdownIO::Socket::shutdown
0000s0sIO::Socket::::sockdomainIO::Socket::sockdomain
0000s0sIO::Socket::::socketpairIO::Socket::socketpair
0000s0sIO::Socket::::socknameIO::Socket::sockname
0000s0sIO::Socket::::sockoptIO::Socket::sockopt
0000s0sIO::Socket::::socktypeIO::Socket::socktype
0000s0sIO::Socket::::timeoutIO::Socket::timeout
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1
2# IO::Socket.pm
3#
4# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
5# This program is free software; you can redistribute it and/or
6# modify it under the same terms as Perl itself.
7
8package IO::Socket;
9
10111µsrequire 5.006;
11
122127µs22.37ms
# spent 2.36ms (1.23+1.13) within IO::Socket::BEGIN@12 which was called: # once (1.23ms+1.13ms) by HTTP::Tiny::Handle::BEGIN@866 at line 12
use IO::Handle;
# spent 2.36ms making 1 call to IO::Socket::BEGIN@12 # spent 12µs making 1 call to Exporter::import
13380µs32.94ms
# spent 2.47ms (1.57+902µs) within IO::Socket::BEGIN@13 which was called: # once (1.57ms+902µs) by HTTP::Tiny::Handle::BEGIN@866 at line 13
use Socket 1.3;
# spent 2.47ms making 1 call to IO::Socket::BEGIN@13 # spent 467µs making 1 call to Exporter::import # spent 6µs making 1 call to UNIVERSAL::VERSION
14216µs246µs
# spent 26µs (6+20) within IO::Socket::BEGIN@14 which was called: # once (6µs+20µs) by HTTP::Tiny::Handle::BEGIN@866 at line 14
use Carp;
# spent 26µs making 1 call to IO::Socket::BEGIN@14 # spent 20µs making 1 call to Exporter::import
15228µs29µs
# spent 8µs (7+1) within IO::Socket::BEGIN@15 which was called: # once (7µs+1µs) by HTTP::Tiny::Handle::BEGIN@866 at line 15
use strict;
# spent 8µs making 1 call to IO::Socket::BEGIN@15 # spent 1µs making 1 call to strict::import
16our(@ISA, $VERSION, @EXPORT_OK);
17221µs236µs
# spent 20µs (5+15) within IO::Socket::BEGIN@17 which was called: # once (5µs+15µs) by HTTP::Tiny::Handle::BEGIN@866 at line 17
use Exporter;
# spent 20µs making 1 call to IO::Socket::BEGIN@17 # spent 15µs making 1 call to Exporter::import
1821.11ms228µs
# spent 19µs (10+9) within IO::Socket::BEGIN@18 which was called: # once (10µs+9µs) by HTTP::Tiny::Handle::BEGIN@866 at line 18
use Errno;
# spent 19µs making 1 call to IO::Socket::BEGIN@18 # spent 9µs making 1 call to Exporter::import
19
20# legacy
21
22164µsrequire IO::Socket::INET;
23146µsrequire IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian');
24
25111µs@ISA = qw(IO::Handle);
26
271200ns$VERSION = "1.38";
28
291400ns@EXPORT_OK = qw(sockatmark);
30
31
# spent 5.45ms (19µs+5.43) within IO::Socket::import which was called 3 times, avg 1.82ms/call: # once (5µs+4.69ms) by HTTP::Tiny::Handle::BEGIN@866 at line 866 of HTTP/Tiny.pm # once (10µs+407µs) by IO::Socket::INET::BEGIN@11 at line 11 of IO/Socket/INET.pm # once (4µs+338µs) by IO::Socket::UNIX::BEGIN@11 at line 11 of IO/Socket/UNIX.pm
sub import {
3231µs my $pkg = shift;
3337µs if (@_ && $_[0] eq 'sockatmark') { # not very extensible but for now, fast
34 Exporter::export_to_level('IO::Socket', 1, $pkg, 'sockatmark');
35 } else {
3632µs my $callpkg = caller;
3735µs341µs Exporter::export 'Socket', $callpkg, @_;
# spent 41µs making 3 calls to Exporter::export, avg 14µs/call
38 }
39}
40
41
# spent 836ms (39.4+797) within IO::Socket::new which was called 2002 times, avg 418µs/call: # 2002 times (39.4ms+797ms) by IO::Socket::IP::new at line 353 of IO/Socket/IP.pm, avg 418µs/call
sub new {
4220023.45ms my($class,%arg) = @_;
4320025.34ms200225.9ms my $sock = $class->SUPER::new();
# spent 25.9ms making 2002 calls to IO::Handle::new, avg 13µs/call
44
4520028.62ms4004106ms $sock->autoflush(1);
# spent 97.5ms making 2002 calls to IO::Handle::autoflush, avg 49µs/call # spent 8.04ms making 2002 calls to SelectSaver::DESTROY, avg 4µs/call
46
4720023.45ms ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
48
4920028.87ms2002674ms return scalar(%arg) ? $sock->configure(\%arg)
# spent 674ms making 2002 calls to IO::Socket::IP::configure, avg 336µs/call
50 : $sock;
51}
52
531100nsmy @domain2pkg;
54
55
# spent 4µs within IO::Socket::register_domain which was called 2 times, avg 2µs/call: # once (2µs+0s) by HTTP::Tiny::Handle::BEGIN@866 at line 22 of IO/Socket/INET.pm # once (2µs+0s) by HTTP::Tiny::Handle::BEGIN@866 at line 18 of IO/Socket/UNIX.pm
sub register_domain {
5621µs my($p,$d) = @_;
5728µs $domain2pkg[$d] = $p;
58}
59
60sub configure {
61 my($sock,$arg) = @_;
62 my $domain = delete $arg->{Domain};
63
64 croak 'IO::Socket: Cannot configure a generic socket'
65 unless defined $domain;
66
67 croak "IO::Socket: Unsupported socket domain"
68 unless defined $domain2pkg[$domain];
69
70 croak "IO::Socket: Cannot configure socket in domain '$domain'"
71 unless ref($sock) eq "IO::Socket";
72
73 bless($sock, $domain2pkg[$domain]);
74 $sock->configure($arg);
75}
76
77
# spent 33.1ms (14.2+18.9) within IO::Socket::socket which was called 2002 times, avg 17µs/call: # 2002 times (14.2ms+18.9ms) by IO::Socket::IP::socket at line 911 of IO/Socket/IP.pm, avg 17µs/call
sub socket {
7820021.03ms @_ == 4 or croak 'usage: $sock->socket(DOMAIN, TYPE, PROTOCOL)';
7920021.13ms my($sock,$domain,$type,$protocol) = @_;
80
81200223.5ms200218.9ms socket($sock,$domain,$type,$protocol) or
# spent 18.9ms making 2002 calls to IO::Socket::CORE:socket, avg 9µs/call
82 return undef;
83
8420021.44ms ${*$sock}{'io_socket_domain'} = $domain;
8520021.35ms ${*$sock}{'io_socket_type'} = $type;
8620021.34ms ${*$sock}{'io_socket_proto'} = $protocol;
87
8820024.28ms $sock;
89}
90
91sub socketpair {
92 @_ == 4 || croak 'usage: IO::Socket->socketpair(DOMAIN, TYPE, PROTOCOL)';
93 my($class,$domain,$type,$protocol) = @_;
94 my $sock1 = $class->new();
95 my $sock2 = $class->new();
96
97 socketpair($sock1,$sock2,$domain,$type,$protocol) or
98 return ();
99
100 ${*$sock1}{'io_socket_type'} = ${*$sock2}{'io_socket_type'} = $type;
101 ${*$sock1}{'io_socket_proto'} = ${*$sock2}{'io_socket_proto'} = $protocol;
102
103 ($sock1,$sock2);
104}
105
106sub connect {
107 @_ == 2 or croak 'usage: $sock->connect(NAME)';
108 my $sock = shift;
109 my $addr = shift;
110 my $timeout = ${*$sock}{'io_socket_timeout'};
111 my $err;
112 my $blocking;
113
114 $blocking = $sock->blocking(0) if $timeout;
115 if (!connect($sock, $addr)) {
116 if (defined $timeout && ($!{EINPROGRESS} || $!{EWOULDBLOCK})) {
117 require IO::Select;
118
119 my $sel = new IO::Select $sock;
120
121 undef $!;
122 my($r,$w,$e) = IO::Select::select(undef,$sel,$sel,$timeout);
123 if(@$e[0]) {
124 # Windows return from select after the timeout in case of
125 # WSAECONNREFUSED(10061) if exception set is not used.
126 # This behavior is different from Linux.
127 # Using the exception
128 # set we now emulate the behavior in Linux
129 # - Karthik Rajagopalan
130 $err = $sock->getsockopt(SOL_SOCKET,SO_ERROR);
131 $@ = "connect: $err";
132 }
133 elsif(!@$w[0]) {
134 $err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
135 $@ = "connect: timeout";
136 }
137 elsif (!connect($sock,$addr) &&
138 not ($!{EISCONN} || ($^O eq 'MSWin32' &&
139 ($! == (($] < 5.019004) ? 10022 : Errno::EINVAL))))
140 ) {
141 # Some systems refuse to re-connect() to
142 # an already open socket and set errno to EISCONN.
143 # Windows sets errno to WSAEINVAL (10022) (pre-5.19.4) or
144 # EINVAL (22) (5.19.4 onwards).
145 $err = $!;
146 $@ = "connect: $!";
147 }
148 }
149 elsif ($blocking || !($!{EINPROGRESS} || $!{EWOULDBLOCK})) {
150 $err = $!;
151 $@ = "connect: $!";
152 }
153 }
154
155 $sock->blocking(1) if $blocking;
156
157 $! = $err if $err;
158
159 $err ? undef : $sock;
160}
161
162# Enable/disable blocking IO on sockets.
163# Without args return the current status of blocking,
164# with args change the mode as appropriate, returning the
165# old setting, or in case of error during the mode change
166# undef.
167
168
# spent 22.9ms (16.7+6.22) within IO::Socket::blocking which was called 4004 times, avg 6µs/call: # 2002 times (10.6ms+3.73ms) by IO::Socket::IP::connect at line 677 of IO/Socket/IP.pm, avg 7µs/call # 2002 times (6.09ms+2.49ms) by IO::Socket::IP::connect at line 705 of IO/Socket/IP.pm, avg 4µs/call
sub blocking {
16940041.06ms my $sock = shift;
170
171400424.4ms40046.22ms return $sock->SUPER::blocking(@_)
# spent 6.22ms making 4004 calls to IO::Handle::blocking, avg 2µs/call
172 if $^O ne 'MSWin32' && $^O ne 'VMS';
173
174 # Windows handles blocking differently
175 #
176 # http://groups.google.co.uk/group/perl.perl5.porters/browse_thread/thread/b4e2b1d88280ddff/630b667a66e3509f?#630b667a66e3509f
177 # http://msdn.microsoft.com/library/default.asp?url=/library/en-us/winsock/winsock/ioctlsocket_2.asp
178 #
179 # 0x8004667e is FIONBIO
180 #
181 # which is used to set blocking behaviour.
182
183 # NOTE:
184 # This is a little confusing, the perl keyword for this is
185 # 'blocking' but the OS level behaviour is 'non-blocking', probably
186 # because sockets are blocking by default.
187 # Therefore internally we have to reverse the semantics.
188
189 my $orig= !${*$sock}{io_sock_nonblocking};
190
191 return $orig unless @_;
192
193 my $block = shift;
194
195 if ( !$block != !$orig ) {
196 ${*$sock}{io_sock_nonblocking} = $block ? 0 : 1;
197 ioctl($sock, 0x8004667e, pack("L!",${*$sock}{io_sock_nonblocking}))
198 or return undef;
199 }
200
201 return $orig;
202}
203
204
205sub close {
206 @_ == 1 or croak 'usage: $sock->close()';
207 my $sock = shift;
208 ${*$sock}{'io_socket_peername'} = undef;
209 $sock->SUPER::close();
210}
211
212sub bind {
213 @_ == 2 or croak 'usage: $sock->bind(NAME)';
214 my $sock = shift;
215 my $addr = shift;
216
217 return bind($sock, $addr) ? $sock
218 : undef;
219}
220
221sub listen {
222 @_ >= 1 && @_ <= 2 or croak 'usage: $sock->listen([QUEUE])';
223 my($sock,$queue) = @_;
224 $queue = 5
225 unless $queue && $queue > 0;
226
227 return listen($sock, $queue) ? $sock
228 : undef;
229}
230
231sub accept {
232 @_ == 1 || @_ == 2 or croak 'usage $sock->accept([PKG])';
233 my $sock = shift;
234 my $pkg = shift || $sock;
235 my $timeout = ${*$sock}{'io_socket_timeout'};
236 my $new = $pkg->new(Timeout => $timeout);
237 my $peer = undef;
238
239 if(defined $timeout) {
240 require IO::Select;
241
242 my $sel = new IO::Select $sock;
243
244 unless ($sel->can_read($timeout)) {
245 $@ = 'accept: timeout';
246 $! = (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
247 return;
248 }
249 }
250
251 $peer = accept($new,$sock)
252 or return;
253
254 ${*$new}{$_} = ${*$sock}{$_} for qw( io_socket_domain io_socket_type io_socket_proto );
255
256 return wantarray ? ($new, $peer)
257 : $new;
258}
259
260sub sockname {
261 @_ == 1 or croak 'usage: $sock->sockname()';
262 getsockname($_[0]);
263}
264
265sub peername {
266 @_ == 1 or croak 'usage: $sock->peername()';
267 my($sock) = @_;
268 ${*$sock}{'io_socket_peername'} ||= getpeername($sock);
269}
270
271sub connected {
272 @_ == 1 or croak 'usage: $sock->connected()';
273 my($sock) = @_;
274 getpeername($sock);
275}
276
277sub send {
278 @_ >= 2 && @_ <= 4 or croak 'usage: $sock->send(BUF, [FLAGS, [TO]])';
279 my $sock = $_[0];
280 my $flags = $_[2] || 0;
281 my $peer = $_[3] || $sock->peername;
282
283 croak 'send: Cannot determine peer address'
284 unless(defined $peer);
285
286 my $r = defined(getpeername($sock))
287 ? send($sock, $_[1], $flags)
288 : send($sock, $_[1], $flags, $peer);
289
290 # remember who we send to, if it was successful
291 ${*$sock}{'io_socket_peername'} = $peer
292 if(@_ == 4 && defined $r);
293
294 $r;
295}
296
297sub recv {
298 @_ == 3 || @_ == 4 or croak 'usage: $sock->recv(BUF, LEN [, FLAGS])';
299 my $sock = $_[0];
300 my $len = $_[2];
301 my $flags = $_[3] || 0;
302
303 # remember who we recv'd from
304 ${*$sock}{'io_socket_peername'} = recv($sock, $_[1]='', $len, $flags);
305}
306
307sub shutdown {
308 @_ == 2 or croak 'usage: $sock->shutdown(HOW)';
309 my($sock, $how) = @_;
310 ${*$sock}{'io_socket_peername'} = undef;
311 shutdown($sock, $how);
312}
313
314sub setsockopt {
315 @_ == 4 or croak '$sock->setsockopt(LEVEL, OPTNAME, OPTVAL)';
316 setsockopt($_[0],$_[1],$_[2],$_[3]);
317}
318
3191200ns12µsmy $intsize = length(pack("i",0));
# spent 2µs making 1 call to main::CORE:pack
320
321
# spent 22.6ms (15.9+6.73) within IO::Socket::getsockopt which was called 2002 times, avg 11µs/call: # 2002 times (15.9ms+6.73ms) by IO::Socket::IP::connect at line 702 of IO/Socket/IP.pm, avg 11µs/call
sub getsockopt {
32220021.07ms @_ == 3 or croak '$sock->getsockopt(LEVEL, OPTNAME)';
32320029.01ms20023.34ms my $r = getsockopt($_[0],$_[1],$_[2]);
# spent 3.34ms making 2002 calls to IO::Socket::CORE:gsockopt, avg 2µs/call
324 # Just a guess
32520029.39ms20023.39ms $r = unpack("i", $r)
# spent 3.39ms making 2002 calls to IO::Socket::CORE:unpack, avg 2µs/call
326 if(defined $r && length($r) == $intsize);
32720024.43ms $r;
328}
329
330sub sockopt {
331 my $sock = shift;
332 @_ == 1 ? $sock->getsockopt(SOL_SOCKET,@_)
333 : $sock->setsockopt(SOL_SOCKET,@_);
334}
335
336sub atmark {
337 @_ == 1 or croak 'usage: $sock->atmark()';
338 my($sock) = @_;
339 sockatmark($sock);
340}
341
342sub timeout {
343 @_ == 1 || @_ == 2 or croak 'usage: $sock->timeout([VALUE])';
344 my($sock,$val) = @_;
345 my $r = ${*$sock}{'io_socket_timeout'};
346
347 ${*$sock}{'io_socket_timeout'} = defined $val ? 0 + $val : $val
348 if(@_ == 2);
349
350 $r;
351}
352
353sub sockdomain {
354 @_ == 1 or croak 'usage: $sock->sockdomain()';
355 my $sock = shift;
356 if (!defined(${*$sock}{'io_socket_domain'})) {
357 my $addr = $sock->sockname();
358 ${*$sock}{'io_socket_domain'} = sockaddr_family($addr)
359 if (defined($addr));
360 }
361 ${*$sock}{'io_socket_domain'};
362}
363
364sub socktype {
365 @_ == 1 or croak 'usage: $sock->socktype()';
366 my $sock = shift;
367 ${*$sock}{'io_socket_type'} = $sock->sockopt(Socket::SO_TYPE)
368 if (!defined(${*$sock}{'io_socket_type'}) && defined(eval{Socket::SO_TYPE}));
369 ${*$sock}{'io_socket_type'}
370}
371
372sub protocol {
373 @_ == 1 or croak 'usage: $sock->protocol()';
374 my($sock) = @_;
375 ${*$sock}{'io_socket_proto'} = $sock->sockopt(Socket::SO_PROTOCOL)
376 if (!defined(${*$sock}{'io_socket_proto'}) && defined(eval{Socket::SO_PROTOCOL}));
377 ${*$sock}{'io_socket_proto'};
378}
379
38014µs1;
381
382__END__
 
# spent 3.34ms within IO::Socket::CORE:gsockopt which was called 2002 times, avg 2µs/call: # 2002 times (3.34ms+0s) by IO::Socket::getsockopt at line 323, avg 2µs/call
sub IO::Socket::CORE:gsockopt; # opcode
# spent 18.9ms within IO::Socket::CORE:socket which was called 2002 times, avg 9µs/call: # 2002 times (18.9ms+0s) by IO::Socket::socket at line 81, avg 9µs/call
sub IO::Socket::CORE:socket; # opcode
# spent 3.39ms within IO::Socket::CORE:unpack which was called 2002 times, avg 2µs/call: # 2002 times (3.39ms+0s) by IO::Socket::getsockopt at line 325, avg 2µs/call
sub IO::Socket::CORE:unpack; # opcode