Profile of IO/Socket.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For xt/tapper-mcp-scheduler-with-db-longrun.t
Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:23:51 2012

Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/5.12.3/x86_64-linux/IO/Socket.pm
Statements | Executed 44 statements in 1.65ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
3 | 3 | 3 | 26µs | 2.80ms | IO::Socket::::importIO::Socket::import
1 | 1 | 1 | 24µs | 732µs | IO::Socket::::BEGIN@12IO::Socket::BEGIN@12
1 | 1 | 1 | 11µs | 23µs | IO::Socket::::BEGIN@11IO::Socket::BEGIN@11
1 | 1 | 1 | 9µs | 20µs | IO::Socket::::BEGIN@17IO::Socket::BEGIN@17
1 | 1 | 1 | 8µs | 39µs | IO::Socket::::BEGIN@13IO::Socket::BEGIN@13
1 | 1 | 1 | 8µs | 8µs | IO::Socket::::CORE:packIO::Socket::CORE:pack (opcode)
1 | 1 | 1 | 7µs | 19µs | IO::Socket::::BEGIN@16IO::Socket::BEGIN@16
1 | 1 | 1 | 6µs | 8µs | IO::Socket::::BEGIN@14IO::Socket::BEGIN@14
2 | 2 | 2 | 6µs | 6µs | IO::Socket::::register_domainIO::Socket::register_domain
0 | 0 | 0 | 0s | 0s | IO::Socket::::acceptIO::Socket::accept
0 | 0 | 0 | 0s | 0s | IO::Socket::::atmarkIO::Socket::atmark
0 | 0 | 0 | 0s | 0s | IO::Socket::::bindIO::Socket::bind
0 | 0 | 0 | 0s | 0s | IO::Socket::::blockingIO::Socket::blocking
0 | 0 | 0 | 0s | 0s | IO::Socket::::closeIO::Socket::close
0 | 0 | 0 | 0s | 0s | IO::Socket::::configureIO::Socket::configure
0 | 0 | 0 | 0s | 0s | IO::Socket::::connectIO::Socket::connect
0 | 0 | 0 | 0s | 0s | IO::Socket::::connectedIO::Socket::connected
0 | 0 | 0 | 0s | 0s | IO::Socket::::getsockoptIO::Socket::getsockopt
0 | 0 | 0 | 0s | 0s | IO::Socket::::listenIO::Socket::listen
0 | 0 | 0 | 0s | 0s | IO::Socket::::newIO::Socket::new
0 | 0 | 0 | 0s | 0s | IO::Socket::::peernameIO::Socket::peername
0 | 0 | 0 | 0s | 0s | IO::Socket::::protocolIO::Socket::protocol
0 | 0 | 0 | 0s | 0s | IO::Socket::::recvIO::Socket::recv
0 | 0 | 0 | 0s | 0s | IO::Socket::::sendIO::Socket::send
0 | 0 | 0 | 0s | 0s | IO::Socket::::setsockoptIO::Socket::setsockopt
0 | 0 | 0 | 0s | 0s | IO::Socket::::shutdownIO::Socket::shutdown
0 | 0 | 0 | 0s | 0s | IO::Socket::::sockdomainIO::Socket::sockdomain
0 | 0 | 0 | 0s | 0s | IO::Socket::::socketIO::Socket::socket
0 | 0 | 0 | 0s | 0s | IO::Socket::::socketpairIO::Socket::socketpair
0 | 0 | 0 | 0s | 0s | IO::Socket::::socknameIO::Socket::sockname
0 | 0 | 0 | 0s | 0s | IO::Socket::::sockoptIO::Socket::sockopt
0 | 0 | 0 | 0s | 0s | IO::Socket::::socktypeIO::Socket::socktype
0 | 0 | 0 | 0s | 0s | IO::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 |  |  |  |  |
7 |  |  |  |  | package IO::Socket;
8 |  |  |  |  |
9 | 1 | 24µs |  |  | require 5.006;
10 |  |  |  |  |
11 | 3 | 19µs | 2 | 35µs | # spent 23µs (11+12) within IO::Socket::BEGIN@11 which was called: # once (11µs+12µs) by IO::Socket::INET::BEGIN@11 at line 11 use IO::Handle; # spent 23µs making 1 call to IO::Socket::BEGIN@11 # spent 12µs making 1 call to Exporter::import
12 | 3 | 50µs | 3 | 1.44ms | # spent 732µs (24+708) within IO::Socket::BEGIN@12 which was called: # once (24µs+708µs) by IO::Socket::INET::BEGIN@11 at line 12 use Socket 1.3; # spent 732µs making 1 call to IO::Socket::BEGIN@12 # spent 687µs making 1 call to Exporter::import # spent 21µs making 1 call to UNIVERSAL::VERSION
13 | 3 | 18µs | 2 | 70µs | # spent 39µs (8+31) within IO::Socket::BEGIN@13 which was called: # once (8µs+31µs) by IO::Socket::INET::BEGIN@11 at line 13 use Carp; # spent 39µs making 1 call to IO::Socket::BEGIN@13 # spent 31µs making 1 call to Exporter::import
14 | 3 | 48µs | 2 | 10µs | # spent 8µs (6+2) within IO::Socket::BEGIN@14 which was called: # once (6µs+2µs) by IO::Socket::INET::BEGIN@11 at line 14 use strict; # spent 8µs making 1 call to IO::Socket::BEGIN@14 # spent 2µs making 1 call to strict::import
15 | 1 | 700ns |  |  | our(@ISA, $VERSION, @EXPORT_OK);
16 | 3 | 17µs | 2 | 30µs | # spent 19µ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 19µs making 1 call to IO::Socket::BEGIN@16 # spent 11µs making 1 call to Exporter::import
17 | 3 | 1.32ms | 2 | 30µs | # spent 20µs (9+11) within IO::Socket::BEGIN@17 which was called: # once (9µs+11µs) by IO::Socket::INET::BEGIN@11 at line 17 use Errno; # spent 20µs making 1 call to IO::Socket::BEGIN@17 # spent 10µs making 1 call to Exporter::import
18 |  |  |  |  |
19 |  |  |  |  | # legacy
20 |  |  |  |  |
21 | 1 | 400ns |  |  | require IO::Socket::INET;
22 | 1 | 88µs |  |  | require IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian');
23 |  |  |  |  |
24 | 1 | 12µs |  |  | @ISA = qw(IO::Handle);
25 |  |  |  |  |
26 | 1 | 600ns |  |  | $VERSION = "1.31";
27 |  |  |  |  |
28 | 1 | 500ns |  |  | @EXPORT_OK = qw(sockatmark);
29 |  |  |  |  |
30 |  |  |  |  | # spent 2.80ms (26µs+2.77) within IO::Socket::import which was called 3 times, avg 932µs/call: # once (9µs+1.28ms) by Tapper::MCP::Net::BEGIN@13 at line 13 of lib/Tapper/MCP/Net.pm # once (11µs+785µs) by IO::Socket::UNIX::BEGIN@11 at line 11 of IO/Socket/UNIX.pm # once (6µs+708µs) by IO::Socket::INET::BEGIN@11 at line 11 of IO/Socket/INET.pm sub import {
31 | 3 | 2µs |  |  | my $pkg = shift;
32 | 3 | 9µs |  |  | if (@_ && $_[0] eq 'sockatmark') { # not very extensible but for now, fast
33 |  |  |  |  | Exporter::export_to_level('IO::Socket', 1, $pkg, 'sockatmark');
34 |  |  |  |  | } else {
35 | 3 | 2µs |  |  | my $callpkg = caller;
36 | 3 | 6µs | 3 | 57µs | Exporter::export 'Socket', $callpkg, @_; # spent 57µs making 3 calls to Exporter::export, avg 19µs/call
37 |  |  |  |  | }
38 |  |  |  |  | }
39 |  |  |  |  |
40 |  |  |  |  | sub new {
41 |  |  |  |  | my($class,%arg) = @_;
42 |  |  |  |  | my $sock = $class->SUPER::new();
43 |  |  |  |  |
44 |  |  |  |  | $sock->autoflush(1);
45 |  |  |  |  |
46 |  |  |  |  | ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
47 |  |  |  |  |
48 |  |  |  |  | return scalar(%arg) ? $sock->configure(\%arg)
49 |  |  |  |  | : $sock;
50 |  |  |  |  | }
51 |  |  |  |  |
52 | 1 | 300ns |  |  | my @domain2pkg;
53 |  |  |  |  |
54 |  |  |  |  | # spent 6µs within IO::Socket::register_domain which was called 2 times, avg 3µs/call: # once (3µs+0s) by IO::Socket::INET::BEGIN@11 at line 18 of IO/Socket/UNIX.pm # once (3µs+0s) by Tapper::MCP::Net::BEGIN@13 at line 22 of IO/Socket/INET.pm sub register_domain {
55 | 2 | 1µs |  |  | my($p,$d) = @_;
56 | 2 | 9µs |  |  | $domain2pkg[$d] = $p;
57 |  |  |  |  | }
58 |  |  |  |  |
59 |  |  |  |  | sub 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 |  |  |  |  | sub socket {
77 |  |  |  |  | @_ == 4 or croak 'usage: $sock->socket(DOMAIN, TYPE, PROTOCOL)';
78 |  |  |  |  | my($sock,$domain,$type,$protocol) = @_;
79 |  |  |  |  |
80 |  |  |  |  | socket($sock,$domain,$type,$protocol) or
81 |  |  |  |  | return undef;
82 |  |  |  |  |
83 |  |  |  |  | ${*$sock}{'io_socket_domain'} = $domain;
84 |  |  |  |  | ${*$sock}{'io_socket_type'} = $type;
85 |  |  |  |  | ${*$sock}{'io_socket_proto'} = $protocol;
86 |  |  |  |  |
87 |  |  |  |  | $sock;
88 |  |  |  |  | }
89 |  |  |  |  |
90 |  |  |  |  | sub 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 |  |  |  |  |
105 |  |  |  |  | sub 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 |  |  |  |  | if (!$sel->can_write($timeout)) {
122 |  |  |  |  | $err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
123 |  |  |  |  | $@ = "connect: timeout";
124 |  |  |  |  | }
125 |  |  |  |  | elsif (!connect($sock,$addr) &&
126 |  |  |  |  | not ($!{EISCONN} || ($! == 10022 && $^O eq 'MSWin32'))
127 |  |  |  |  | ) {
128 |  |  |  |  | # Some systems refuse to re-connect() to
129 |  |  |  |  | # an already open socket and set errno to EISCONN.
130 |  |  |  |  | # Windows sets errno to WSAEINVAL (10022)
131 |  |  |  |  | $err = $!;
132 |  |  |  |  | $@ = "connect: $!";
133 |  |  |  |  | }
134 |  |  |  |  | }
135 |  |  |  |  | elsif ($blocking || !($!{EINPROGRESS} || $!{EWOULDBLOCK})) {
136 |  |  |  |  | $err = $!;
137 |  |  |  |  | $@ = "connect: $!";
138 |  |  |  |  | }
139 |  |  |  |  | }
140 |  |  |  |  |
141 |  |  |  |  | $sock->blocking(1) if $blocking;
142 |  |  |  |  |
143 |  |  |  |  | $! = $err if $err;
144 |  |  |  |  |
145 |  |  |  |  | $err ? undef : $sock;
146 |  |  |  |  | }
147 |  |  |  |  |
148 |  |  |  |  | # Enable/disable blocking IO on sockets.
149 |  |  |  |  | # Without args return the current status of blocking,
150 |  |  |  |  | # with args change the mode as appropriate, returning the
151 |  |  |  |  | # old setting, or in case of error during the mode change
152 |  |  |  |  | # undef.
153 |  |  |  |  |
154 |  |  |  |  | sub blocking {
155 |  |  |  |  | my $sock = shift;
156 |  |  |  |  |
157 |  |  |  |  | return $sock->SUPER::blocking(@_)
158 |  |  |  |  | if $^O ne 'MSWin32';
159 |  |  |  |  |
160 |  |  |  |  | # Windows handles blocking differently
161 |  |  |  |  | #
162 |  |  |  |  | # http://groups.google.co.uk/group/perl.perl5.porters/browse_thread/thread/b4e2b1d88280ddff/630b667a66e3509f?#630b667a66e3509f
163 |  |  |  |  | # http://msdn.microsoft.com/library/default.asp?url=/library/en-us/winsock/winsock/ioctlsocket_2.asp
164 |  |  |  |  | #
165 |  |  |  |  | # 0x8004667e is FIONBIO
166 |  |  |  |  | #
167 |  |  |  |  | # which is used to set blocking behaviour.
168 |  |  |  |  |
169 |  |  |  |  | # NOTE:
170 |  |  |  |  | # This is a little confusing, the perl keyword for this is
171 |  |  |  |  | # 'blocking' but the OS level behaviour is 'non-blocking', probably
172 |  |  |  |  | # because sockets are blocking by default.
173 |  |  |  |  | # Therefore internally we have to reverse the semantics.
174 |  |  |  |  |
175 |  |  |  |  | my $orig= !${*$sock}{io_sock_nonblocking};
176 |  |  |  |  |
177 |  |  |  |  | return $orig unless @_;
178 |  |  |  |  |
179 |  |  |  |  | my $block = shift;
180 |  |  |  |  |
181 |  |  |  |  | if ( !$block != !$orig ) {
182 |  |  |  |  | ${*$sock}{io_sock_nonblocking} = $block ? 0 : 1;
183 |  |  |  |  | ioctl($sock, 0x8004667e, pack("L!",${*$sock}{io_sock_nonblocking}))
184 |  |  |  |  | or return undef;
185 |  |  |  |  | }
186 |  |  |  |  |
187 |  |  |  |  | return $orig;
188 |  |  |  |  | }
189 |  |  |  |  |
190 |  |  |  |  |
191 |  |  |  |  | sub close {
192 |  |  |  |  | @_ == 1 or croak 'usage: $sock->close()';
193 |  |  |  |  | my $sock = shift;
194 |  |  |  |  | ${*$sock}{'io_socket_peername'} = undef;
195 |  |  |  |  | $sock->SUPER::close();
196 |  |  |  |  | }
197 |  |  |  |  |
198 |  |  |  |  | sub bind {
199 |  |  |  |  | @_ == 2 or croak 'usage: $sock->bind(NAME)';
200 |  |  |  |  | my $sock = shift;
201 |  |  |  |  | my $addr = shift;
202 |  |  |  |  |
203 |  |  |  |  | return bind($sock, $addr) ? $sock
204 |  |  |  |  | : undef;
205 |  |  |  |  | }
206 |  |  |  |  |
207 |  |  |  |  | sub listen {
208 |  |  |  |  | @_ >= 1 && @_ <= 2 or croak 'usage: $sock->listen([QUEUE])';
209 |  |  |  |  | my($sock,$queue) = @_;
210 |  |  |  |  | $queue = 5
211 |  |  |  |  | unless $queue && $queue > 0;
212 |  |  |  |  |
213 |  |  |  |  | return listen($sock, $queue) ? $sock
214 |  |  |  |  | : undef;
215 |  |  |  |  | }
216 |  |  |  |  |
217 |  |  |  |  | sub accept {
218 |  |  |  |  | @_ == 1 || @_ == 2 or croak 'usage $sock->accept([PKG])';
219 |  |  |  |  | my $sock = shift;
220 |  |  |  |  | my $pkg = shift || $sock;
221 |  |  |  |  | my $timeout = ${*$sock}{'io_socket_timeout'};
222 |  |  |  |  | my $new = $pkg->new(Timeout => $timeout);
223 |  |  |  |  | my $peer = undef;
224 |  |  |  |  |
225 |  |  |  |  | if(defined $timeout) {
226 |  |  |  |  | require IO::Select;
227 |  |  |  |  |
228 |  |  |  |  | my $sel = new IO::Select $sock;
229 |  |  |  |  |
230 |  |  |  |  | unless ($sel->can_read($timeout)) {
231 |  |  |  |  | $@ = 'accept: timeout';
232 |  |  |  |  | $! = (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
233 |  |  |  |  | return;
234 |  |  |  |  | }
235 |  |  |  |  | }
236 |  |  |  |  |
237 |  |  |  |  | $peer = accept($new,$sock)
238 |  |  |  |  | or return;
239 |  |  |  |  |
240 |  |  |  |  | return wantarray ? ($new, $peer)
241 |  |  |  |  | : $new;
242 |  |  |  |  | }
243 |  |  |  |  |
244 |  |  |  |  | sub sockname {
245 |  |  |  |  | @_ == 1 or croak 'usage: $sock->sockname()';
246 |  |  |  |  | getsockname($_[0]);
247 |  |  |  |  | }
248 |  |  |  |  |
249 |  |  |  |  | sub peername {
250 |  |  |  |  | @_ == 1 or croak 'usage: $sock->peername()';
251 |  |  |  |  | my($sock) = @_;
252 |  |  |  |  | ${*$sock}{'io_socket_peername'} ||= getpeername($sock);
253 |  |  |  |  | }
254 |  |  |  |  |
255 |  |  |  |  | sub connected {
256 |  |  |  |  | @_ == 1 or croak 'usage: $sock->connected()';
257 |  |  |  |  | my($sock) = @_;
258 |  |  |  |  | getpeername($sock);
259 |  |  |  |  | }
260 |  |  |  |  |
261 |  |  |  |  | sub send {
262 |  |  |  |  | @_ >= 2 && @_ <= 4 or croak 'usage: $sock->send(BUF, [FLAGS, [TO]])';
263 |  |  |  |  | my $sock = $_[0];
264 |  |  |  |  | my $flags = $_[2] || 0;
265 |  |  |  |  | my $peer = $_[3] || $sock->peername;
266 |  |  |  |  |
267 |  |  |  |  | croak 'send: Cannot determine peer address'
268 |  |  |  |  | unless(defined $peer);
269 |  |  |  |  |
270 |  |  |  |  | my $r = defined(getpeername($sock))
271 |  |  |  |  | ? send($sock, $_[1], $flags)
272 |  |  |  |  | : send($sock, $_[1], $flags, $peer);
273 |  |  |  |  |
274 |  |  |  |  | # remember who we send to, if it was successful
275 |  |  |  |  | ${*$sock}{'io_socket_peername'} = $peer
276 |  |  |  |  | if(@_ == 4 && defined $r);
277 |  |  |  |  |
278 |  |  |  |  | $r;
279 |  |  |  |  | }
280 |  |  |  |  |
281 |  |  |  |  | sub recv {
282 |  |  |  |  | @_ == 3 || @_ == 4 or croak 'usage: $sock->recv(BUF, LEN [, FLAGS])';
283 |  |  |  |  | my $sock = $_[0];
284 |  |  |  |  | my $len = $_[2];
285 |  |  |  |  | my $flags = $_[3] || 0;
286 |  |  |  |  |
287 |  |  |  |  | # remember who we recv'd from
288 |  |  |  |  | ${*$sock}{'io_socket_peername'} = recv($sock, $_[1]='', $len, $flags);
289 |  |  |  |  | }
290 |  |  |  |  |
291 |  |  |  |  | sub shutdown {
292 |  |  |  |  | @_ == 2 or croak 'usage: $sock->shutdown(HOW)';
293 |  |  |  |  | my($sock, $how) = @_;
294 |  |  |  |  | ${*$sock}{'io_socket_peername'} = undef;
295 |  |  |  |  | shutdown($sock, $how);
296 |  |  |  |  | }
297 |  |  |  |  |
298 |  |  |  |  | sub setsockopt {
299 |  |  |  |  | @_ == 4 or croak '$sock->setsockopt(LEVEL, OPTNAME, OPTVAL)';
300 |  |  |  |  | setsockopt($_[0],$_[1],$_[2],$_[3]);
301 |  |  |  |  | }
302 |  |  |  |  |
303 | 1 | 13µs | 1 | 8µs | my $intsize = length(pack("i",0)); # spent 8µs making 1 call to IO::Socket::CORE:pack
304 |  |  |  |  |
305 |  |  |  |  | sub getsockopt {
306 |  |  |  |  | @_ == 3 or croak '$sock->getsockopt(LEVEL, OPTNAME)';
307 |  |  |  |  | my $r = getsockopt($_[0],$_[1],$_[2]);
308 |  |  |  |  | # Just a guess
309 |  |  |  |  | $r = unpack("i", $r)
310 |  |  |  |  | if(defined $r && length($r) == $intsize);
311 |  |  |  |  | $r;
312 |  |  |  |  | }
313 |  |  |  |  |
314 |  |  |  |  | sub sockopt {
315 |  |  |  |  | my $sock = shift;
316 |  |  |  |  | @_ == 1 ? $sock->getsockopt(SOL_SOCKET,@_)
317 |  |  |  |  | : $sock->setsockopt(SOL_SOCKET,@_);
318 |  |  |  |  | }
319 |  |  |  |  |
320 |  |  |  |  | sub atmark {
321 |  |  |  |  | @_ == 1 or croak 'usage: $sock->atmark()';
322 |  |  |  |  | my($sock) = @_;
323 |  |  |  |  | sockatmark($sock);
324 |  |  |  |  | }
325 |  |  |  |  |
326 |  |  |  |  | sub timeout {
327 |  |  |  |  | @_ == 1 || @_ == 2 or croak 'usage: $sock->timeout([VALUE])';
328 |  |  |  |  | my($sock,$val) = @_;
329 |  |  |  |  | my $r = ${*$sock}{'io_socket_timeout'};
330 |  |  |  |  |
331 |  |  |  |  | ${*$sock}{'io_socket_timeout'} = defined $val ? 0 + $val : $val
332 |  |  |  |  | if(@_ == 2);
333 |  |  |  |  |
334 |  |  |  |  | $r;
335 |  |  |  |  | }
336 |  |  |  |  |
337 |  |  |  |  | sub sockdomain {
338 |  |  |  |  | @_ == 1 or croak 'usage: $sock->sockdomain()';
339 |  |  |  |  | my $sock = shift;
340 |  |  |  |  | ${*$sock}{'io_socket_domain'};
341 |  |  |  |  | }
342 |  |  |  |  |
343 |  |  |  |  | sub socktype {
344 |  |  |  |  | @_ == 1 or croak 'usage: $sock->socktype()';
345 |  |  |  |  | my $sock = shift;
346 |  |  |  |  | ${*$sock}{'io_socket_type'}
347 |  |  |  |  | }
348 |  |  |  |  |
349 |  |  |  |  | sub protocol {
350 |  |  |  |  | @_ == 1 or croak 'usage: $sock->protocol()';
351 |  |  |  |  | my($sock) = @_;
352 |  |  |  |  | ${*$sock}{'io_socket_proto'};
353 |  |  |  |  | }
354 |  |  |  |  |
355 | 1 | 7µs |  |  | 1;
356 |  |  |  |  |
357 |  |  |  |  | __END__
|  |  |  |  | # spent 8µs within IO::Socket::CORE:pack which was called: # once (8µs+0s) by IO::Socket::INET::BEGIN@11 at line 303 sub IO::Socket::CORE:pack; # opcode