Filename | /usr/local/lib/perl5/5.24/mach/IO/Socket.pm |
Statements | Executed 23728 statements in 201ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1968 | 1 | 1 | 84.4ms | 182ms | send | IO::Socket::
1968 | 1 | 1 | 39.1ms | 39.1ms | CORE:send (opcode) | IO::Socket::
1968 | 1 | 1 | 36.3ms | 36.3ms | peername | IO::Socket::
1969 | 2 | 1 | 22.3ms | 22.3ms | CORE:getpeername (opcode) | IO::Socket::
10 | 10 | 10 | 366µs | 57.0ms | import | IO::Socket::
3 | 1 | 1 | 192µs | 4.10ms | new | IO::Socket::
3 | 1 | 1 | 106µs | 106µs | CORE:socket (opcode) | IO::Socket::
3 | 1 | 1 | 82µs | 188µs | socket | IO::Socket::
1 | 1 | 1 | 68µs | 68µs | CORE:bind (opcode) | IO::Socket::
1 | 1 | 1 | 51µs | 5.94ms | BEGIN@13 | IO::Socket::
1 | 1 | 1 | 46µs | 140µs | BEGIN@12 | IO::Socket::
1 | 1 | 1 | 35µs | 60µs | getsockopt | IO::Socket::
3 | 3 | 3 | 31µs | 31µs | register_domain | IO::Socket::
1 | 1 | 1 | 30µs | 98µs | BEGIN@18 | IO::Socket::
1 | 1 | 1 | 30µs | 37µs | BEGIN@15 | IO::Socket::
1 | 1 | 1 | 27µs | 87µs | sockopt | IO::Socket::
1 | 1 | 1 | 25µs | 252µs | BEGIN@14 | IO::Socket::
1 | 1 | 1 | 25µs | 93µs | bind | IO::Socket::
1 | 1 | 1 | 19µs | 19µs | CORE:gsockopt (opcode) | IO::Socket::
1 | 1 | 1 | 18µs | 117µs | BEGIN@17 | IO::Socket::
1 | 1 | 1 | 6µs | 6µs | CORE:unpack (opcode) | IO::Socket::
0 | 0 | 0 | 0s | 0s | accept | IO::Socket::
0 | 0 | 0 | 0s | 0s | atmark | IO::Socket::
0 | 0 | 0 | 0s | 0s | blocking | IO::Socket::
0 | 0 | 0 | 0s | 0s | close | IO::Socket::
0 | 0 | 0 | 0s | 0s | configure | IO::Socket::
0 | 0 | 0 | 0s | 0s | connect | IO::Socket::
0 | 0 | 0 | 0s | 0s | connected | IO::Socket::
0 | 0 | 0 | 0s | 0s | listen | IO::Socket::
0 | 0 | 0 | 0s | 0s | protocol | IO::Socket::
0 | 0 | 0 | 0s | 0s | recv | IO::Socket::
0 | 0 | 0 | 0s | 0s | setsockopt | IO::Socket::
0 | 0 | 0 | 0s | 0s | shutdown | IO::Socket::
0 | 0 | 0 | 0s | 0s | sockdomain | IO::Socket::
0 | 0 | 0 | 0s | 0s | socketpair | IO::Socket::
0 | 0 | 0 | 0s | 0s | sockname | IO::Socket::
0 | 0 | 0 | 0s | 0s | socktype | IO::Socket::
0 | 0 | 0 | 0s | 0s | timeout | IO::Socket::
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 | |||||
8 | package IO::Socket; | ||||
9 | |||||
10 | 1 | 19µs | require 5.006; | ||
11 | |||||
12 | 2 | 87µs | 2 | 233µ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 # spent 140µs making 1 call to IO::Socket::BEGIN@12
# spent 93µs making 1 call to Exporter::import |
13 | 3 | 104µs | 3 | 11.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 # 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 |
14 | 2 | 87µs | 2 | 478µ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 # spent 252µs making 1 call to IO::Socket::BEGIN@14
# spent 227µs making 1 call to Exporter::import |
15 | 2 | 95µs | 2 | 45µ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 # spent 37µs making 1 call to IO::Socket::BEGIN@15
# spent 8µs making 1 call to strict::import |
16 | our(@ISA, $VERSION, @EXPORT_OK); | ||||
17 | 2 | 59µs | 2 | 216µ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 # spent 117µs making 1 call to IO::Socket::BEGIN@17
# spent 99µs making 1 call to Exporter::import |
18 | 2 | 4.09ms | 2 | 166µ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 # spent 98µs making 1 call to IO::Socket::BEGIN@18
# spent 68µs making 1 call to Exporter::import |
19 | |||||
20 | # legacy | ||||
21 | |||||
22 | 1 | 289µs | require IO::Socket::INET; | ||
23 | 1 | 267µs | require IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian'); | ||
24 | |||||
25 | 1 | 36µs | @ISA = qw(IO::Handle); | ||
26 | |||||
27 | 1 | 2µs | $VERSION = "1.38"; | ||
28 | |||||
29 | 1 | 3µ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 | ||||
32 | 10 | 25µs | my $pkg = shift; | ||
33 | 10 | 170µs | if (@_ && $_[0] eq 'sockatmark') { # not very extensible but for now, fast | ||
34 | Exporter::export_to_level('IO::Socket', 1, $pkg, 'sockatmark'); | ||||
35 | } else { | ||||
36 | 10 | 32µs | my $callpkg = caller; | ||
37 | 10 | 94µs | 10 | 723µ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 | ||||
42 | 3 | 16µs | my($class,%arg) = @_; | ||
43 | 3 | 37µs | 3 | 166µs | my $sock = $class->SUPER::new(); # spent 166µs making 3 calls to IO::Handle::new, avg 55µs/call |
44 | |||||
45 | 3 | 32µs | 3 | 444µs | $sock->autoflush(1); # spent 444µs making 3 calls to IO::Handle::autoflush, avg 148µs/call |
46 | |||||
47 | 6 | 35µs | ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout}; | ||
48 | |||||
49 | 3 | 62µs | 3 | 3.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 | |||||
53 | 1 | 2µs | my @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 | ||||
56 | 3 | 8µs | my($p,$d) = @_; | ||
57 | 3 | 55µs | $domain2pkg[$d] = $p; | ||
58 | } | ||||
59 | |||||
60 | sub 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 | ||||
78 | 3 | 7µs | @_ == 4 or croak 'usage: $sock->socket(DOMAIN, TYPE, PROTOCOL)'; | ||
79 | 3 | 8µs | my($sock,$domain,$type,$protocol) = @_; | ||
80 | |||||
81 | 3 | 150µs | 3 | 106µ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 | |||||
84 | 2 | 9µs | ${*$sock}{'io_socket_domain'} = $domain; | ||
85 | 2 | 7µs | ${*$sock}{'io_socket_type'} = $type; | ||
86 | 2 | 7µs | ${*$sock}{'io_socket_proto'} = $protocol; | ||
87 | |||||
88 | 1 | 7µs | $sock; | ||
89 | } | ||||
90 | |||||
91 | sub 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 | |||||
106 | sub 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 | sub 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 | |||||
205 | sub 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 | ||||
213 | 1 | 3µs | @_ == 2 or croak 'usage: $sock->bind(NAME)'; | ||
214 | 1 | 2µs | my $sock = shift; | ||
215 | 1 | 2µs | my $addr = shift; | ||
216 | |||||
217 | 1 | 89µs | 1 | 68µs | return bind($sock, $addr) ? $sock # spent 68µs making 1 call to IO::Socket::CORE:bind |
218 | : undef; | ||||
219 | } | ||||
220 | |||||
221 | sub 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 | |||||
231 | sub 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 | |||||
260 | sub 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 | ||||
266 | 1968 | 3.84ms | @_ == 1 or croak 'usage: $sock->peername()'; | ||
267 | 1968 | 3.76ms | my($sock) = @_; | ||
268 | 3936 | 34.1ms | 1 | 22µs | ${*$sock}{'io_socket_peername'} ||= getpeername($sock); # spent 22µs making 1 call to IO::Socket::CORE:getpeername |
269 | } | ||||
270 | |||||
271 | sub 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 | ||||
278 | 1968 | 4.93ms | @_ >= 2 && @_ <= 4 or croak 'usage: $sock->send(BUF, [FLAGS, [TO]])'; | ||
279 | 1968 | 3.94ms | my $sock = $_[0]; | ||
280 | 1968 | 4.14ms | my $flags = $_[2] || 0; | ||
281 | 1968 | 15.1ms | 1968 | 36.3ms | my $peer = $_[3] || $sock->peername; # spent 36.3ms making 1968 calls to IO::Socket::peername, avg 18µs/call |
282 | |||||
283 | 1968 | 3.72ms | croak 'send: Cannot determine peer address' | ||
284 | unless(defined $peer); | ||||
285 | |||||
286 | 1968 | 85.9ms | 3936 | 61.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 | ||||
291 | 1968 | 4.16ms | ${*$sock}{'io_socket_peername'} = $peer | ||
292 | if(@_ == 4 && defined $r); | ||||
293 | |||||
294 | 1968 | 31.7ms | $r; | ||
295 | } | ||||
296 | |||||
297 | sub 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 | |||||
307 | sub 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 | |||||
314 | sub setsockopt { | ||||
315 | @_ == 4 or croak '$sock->setsockopt(LEVEL, OPTNAME, OPTVAL)'; | ||||
316 | setsockopt($_[0],$_[1],$_[2],$_[3]); | ||||
317 | } | ||||
318 | |||||
319 | 1 | 2µs | 1 | 9µs | my $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 | ||||
322 | 1 | 3µs | @_ == 3 or croak '$sock->getsockopt(LEVEL, OPTNAME)'; | ||
323 | 1 | 31µs | 1 | 19µs | my $r = getsockopt($_[0],$_[1],$_[2]); # spent 19µs making 1 call to IO::Socket::CORE:gsockopt |
324 | # Just a guess | ||||
325 | 1 | 19µs | 1 | 6µs | $r = unpack("i", $r) # spent 6µs making 1 call to IO::Socket::CORE:unpack |
326 | if(defined $r && length($r) == $intsize); | ||||
327 | 1 | 10µ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 | ||||
331 | 1 | 2µs | my $sock = shift; | ||
332 | 1 | 25µs | 1 | 60µs | @_ == 1 ? $sock->getsockopt(SOL_SOCKET,@_) # spent 60µs making 1 call to IO::Socket::getsockopt |
333 | : $sock->setsockopt(SOL_SOCKET,@_); | ||||
334 | } | ||||
335 | |||||
336 | sub atmark { | ||||
337 | @_ == 1 or croak 'usage: $sock->atmark()'; | ||||
338 | my($sock) = @_; | ||||
339 | sockatmark($sock); | ||||
340 | } | ||||
341 | |||||
342 | sub 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 | |||||
353 | sub 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 | |||||
364 | sub 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 | |||||
372 | sub 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 | |||||
380 | 1 | 17µs | 1; | ||
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:getpeername; # opcode | |||||
# spent 19µs within IO::Socket::CORE:gsockopt which was called:
# once (19µs+0s) by IO::Socket::getsockopt at line 323 | |||||
# 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 | |||||
# 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 | |||||
# spent 6µs within IO::Socket::CORE:unpack which was called:
# once (6µs+0s) by IO::Socket::getsockopt at line 325 |