← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Sun Nov 5 02:36:06 2017
Reported on Sun Nov 5 02:56:19 2017

Filename/usr/local/lib/perl5/5.24/mach/IO/Socket.pm
StatementsExecuted 23728 statements in 201ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
19681184.4ms182msIO::Socket::::sendIO::Socket::send
19681139.1ms39.1msIO::Socket::::CORE:sendIO::Socket::CORE:send (opcode)
19681136.3ms36.3msIO::Socket::::peernameIO::Socket::peername
19692122.3ms22.3msIO::Socket::::CORE:getpeernameIO::Socket::CORE:getpeername (opcode)
101010366µs57.0msIO::Socket::::importIO::Socket::import
311192µs4.10msIO::Socket::::newIO::Socket::new
311106µs106µsIO::Socket::::CORE:socketIO::Socket::CORE:socket (opcode)
31182µs188µsIO::Socket::::socketIO::Socket::socket
11168µs68µsIO::Socket::::CORE:bindIO::Socket::CORE:bind (opcode)
11151µs5.94msIO::Socket::::BEGIN@13IO::Socket::BEGIN@13
11146µs140µsIO::Socket::::BEGIN@12IO::Socket::BEGIN@12
11135µs60µsIO::Socket::::getsockoptIO::Socket::getsockopt
33331µs31µsIO::Socket::::register_domainIO::Socket::register_domain
11130µs98µsIO::Socket::::BEGIN@18IO::Socket::BEGIN@18
11130µs37µsIO::Socket::::BEGIN@15IO::Socket::BEGIN@15
11127µs87µsIO::Socket::::sockoptIO::Socket::sockopt
11125µs252µsIO::Socket::::BEGIN@14IO::Socket::BEGIN@14
11125µs93µsIO::Socket::::bindIO::Socket::bind
11119µs19µsIO::Socket::::CORE:gsockoptIO::Socket::CORE:gsockopt (opcode)
11118µs117µsIO::Socket::::BEGIN@17IO::Socket::BEGIN@17
1116µs6µsIO::Socket::::CORE:unpackIO::Socket::CORE:unpack (opcode)
0000s0sIO::Socket::::acceptIO::Socket::accept
0000s0sIO::Socket::::atmarkIO::Socket::atmark
0000s0sIO::Socket::::blockingIO::Socket::blocking
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::::protocolIO::Socket::protocol
0000s0sIO::Socket::::recvIO::Socket::recv
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::::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
10119µsrequire 5.006;
11
12287µs2233µs
# spent 140µs (46+93) within IO::Socket::BEGIN@12 which was called: # once (46µs+93µs) by Mail::SpamAssassin::PerMsgStatus::BEGIN@35 at line 12
use IO::Handle;
# spent 140µs making 1 call to IO::Socket::BEGIN@12 # spent 93µs making 1 call to Exporter::import
133104µs311.8ms
# spent 5.94ms (51µs+5.89) within IO::Socket::BEGIN@13 which was called: # once (51µs+5.89ms) by Mail::SpamAssassin::PerMsgStatus::BEGIN@35 at line 13
use Socket 1.3;
# spent 5.94ms making 1 call to IO::Socket::BEGIN@13 # spent 5.87ms making 1 call to Exporter::import # spent 19µs making 1 call to version::_VERSION
14287µs2478µs
# spent 252µs (25+227) within IO::Socket::BEGIN@14 which was called: # once (25µs+227µs) by Mail::SpamAssassin::PerMsgStatus::BEGIN@35 at line 14
use Carp;
# spent 252µs making 1 call to IO::Socket::BEGIN@14 # spent 227µs making 1 call to Exporter::import
15295µs245µs
# spent 37µs (30+8) within IO::Socket::BEGIN@15 which was called: # once (30µs+8µs) by Mail::SpamAssassin::PerMsgStatus::BEGIN@35 at line 15
use strict;
# spent 37µs making 1 call to IO::Socket::BEGIN@15 # spent 8µs making 1 call to strict::import
16our(@ISA, $VERSION, @EXPORT_OK);
17259µs2216µs
# spent 117µs (18+99) within IO::Socket::BEGIN@17 which was called: # once (18µs+99µs) by Mail::SpamAssassin::PerMsgStatus::BEGIN@35 at line 17
use Exporter;
# spent 117µs making 1 call to IO::Socket::BEGIN@17 # spent 99µs making 1 call to Exporter::import
1824.09ms2166µs
# spent 98µs (30+68) within IO::Socket::BEGIN@18 which was called: # once (30µs+68µs) by Mail::SpamAssassin::PerMsgStatus::BEGIN@35 at line 18
use Errno;
# spent 98µs making 1 call to IO::Socket::BEGIN@18 # spent 68µs making 1 call to Exporter::import
19
20# legacy
21
221289µsrequire IO::Socket::INET;
231267µsrequire IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian');
24
25136µs@ISA = qw(IO::Handle);
26
2712µs$VERSION = "1.38";
28
2913µs@EXPORT_OK = qw(sockatmark);
30
31
# spent 57.0ms (366µs+56.6) within IO::Socket::import which was called 10 times, avg 5.70ms/call: # once (31µs+6.75ms) by Net::DNS::Resolver::Base::BEGIN@54 at line 54 of Net/DNS/Resolver/Base.pm # once (31µs+6.74ms) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 141 of IO/Socket/IP.pm # once (36µs+6.27ms) by Razor2::Client::Core::BEGIN@14 at line 14 of Razor2/Client/Core.pm # once (44µs+6.20ms) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@46 at line 46 of Mail/SpamAssassin/Plugin/SpamCop.pm # once (34µs+5.58ms) by IO::Socket::SSL::BEGIN@18 at line 18 of IO/Socket/SSL.pm # once (44µs+5.27ms) by IO::Socket::UNIX::BEGIN@11 at line 11 of IO/Socket/UNIX.pm # once (40µs+5.23ms) by Razor2::Syslog::BEGIN@4 at line 4 of Razor2/Syslog.pm # once (31µs+5.22ms) by IO::Socket::INET::BEGIN@11 at line 11 of IO/Socket/INET.pm # once (37µs+5.07ms) by Mail::SpamAssassin::PerMsgStatus::BEGIN@35 at line 35 of Mail/SpamAssassin/Dns.pm # once (39µs+4.27ms) by Net::SMTP::BEGIN@19 at line 19 of Net/SMTP.pm
sub import {
321025µs my $pkg = shift;
3310170µs if (@_ && $_[0] eq 'sockatmark') { # not very extensible but for now, fast
34 Exporter::export_to_level('IO::Socket', 1, $pkg, 'sockatmark');
35 } else {
361032µs my $callpkg = caller;
371094µs10723µs Exporter::export 'Socket', $callpkg, @_;
# spent 723µs making 10 calls to Exporter::export, avg 72µs/call
38 }
39}
40
41
# spent 4.10ms (192µs+3.91) within IO::Socket::new which was called 3 times, avg 1.37ms/call: # 3 times (192µs+3.91ms) by IO::Socket::IP::new at line 369 of IO/Socket/IP.pm, avg 1.37ms/call
sub new {
42316µs my($class,%arg) = @_;
43337µs3166µs my $sock = $class->SUPER::new();
# spent 166µs making 3 calls to IO::Handle::new, avg 55µs/call
44
45332µs3444µs $sock->autoflush(1);
# spent 444µs making 3 calls to IO::Handle::autoflush, avg 148µs/call
46
47635µs ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
48
49362µs33.30ms return scalar(%arg) ? $sock->configure(\%arg)
# spent 3.30ms making 3 calls to IO::Socket::IP::configure, avg 1.10ms/call
50 : $sock;
51}
52
5312µsmy @domain2pkg;
54
55
# spent 31µs within IO::Socket::register_domain which was called 3 times, avg 10µs/call: # once (12µs+0s) by Net::DNS::Resolver::Base::BEGIN@33 at line 51 of IO/Socket/INET6.pm # once (10µs+0s) by Mail::SpamAssassin::PerMsgStatus::BEGIN@35 at line 22 of IO/Socket/INET.pm # once (8µs+0s) by Mail::SpamAssassin::PerMsgStatus::BEGIN@35 at line 18 of IO/Socket/UNIX.pm
sub register_domain {
5638µs my($p,$d) = @_;
57355µ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 188µs (82+106) within IO::Socket::socket which was called 3 times, avg 63µs/call: # 3 times (82µs+106µs) by IO::Socket::IP::socket at line 947 of IO/Socket/IP.pm, avg 63µs/call
sub socket {
7837µs @_ == 4 or croak 'usage: $sock->socket(DOMAIN, TYPE, PROTOCOL)';
7938µs my($sock,$domain,$type,$protocol) = @_;
80
813150µs3106µs socket($sock,$domain,$type,$protocol) or
# spent 106µs making 3 calls to IO::Socket::CORE:socket, avg 35µs/call
82 return undef;
83
8429µs ${*$sock}{'io_socket_domain'} = $domain;
8527µs ${*$sock}{'io_socket_type'} = $type;
8627µs ${*$sock}{'io_socket_proto'} = $protocol;
87
8817µs $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
168sub blocking {
169 my $sock = shift;
170
171 return $sock->SUPER::blocking(@_)
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
212
# spent 93µs (25+68) within IO::Socket::bind which was called: # once (25µs+68µs) by IO::Socket::IP::setup at line 654 of IO/Socket/IP.pm
sub bind {
21313µs @_ == 2 or croak 'usage: $sock->bind(NAME)';
21412µs my $sock = shift;
21512µs my $addr = shift;
216
217189µs168µs return bind($sock, $addr) ? $sock
# spent 68µs making 1 call to IO::Socket::CORE:bind
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
265
# spent 36.3ms (36.3+22µs) within IO::Socket::peername which was called 1968 times, avg 18µs/call: # 1968 times (36.3ms+22µs) by IO::Socket::send at line 281, avg 18µs/call
sub peername {
26619683.84ms @_ == 1 or croak 'usage: $sock->peername()';
26719683.76ms my($sock) = @_;
268393634.1ms122µs ${*$sock}{'io_socket_peername'} ||= getpeername($sock);
# spent 22µs making 1 call to IO::Socket::CORE:getpeername
269}
270
271sub connected {
272 @_ == 1 or croak 'usage: $sock->connected()';
273 my($sock) = @_;
274 getpeername($sock);
275}
276
277
# spent 182ms (84.4+97.7) within IO::Socket::send which was called 1968 times, avg 92µs/call: # 1968 times (84.4ms+97.7ms) by Mail::SpamAssassin::DnsResolver::bgsend at line 703 of Mail/SpamAssassin/DnsResolver.pm, avg 92µs/call
sub send {
27819684.93ms @_ >= 2 && @_ <= 4 or croak 'usage: $sock->send(BUF, [FLAGS, [TO]])';
27919683.94ms my $sock = $_[0];
28019684.14ms my $flags = $_[2] || 0;
281196815.1ms196836.3ms my $peer = $_[3] || $sock->peername;
# spent 36.3ms making 1968 calls to IO::Socket::peername, avg 18µs/call
282
28319683.72ms croak 'send: Cannot determine peer address'
284 unless(defined $peer);
285
286196885.9ms393661.3ms my $r = defined(getpeername($sock))
# spent 39.1ms making 1968 calls to IO::Socket::CORE:send, avg 20µs/call # spent 22.3ms making 1968 calls to IO::Socket::CORE:getpeername, avg 11µs/call
287 ? send($sock, $_[1], $flags)
288 : send($sock, $_[1], $flags, $peer);
289
290 # remember who we send to, if it was successful
29119684.16ms ${*$sock}{'io_socket_peername'} = $peer
292 if(@_ == 4 && defined $r);
293
294196831.7ms $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
31912µs19µsmy $intsize = length(pack("i",0));
# spent 9µs making 1 call to main::CORE:pack
320
321
# spent 60µs (35+25) within IO::Socket::getsockopt which was called: # once (35µs+25µs) by IO::Socket::sockopt at line 332
sub getsockopt {
32213µs @_ == 3 or croak '$sock->getsockopt(LEVEL, OPTNAME)';
323131µs119µs my $r = getsockopt($_[0],$_[1],$_[2]);
# spent 19µs making 1 call to IO::Socket::CORE:gsockopt
324 # Just a guess
325119µs16µs $r = unpack("i", $r)
# spent 6µs making 1 call to IO::Socket::CORE:unpack
326 if(defined $r && length($r) == $intsize);
327110µs $r;
328}
329
330
# spent 87µs (27+60) within IO::Socket::sockopt which was called: # once (27µs+60µs) by Mail::SpamAssassin::DnsResolver::connect_sock at line 445 of Mail/SpamAssassin/DnsResolver.pm
sub sockopt {
33112µs my $sock = shift;
332125µs160µs @_ == 1 ? $sock->getsockopt(SOL_SOCKET,@_)
# spent 60µs making 1 call to IO::Socket::getsockopt
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
380117µs1;
381
382__END__
 
# spent 68µs within IO::Socket::CORE:bind which was called: # once (68µs+0s) by IO::Socket::bind at line 217
sub IO::Socket::CORE:bind; # opcode
# spent 22.3ms within IO::Socket::CORE:getpeername which was called 1969 times, avg 11µs/call: # 1968 times (22.3ms+0s) by IO::Socket::send at line 286, avg 11µs/call # once (22µs+0s) by IO::Socket::peername at line 268
sub IO::Socket::CORE:getpeername; # opcode
# spent 19µs within IO::Socket::CORE:gsockopt which was called: # once (19µs+0s) by IO::Socket::getsockopt at line 323
sub IO::Socket::CORE:gsockopt; # opcode
# spent 39.1ms within IO::Socket::CORE:send which was called 1968 times, avg 20µs/call: # 1968 times (39.1ms+0s) by IO::Socket::send at line 286, avg 20µs/call
sub IO::Socket::CORE:send; # opcode
# spent 106µs within IO::Socket::CORE:socket which was called 3 times, avg 35µs/call: # 3 times (106µs+0s) by IO::Socket::socket at line 81, avg 35µs/call
sub IO::Socket::CORE:socket; # opcode
# spent 6µs within IO::Socket::CORE:unpack which was called: # once (6µs+0s) by IO::Socket::getsockopt at line 325
sub IO::Socket::CORE:unpack; # opcode