← Index
NYTProf Performance Profile   « line view »
For script/ponapi
  Run on Wed Feb 10 15:51:26 2016
Reported on Thu Feb 11 09:43:12 2016

Filename/usr/lib/perl/5.18/IO/Socket.pm
StatementsExecuted 2700103 statements in 13.3s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
100001112.91s17.4sIO::Socket::::acceptIO::Socket::accept
100003112.19s13.5sIO::Socket::::newIO::Socket::new
100001111.21s5.14sIO::Socket::::closeIO::Socket::close
200002211.13s1.34sIO::Socket::::peernameIO::Socket::peername
100002221.02s1.32sIO::Socket::::setsockoptIO::Socket::setsockopt
10000211295ms295msIO::Socket::::CORE:ssockoptIO::Socket::CORE:ssockopt (opcode)
10000111207ms207msIO::Socket::::CORE:getpeernameIO::Socket::CORE:getpeername (opcode)
1111.96ms2.90msIO::Socket::::BEGIN@12IO::Socket::BEGIN@12
33325µs6.80msIO::Socket::::importIO::Socket::import
11123µs23µsIO::Socket::::CORE:socketIO::Socket::CORE:socket (opcode)
11113µs26µsIO::Socket::::BEGIN@11IO::Socket::BEGIN@11
1119µs32µsIO::Socket::::socketIO::Socket::socket
1118µs17µsIO::Socket::::BEGIN@17IO::Socket::BEGIN@17
1118µs12µsIO::Socket::::bindIO::Socket::bind
1117µs16µsIO::Socket::::BEGIN@14IO::Socket::BEGIN@14
1117µs36µsIO::Socket::::BEGIN@13IO::Socket::BEGIN@13
1117µs18µsIO::Socket::::BEGIN@16IO::Socket::BEGIN@16
1117µs18µsIO::Socket::::sockoptIO::Socket::sockopt
1117µs7µsIO::Socket::::CORE:listenIO::Socket::CORE:listen (opcode)
1117µs13µsIO::Socket::::listenIO::Socket::listen
2225µs5µsIO::Socket::::register_domainIO::Socket::register_domain
1114µs4µsIO::Socket::::CORE:bindIO::Socket::CORE:bind (opcode)
100002110s0sIO::Socket::::CORE:acceptIO::Socket::CORE:accept (opcode)
0000s0sIO::Socket::::atmarkIO::Socket::atmark
0000s0sIO::Socket::::blockingIO::Socket::blocking
0000s0sIO::Socket::::configureIO::Socket::configure
0000s0sIO::Socket::::connectIO::Socket::connect
0000s0sIO::Socket::::connectedIO::Socket::connected
0000s0sIO::Socket::::getsockoptIO::Socket::getsockopt
0000s0sIO::Socket::::protocolIO::Socket::protocol
0000s0sIO::Socket::::recvIO::Socket::recv
0000s0sIO::Socket::::sendIO::Socket::send
0000s0sIO::Socket::::shutdownIO::Socket::shutdown
0000s0sIO::Socket::::sockdomainIO::Socket::sockdomain
0000s0sIO::Socket::::socketpairIO::Socket::socketpair
0000s0sIO::Socket::::socknameIO::Socket::sockname
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# IO::Socket.pm
2#
3# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
4# This program is free software; you can redistribute it and/or
5# modify it under the same terms as Perl itself.
6
7package IO::Socket;
8
918µsrequire 5.006;
10
11225µs238µs
# spent 26µs (13+13) within IO::Socket::BEGIN@11 which was called: # once (13µs+13µs) by IO::Socket::INET::BEGIN@11 at line 11
use IO::Handle;
# spent 26µs making 1 call to IO::Socket::BEGIN@11 # spent 13µs making 1 call to Exporter::import
123131µs33.33ms
# spent 2.90ms (1.96+935µs) within IO::Socket::BEGIN@12 which was called: # once (1.96ms+935µs) by IO::Socket::INET::BEGIN@11 at line 12
use Socket 1.3;
# spent 2.90ms making 1 call to IO::Socket::BEGIN@12 # spent 426µs making 1 call to Exporter::import # spent 9µs making 1 call to UNIVERSAL::VERSION
13221µs265µs
# spent 36µs (7+29) within IO::Socket::BEGIN@13 which was called: # once (7µs+29µs) by IO::Socket::INET::BEGIN@11 at line 13
use Carp;
# spent 36µs making 1 call to IO::Socket::BEGIN@13 # spent 29µs making 1 call to Exporter::import
14233µs225µs
# spent 16µs (7+9) within IO::Socket::BEGIN@14 which was called: # once (7µs+9µs) by IO::Socket::INET::BEGIN@11 at line 14
use strict;
# spent 16µs making 1 call to IO::Socket::BEGIN@14 # spent 9µs making 1 call to strict::import
151400nsour(@ISA, $VERSION, @EXPORT_OK);
16219µs230µs
# spent 18µs (7+11) within IO::Socket::BEGIN@16 which was called: # once (7µs+11µs) by IO::Socket::INET::BEGIN@11 at line 16
use Exporter;
# spent 18µs making 1 call to IO::Socket::BEGIN@16 # spent 11µs making 1 call to Exporter::import
1721.46ms226µs
# spent 17µs (8+9) within IO::Socket::BEGIN@17 which was called: # once (8µs+9µs) by IO::Socket::INET::BEGIN@11 at line 17
use Errno;
# spent 17µs making 1 call to IO::Socket::BEGIN@17 # spent 9µs making 1 call to Exporter::import
18
19# legacy
20
211300nsrequire IO::Socket::INET;
22178µsrequire IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian');
23
24110µs@ISA = qw(IO::Handle);
25
261300ns$VERSION = "1.36";
27
281400ns@EXPORT_OK = qw(sockatmark);
29
30
# spent 6.80ms (25µs+6.77) within IO::Socket::import which was called 3 times, avg 2.27ms/call: # once (7µs+5.73ms) by IO::Socket::INET::BEGIN@11 at line 11 of IO/Socket/INET.pm # once (10µs+537µs) by IO::Socket::UNIX::BEGIN@11 at line 11 of IO/Socket/UNIX.pm # once (8µs+510µs) by HTTP::Server::PSGI::BEGIN@8 at line 8 of HTTP/Server/PSGI.pm
sub import {
3131µs my $pkg = shift;
32310µs if (@_ && $_[0] eq 'sockatmark') { # not very extensible but for now, fast
33 Exporter::export_to_level('IO::Socket', 1, $pkg, 'sockatmark');
34 } else {
3532µs my $callpkg = caller;
3635µs349µs Exporter::export 'Socket', $callpkg, @_;
# spent 49µs making 3 calls to Exporter::export, avg 16µs/call
37 }
38}
39
40
# spent 13.5s (2.19+11.3) within IO::Socket::new which was called 100003 times, avg 135µs/call: # 100003 times (2.19s+11.3s) by IO::Socket::INET::new at line 37 of IO/Socket/INET.pm, avg 135µs/call
sub new {
41100003268ms my($class,%arg) = @_;
42100003411ms1000033.09s my $sock = $class->SUPER::new();
# spent 3.09s making 100003 calls to IO::Handle::new, avg 31µs/call
43
44100003921ms2000069.13s $sock->autoflush(1);
# spent 8.20s making 100003 calls to IO::Handle::autoflush, avg 82µs/call # spent 930ms making 100003 calls to SelectSaver::DESTROY, avg 9µs/call
45
46100003303ms ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
47
48100003567ms1168µs return scalar(%arg) ? $sock->configure(\%arg)
# spent 168µs making 1 call to IO::Socket::INET::configure
49 : $sock;
50}
51
521100nsmy @domain2pkg;
53
54
# spent 5µs within IO::Socket::register_domain which was called 2 times, avg 3µs/call: # once (3µs+0s) by HTTP::Server::PSGI::BEGIN@8 at line 22 of IO/Socket/INET.pm # once (2µs+0s) by IO::Socket::INET::BEGIN@11 at line 18 of IO/Socket/UNIX.pm
sub register_domain {
5521µs my($p,$d) = @_;
56210µs $domain2pkg[$d] = $p;
57}
58
59sub configure {
60 my($sock,$arg) = @_;
61 my $domain = delete $arg->{Domain};
62
63 croak 'IO::Socket: Cannot configure a generic socket'
64 unless defined $domain;
65
66 croak "IO::Socket: Unsupported socket domain"
67 unless defined $domain2pkg[$domain];
68
69 croak "IO::Socket: Cannot configure socket in domain '$domain'"
70 unless ref($sock) eq "IO::Socket";
71
72 bless($sock, $domain2pkg[$domain]);
73 $sock->configure($arg);
74}
75
76
# spent 32µs (9+23) within IO::Socket::socket which was called: # once (9µs+23µs) by IO::Socket::INET::configure at line 179 of IO/Socket/INET.pm
sub socket {
771600ns @_ == 4 or croak 'usage: $sock->socket(DOMAIN, TYPE, PROTOCOL)';
781500ns my($sock,$domain,$type,$protocol) = @_;
79
80127µs123µs socket($sock,$domain,$type,$protocol) or
# spent 23µs making 1 call to IO::Socket::CORE:socket
81 return undef;
82
831900ns ${*$sock}{'io_socket_domain'} = $domain;
841600ns ${*$sock}{'io_socket_type'} = $type;
851700ns ${*$sock}{'io_socket_proto'} = $protocol;
86
8713µs $sock;
88}
89
90sub socketpair {
91 @_ == 4 || croak 'usage: IO::Socket->socketpair(DOMAIN, TYPE, PROTOCOL)';
92 my($class,$domain,$type,$protocol) = @_;
93 my $sock1 = $class->new();
94 my $sock2 = $class->new();
95
96 socketpair($sock1,$sock2,$domain,$type,$protocol) or
97 return ();
98
99 ${*$sock1}{'io_socket_type'} = ${*$sock2}{'io_socket_type'} = $type;
100 ${*$sock1}{'io_socket_proto'} = ${*$sock2}{'io_socket_proto'} = $protocol;
101
102 ($sock1,$sock2);
103}
104
105sub connect {
106 @_ == 2 or croak 'usage: $sock->connect(NAME)';
107 my $sock = shift;
108 my $addr = shift;
109 my $timeout = ${*$sock}{'io_socket_timeout'};
110 my $err;
111 my $blocking;
112
113 $blocking = $sock->blocking(0) if $timeout;
114 if (!connect($sock, $addr)) {
115 if (defined $timeout && ($!{EINPROGRESS} || $!{EWOULDBLOCK})) {
116 require IO::Select;
117
118 my $sel = new IO::Select $sock;
119
120 undef $!;
121 my($r,$w,$e) = IO::Select::select(undef,$sel,$sel,$timeout);
122 if(@$e[0]) {
123 # Windows return from select after the timeout in case of
124 # WSAECONNREFUSED(10061) if exception set is not used.
125 # This behavior is different from Linux.
126 # Using the exception
127 # set we now emulate the behavior in Linux
128 # - Karthik Rajagopalan
129 $err = $sock->getsockopt(SOL_SOCKET,SO_ERROR);
130 $@ = "connect: $err";
131 }
132 elsif(!@$w[0]) {
133 $err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
134 $@ = "connect: timeout";
135 }
136 elsif (!connect($sock,$addr) &&
137 not ($!{EISCONN} || ($! == 10022 && $^O eq 'MSWin32'))
138 ) {
139 # Some systems refuse to re-connect() to
140 # an already open socket and set errno to EISCONN.
141 # Windows sets errno to WSAEINVAL (10022)
142 $err = $!;
143 $@ = "connect: $!";
144 }
145 }
146 elsif ($blocking || !($!{EINPROGRESS} || $!{EWOULDBLOCK})) {
147 $err = $!;
148 $@ = "connect: $!";
149 }
150 }
151
152 $sock->blocking(1) if $blocking;
153
154 $! = $err if $err;
155
156 $err ? undef : $sock;
157}
158
159# Enable/disable blocking IO on sockets.
160# Without args return the current status of blocking,
161# with args change the mode as appropriate, returning the
162# old setting, or in case of error during the mode change
163# undef.
164
165sub blocking {
166 my $sock = shift;
167
168 return $sock->SUPER::blocking(@_)
169 if $^O ne 'MSWin32' && $^O ne 'VMS';
170
171 # Windows handles blocking differently
172 #
173 # http://groups.google.co.uk/group/perl.perl5.porters/browse_thread/thread/b4e2b1d88280ddff/630b667a66e3509f?#630b667a66e3509f
174 # http://msdn.microsoft.com/library/default.asp?url=/library/en-us/winsock/winsock/ioctlsocket_2.asp
175 #
176 # 0x8004667e is FIONBIO
177 #
178 # which is used to set blocking behaviour.
179
180 # NOTE:
181 # This is a little confusing, the perl keyword for this is
182 # 'blocking' but the OS level behaviour is 'non-blocking', probably
183 # because sockets are blocking by default.
184 # Therefore internally we have to reverse the semantics.
185
186 my $orig= !${*$sock}{io_sock_nonblocking};
187
188 return $orig unless @_;
189
190 my $block = shift;
191
192 if ( !$block != !$orig ) {
193 ${*$sock}{io_sock_nonblocking} = $block ? 0 : 1;
194 ioctl($sock, 0x8004667e, pack("L!",${*$sock}{io_sock_nonblocking}))
195 or return undef;
196 }
197
198 return $orig;
199}
200
201
# spent 5.14s (1.21+3.92) within IO::Socket::close which was called 100001 times, avg 51µs/call: # 100001 times (1.21s+3.92s) by HTTP::Server::PSGI::accept_loop at line 130 of HTTP/Server/PSGI.pm, avg 51µs/call
sub close {
20210000182.0ms @_ == 1 or croak 'usage: $sock->close()';
20310000169.6ms my $sock = shift;
204100001165ms ${*$sock}{'io_socket_peername'} = undef;
205100001803ms1000013.92s $sock->SUPER::close();
# spent 3.92s making 100001 calls to IO::Handle::close, avg 39µs/call
206}
207
208
# spent 12µs (8+4) within IO::Socket::bind which was called: # once (8µs+4µs) by IO::Socket::INET::bind at line 263 of IO/Socket/INET.pm
sub bind {
2091600ns @_ == 2 or croak 'usage: $sock->bind(NAME)';
2101300ns my $sock = shift;
2111400ns my $addr = shift;
212
213113µs14µs return bind($sock, $addr) ? $sock
# spent 4µs making 1 call to IO::Socket::CORE:bind
214 : undef;
215}
216
217
# spent 13µs (7+7) within IO::Socket::listen which was called: # once (7µs+7µs) by IO::Socket::INET::configure at line 208 of IO/Socket/INET.pm
sub listen {
2181600ns @_ >= 1 && @_ <= 2 or croak 'usage: $sock->listen([QUEUE])';
2191400ns my($sock,$queue) = @_;
2201400ns $queue = 5
221 unless $queue && $queue > 0;
222
223113µs17µs return listen($sock, $queue) ? $sock
# spent 7µs making 1 call to IO::Socket::CORE:listen
224 : undef;
225}
226
227
# spent 17.4s (2.91+14.5) within IO::Socket::accept which was called 100001 times, avg 174µs/call: # 100001 times (2.91s+14.5s) by HTTP::Server::PSGI::accept_loop at line 107 of HTTP/Server/PSGI.pm, avg 174µs/call
sub accept {
228100002115ms @_ == 1 || @_ == 2 or croak 'usage $sock->accept([PKG])';
22910000277.0ms my $sock = shift;
23010000263.6ms my $pkg = shift || $sock;
231100002161ms my $timeout = ${*$sock}{'io_socket_timeout'};
232100002417ms10000214.5s my $new = $pkg->new(Timeout => $timeout);
# spent 14.5s making 100002 calls to IO::Socket::INET::new, avg 145µs/call
23310000251.7ms my $peer = undef;
234
23510000247.2ms if(defined $timeout) {
236 require IO::Select;
237
238 my $sel = new IO::Select $sock;
239
240 unless ($sel->can_read($timeout)) {
241 $@ = 'accept: timeout';
242 $! = (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
243 return;
244 }
245 }
246
2471000024.07s1000020s $peer = accept($new,$sock)
# spent 0s making 100002 calls to IO::Socket::CORE:accept, avg 0s/call
248 or return;
249
250100001782ms ${*$new}{$_} = ${*$sock}{$_} for qw( io_socket_domain io_socket_type io_socket_proto );
251
252100001519ms return wantarray ? ($new, $peer)
253 : $new;
254}
255
256sub sockname {
257 @_ == 1 or croak 'usage: $sock->sockname()';
258 getsockname($_[0]);
259}
260
261
# spent 1.34s (1.13+207ms) within IO::Socket::peername which was called 200002 times, avg 7µs/call: # 100001 times (945ms+207ms) by IO::Socket::INET::peeraddr at line 290 of IO/Socket/INET.pm, avg 12µs/call # 100001 times (189ms+0s) by IO::Socket::INET::peerport at line 297 of IO/Socket/INET.pm, avg 2µs/call
sub peername {
26220000299.5ms @_ == 1 or croak 'usage: $sock->peername()';
26320000266.5ms my($sock) = @_;
2642000021.69s100001207ms ${*$sock}{'io_socket_peername'} ||= getpeername($sock);
# spent 207ms making 100001 calls to IO::Socket::CORE:getpeername, avg 2µs/call
265}
266
267sub connected {
268 @_ == 1 or croak 'usage: $sock->connected()';
269 my($sock) = @_;
270 getpeername($sock);
271}
272
273sub send {
274 @_ >= 2 && @_ <= 4 or croak 'usage: $sock->send(BUF, [FLAGS, [TO]])';
275 my $sock = $_[0];
276 my $flags = $_[2] || 0;
277 my $peer = $_[3] || $sock->peername;
278
279 croak 'send: Cannot determine peer address'
280 unless(defined $peer);
281
282 my $r = defined(getpeername($sock))
283 ? send($sock, $_[1], $flags)
284 : send($sock, $_[1], $flags, $peer);
285
286 # remember who we send to, if it was successful
287 ${*$sock}{'io_socket_peername'} = $peer
288 if(@_ == 4 && defined $r);
289
290 $r;
291}
292
293sub recv {
294 @_ == 3 || @_ == 4 or croak 'usage: $sock->recv(BUF, LEN [, FLAGS])';
295 my $sock = $_[0];
296 my $len = $_[2];
297 my $flags = $_[3] || 0;
298
299 # remember who we recv'd from
300 ${*$sock}{'io_socket_peername'} = recv($sock, $_[1]='', $len, $flags);
301}
302
303sub shutdown {
304 @_ == 2 or croak 'usage: $sock->shutdown(HOW)';
305 my($sock, $how) = @_;
306 ${*$sock}{'io_socket_peername'} = undef;
307 shutdown($sock, $how);
308}
309
310
# spent 1.32s (1.02+295ms) within IO::Socket::setsockopt which was called 100002 times, avg 13µs/call: # 100001 times (1.02s+295ms) by HTTP::Server::PSGI::accept_loop at line 108 of HTTP/Server/PSGI.pm, avg 13µs/call # once (6µs+5µs) by IO::Socket::sockopt at line 328
sub setsockopt {
31110000284.5ms @_ == 4 or croak '$sock->setsockopt(LEVEL, OPTNAME, OPTVAL)';
3121000021.45s100002295ms setsockopt($_[0],$_[1],$_[2],$_[3]);
# spent 295ms making 100002 calls to IO::Socket::CORE:ssockopt, avg 3µs/call
313}
314
3151200ns13µsmy $intsize = length(pack("i",0));
# spent 3µs making 1 call to main::CORE:pack
316
317sub getsockopt {
318 @_ == 3 or croak '$sock->getsockopt(LEVEL, OPTNAME)';
319 my $r = getsockopt($_[0],$_[1],$_[2]);
320 # Just a guess
321 $r = unpack("i", $r)
322 if(defined $r && length($r) == $intsize);
323 $r;
324}
325
326
# spent 18µs (7+11) within IO::Socket::sockopt which was called: # once (7µs+11µs) by IO::Socket::INET::configure at line 188 of IO/Socket/INET.pm
sub sockopt {
3271400ns my $sock = shift;
32815µs110µs @_ == 1 ? $sock->getsockopt(SOL_SOCKET,@_)
# spent 10µs making 1 call to IO::Socket::setsockopt
329 : $sock->setsockopt(SOL_SOCKET,@_);
330}
331
332sub atmark {
333 @_ == 1 or croak 'usage: $sock->atmark()';
334 my($sock) = @_;
335 sockatmark($sock);
336}
337
338sub timeout {
339 @_ == 1 || @_ == 2 or croak 'usage: $sock->timeout([VALUE])';
340 my($sock,$val) = @_;
341 my $r = ${*$sock}{'io_socket_timeout'};
342
343 ${*$sock}{'io_socket_timeout'} = defined $val ? 0 + $val : $val
344 if(@_ == 2);
345
346 $r;
347}
348
349sub sockdomain {
350 @_ == 1 or croak 'usage: $sock->sockdomain()';
351 my $sock = shift;
352 if (!defined(${*$sock}{'io_socket_domain'})) {
353 my $addr = $sock->sockname();
354 ${*$sock}{'io_socket_domain'} = sockaddr_family($addr)
355 if (defined($addr));
356 }
357 ${*$sock}{'io_socket_domain'};
358}
359
360sub socktype {
361 @_ == 1 or croak 'usage: $sock->socktype()';
362 my $sock = shift;
363 ${*$sock}{'io_socket_type'} = $sock->sockopt(Socket::SO_TYPE)
364 if (!defined(${*$sock}{'io_socket_type'}) && defined(eval{Socket::SO_TYPE}));
365 ${*$sock}{'io_socket_type'}
366}
367
368sub protocol {
369 @_ == 1 or croak 'usage: $sock->protocol()';
370 my($sock) = @_;
371 ${*$sock}{'io_socket_proto'} = $sock->sockopt(Socket::SO_PROTOCOL)
372 if (!defined(${*$sock}{'io_socket_proto'}) && defined(eval{Socket::SO_PROTOCOL}));
373 ${*$sock}{'io_socket_proto'};
374}
375
37614µs1;
377
378__END__
 
# spent 0s within IO::Socket::CORE:accept which was called 100002 times, avg 0s/call: # 100002 times (0s+0s) by IO::Socket::accept at line 247, avg 0s/call
sub IO::Socket::CORE:accept; # opcode
# spent 4µs within IO::Socket::CORE:bind which was called: # once (4µs+0s) by IO::Socket::bind at line 213
sub IO::Socket::CORE:bind; # opcode
# spent 207ms within IO::Socket::CORE:getpeername which was called 100001 times, avg 2µs/call: # 100001 times (207ms+0s) by IO::Socket::peername at line 264, avg 2µs/call
sub IO::Socket::CORE:getpeername; # opcode
# spent 7µs within IO::Socket::CORE:listen which was called: # once (7µs+0s) by IO::Socket::listen at line 223
sub IO::Socket::CORE:listen; # opcode
# spent 23µs within IO::Socket::CORE:socket which was called: # once (23µs+0s) by IO::Socket::socket at line 80
sub IO::Socket::CORE:socket; # opcode
# spent 295ms within IO::Socket::CORE:ssockopt which was called 100002 times, avg 3µs/call: # 100002 times (295ms+0s) by IO::Socket::setsockopt at line 312, avg 3µs/call
sub IO::Socket::CORE:ssockopt; # opcode