← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Sun Nov 5 03:09:29 2017
Reported on Mon Nov 6 13:20:47 2017

Filename/usr/local/lib/perl5/5.24/mach/IO/Socket.pm
StatementsExecuted 23728 statements in 217ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
196811112ms209msIO::Socket::::sendIO::Socket::send
19681139.0ms39.0msIO::Socket::::CORE:sendIO::Socket::CORE:send (opcode)
19681137.5ms37.5msIO::Socket::::peernameIO::Socket::peername
19692121.5ms21.5msIO::Socket::::CORE:getpeernameIO::Socket::CORE:getpeername (opcode)
101010314µs46.0msIO::Socket::::importIO::Socket::import
311206µs4.33msIO::Socket::::newIO::Socket::new
311114µs114µsIO::Socket::::CORE:socketIO::Socket::CORE:socket (opcode)
31188µs203µsIO::Socket::::socketIO::Socket::socket
11170µs143µsIO::Socket::::sockoptIO::Socket::sockopt
11168µs68µsIO::Socket::::CORE:bindIO::Socket::CORE:bind (opcode)
11151µs110µsIO::Socket::::BEGIN@12IO::Socket::BEGIN@12
11146µs3.31msIO::Socket::::BEGIN@13IO::Socket::BEGIN@13
11144µs73µsIO::Socket::::getsockoptIO::Socket::getsockopt
33333µs33µsIO::Socket::::register_domainIO::Socket::register_domain
11128µs96µsIO::Socket::::bindIO::Socket::bind
11122µs22µsIO::Socket::::CORE:gsockoptIO::Socket::CORE:gsockopt (opcode)
11121µs152µsIO::Socket::::BEGIN@14IO::Socket::BEGIN@14
11120µs72µsIO::Socket::::BEGIN@18IO::Socket::BEGIN@18
11120µs87µsIO::Socket::::BEGIN@17IO::Socket::BEGIN@17
11119µs28µsIO::Socket::::BEGIN@15IO::Socket::BEGIN@15
1117µs7µ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
10116µsrequire 5.006;
11
12278µs2170µs
# spent 110µs (51+59) within IO::Socket::BEGIN@12 which was called: # once (51µs+59µs) by Mail::SpamAssassin::PerMsgStatus::BEGIN@35 at line 12
use IO::Handle;
# spent 110µs making 1 call to IO::Socket::BEGIN@12 # spent 59µs making 1 call to Exporter::import
13396µs36.57ms
# spent 3.31ms (46µs+3.26) within IO::Socket::BEGIN@13 which was called: # once (46µs+3.26ms) by Mail::SpamAssassin::PerMsgStatus::BEGIN@35 at line 13
use Socket 1.3;
# spent 3.31ms making 1 call to IO::Socket::BEGIN@13 # spent 3.24ms making 1 call to Exporter::import # spent 19µs making 1 call to version::_VERSION
14253µs2283µs
# spent 152µs (21+131) within IO::Socket::BEGIN@14 which was called: # once (21µs+131µs) by Mail::SpamAssassin::PerMsgStatus::BEGIN@35 at line 14
use Carp;
# spent 152µs making 1 call to IO::Socket::BEGIN@14 # spent 131µs making 1 call to Exporter::import
15290µs236µs
# spent 28µs (19+8) within IO::Socket::BEGIN@15 which was called: # once (19µs+8µs) by Mail::SpamAssassin::PerMsgStatus::BEGIN@35 at line 15
use strict;
# spent 28µs making 1 call to IO::Socket::BEGIN@15 # spent 8µs making 1 call to strict::import
16our(@ISA, $VERSION, @EXPORT_OK);
17250µs2155µs
# spent 87µs (20+67) within IO::Socket::BEGIN@17 which was called: # once (20µs+67µs) by Mail::SpamAssassin::PerMsgStatus::BEGIN@35 at line 17
use Exporter;
# spent 87µs making 1 call to IO::Socket::BEGIN@17 # spent 67µs making 1 call to Exporter::import
1823.78ms2123µs
# spent 72µs (20+52) within IO::Socket::BEGIN@18 which was called: # once (20µs+52µs) by Mail::SpamAssassin::PerMsgStatus::BEGIN@35 at line 18
use Errno;
# spent 72µs making 1 call to IO::Socket::BEGIN@18 # spent 52µs making 1 call to Exporter::import
19
20# legacy
21
221321µsrequire IO::Socket::INET;
231302µsrequire IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian');
24
25131µs@ISA = qw(IO::Handle);
26
2712µs$VERSION = "1.38";
28
2913µs@EXPORT_OK = qw(sockatmark);
30
31
# spent 46.0ms (314µs+45.7) within IO::Socket::import which was called 10 times, avg 4.60ms/call: # once (35µs+12.7ms) by Net::SMTP::BEGIN@19 at line 19 of Net/SMTP.pm # once (31µs+4.33ms) by Net::DNS::Resolver::Base::BEGIN@1.1 at line 141 of IO/Socket/IP.pm # once (31µs+4.15ms) by Net::DNS::Resolver::Base::BEGIN@54 at line 54 of Net/DNS/Resolver/Base.pm # once (39µs+4.04ms) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@46 at line 46 of Mail/SpamAssassin/Plugin/SpamCop.pm # once (39µs+3.56ms) by IO::Socket::SSL::BEGIN@18 at line 18 of IO/Socket/SSL.pm # once (34µs+3.56ms) by Razor2::Client::Core::BEGIN@14 at line 14 of Razor2/Client/Core.pm # once (31µs+3.38ms) by IO::Socket::INET::BEGIN@11 at line 11 of IO/Socket/INET.pm # once (25µs+3.35ms) by IO::Socket::UNIX::BEGIN@11 at line 11 of IO/Socket/UNIX.pm # once (26µs+3.32ms) by Mail::SpamAssassin::PerMsgStatus::BEGIN@35 at line 35 of Mail/SpamAssassin/Dns.pm # once (24µs+3.29ms) by Razor2::Syslog::BEGIN@4 at line 4 of Razor2/Syslog.pm
sub import {
321025µs my $pkg = shift;
3310140µs if (@_ && $_[0] eq 'sockatmark') { # not very extensible but for now, fast
34 Exporter::export_to_level('IO::Socket', 1, $pkg, 'sockatmark');
35 } else {
361029µs my $callpkg = caller;
371084µs10651µs Exporter::export 'Socket', $callpkg, @_;
# spent 651µs making 10 calls to Exporter::export, avg 65µs/call
38 }
39}
40
41
# spent 4.33ms (206µs+4.13) within IO::Socket::new which was called 3 times, avg 1.44ms/call: # 3 times (206µs+4.13ms) by IO::Socket::IP::new at line 369 of IO/Socket/IP.pm, avg 1.44ms/call
sub new {
42317µs my($class,%arg) = @_;
43338µs3183µs my $sock = $class->SUPER::new();
# spent 183µs making 3 calls to IO::Handle::new, avg 61µs/call
44
45332µs3502µs $sock->autoflush(1);
# spent 502µs making 3 calls to IO::Handle::autoflush, avg 167µs/call
46
47636µs ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
48
49366µs33.44ms return scalar(%arg) ? $sock->configure(\%arg)
# spent 3.44ms making 3 calls to IO::Socket::IP::configure, avg 1.15ms/call
50 : $sock;
51}
52
5312µsmy @domain2pkg;
54
55
# spent 33µs within IO::Socket::register_domain which was called 3 times, avg 11µs/call: # once (12µs+0s) by Net::DNS::Resolver::Base::BEGIN@33 at line 51 of IO/Socket/INET6.pm # once (11µs+0s) by Mail::SpamAssassin::PerMsgStatus::BEGIN@35 at line 22 of IO/Socket/INET.pm # once (10µs+0s) by Mail::SpamAssassin::PerMsgStatus::BEGIN@35 at line 18 of IO/Socket/UNIX.pm
sub register_domain {
5639µs my($p,$d) = @_;
57340µ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 203µs (88+114) within IO::Socket::socket which was called 3 times, avg 68µs/call: # 3 times (88µs+114µs) by IO::Socket::IP::socket at line 947 of IO/Socket/IP.pm, avg 68µs/call
sub socket {
7838µs @_ == 4 or croak 'usage: $sock->socket(DOMAIN, TYPE, PROTOCOL)';
7938µs my($sock,$domain,$type,$protocol) = @_;
80
813158µs3114µs socket($sock,$domain,$type,$protocol) or
# spent 114µs making 3 calls to IO::Socket::CORE:socket, avg 38µs/call
82 return undef;
83
8429µs ${*$sock}{'io_socket_domain'} = $domain;
8527µs ${*$sock}{'io_socket_type'} = $type;
8628µ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 96µs (28+68) within IO::Socket::bind which was called: # once (28µs+68µs) by IO::Socket::IP::setup at line 654 of IO/Socket/IP.pm
sub bind {
21312µs @_ == 2 or croak 'usage: $sock->bind(NAME)';
21412µs my $sock = shift;
21513µs my $addr = shift;
216
217192µ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 37.5ms (37.5+23µs) within IO::Socket::peername which was called 1968 times, avg 19µs/call: # 1968 times (37.5ms+23µs) by IO::Socket::send at line 281, avg 19µs/call
sub peername {
26619684.10ms @_ == 1 or croak 'usage: $sock->peername()';
26719684.11ms my($sock) = @_;
268393658.0ms123µs ${*$sock}{'io_socket_peername'} ||= getpeername($sock);
# spent 23µ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 209ms (112+97.9) within IO::Socket::send which was called 1968 times, avg 106µs/call: # 1968 times (112ms+97.9ms) by Mail::SpamAssassin::DnsResolver::bgsend at line 703 of Mail/SpamAssassin/DnsResolver.pm, avg 106µs/call
sub send {
27819684.96ms @_ >= 2 && @_ <= 4 or croak 'usage: $sock->send(BUF, [FLAGS, [TO]])';
27919683.92ms my $sock = $_[0];
28019684.36ms my $flags = $_[2] || 0;
281196814.9ms196837.5ms my $peer = $_[3] || $sock->peername;
# spent 37.5ms making 1968 calls to IO::Socket::peername, avg 19µs/call
282
28319683.67ms croak 'send: Cannot determine peer address'
284 unless(defined $peer);
285
286196884.9ms393660.4ms my $r = defined(getpeername($sock))
# spent 39.0ms making 1968 calls to IO::Socket::CORE:send, avg 20µs/call # spent 21.5ms 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.06ms ${*$sock}{'io_socket_peername'} = $peer
292 if(@_ == 4 && defined $r);
293
294196823.9ms $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µs18µsmy $intsize = length(pack("i",0));
# spent 8µs making 1 call to main::CORE:pack
320
321
# spent 73µs (44+29) within IO::Socket::getsockopt which was called: # once (44µs+29µs) by IO::Socket::sockopt at line 332
sub getsockopt {
32213µs @_ == 3 or croak '$sock->getsockopt(LEVEL, OPTNAME)';
323137µs122µs my $r = getsockopt($_[0],$_[1],$_[2]);
# spent 22µs making 1 call to IO::Socket::CORE:gsockopt
324 # Just a guess
325126µs17µs $r = unpack("i", $r)
# spent 7µs making 1 call to IO::Socket::CORE:unpack
326 if(defined $r && length($r) == $intsize);
327110µs $r;
328}
329
330
# spent 143µs (70+73) within IO::Socket::sockopt which was called: # once (70µs+73µs) by Mail::SpamAssassin::DnsResolver::connect_sock at line 445 of Mail/SpamAssassin/DnsResolver.pm
sub sockopt {
33112µs my $sock = shift;
332168µs173µs @_ == 1 ? $sock->getsockopt(SOL_SOCKET,@_)
# spent 73µ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
380116µ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 21.5ms within IO::Socket::CORE:getpeername which was called 1969 times, avg 11µs/call: # 1968 times (21.5ms+0s) by IO::Socket::send at line 286, avg 11µs/call # once (23µs+0s) by IO::Socket::peername at line 268
sub IO::Socket::CORE:getpeername; # opcode
# spent 22µs within IO::Socket::CORE:gsockopt which was called: # once (22µs+0s) by IO::Socket::getsockopt at line 323
sub IO::Socket::CORE:gsockopt; # opcode
# spent 39.0ms within IO::Socket::CORE:send which was called 1968 times, avg 20µs/call: # 1968 times (39.0ms+0s) by IO::Socket::send at line 286, avg 20µs/call
sub IO::Socket::CORE:send; # opcode
# spent 114µs within IO::Socket::CORE:socket which was called 3 times, avg 38µs/call: # 3 times (114µs+0s) by IO::Socket::socket at line 81, avg 38µs/call
sub IO::Socket::CORE:socket; # opcode
# spent 7µs within IO::Socket::CORE:unpack which was called: # once (7µs+0s) by IO::Socket::getsockopt at line 325
sub IO::Socket::CORE:unpack; # opcode