Profile of IO/Socket.pm

← 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
Statements | Executed 2700103 statements in 13.3s

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
100001 | 1 | 1 | 2.91s | 17.4s | IO::Socket::::acceptIO::Socket::accept
100003 | 1 | 1 | 2.19s | 13.5s | IO::Socket::::newIO::Socket::new
100001 | 1 | 1 | 1.21s | 5.14s | IO::Socket::::closeIO::Socket::close
200002 | 2 | 1 | 1.13s | 1.34s | IO::Socket::::peernameIO::Socket::peername
100002 | 2 | 2 | 1.02s | 1.32s | IO::Socket::::setsockoptIO::Socket::setsockopt
100002 | 1 | 1 | 295ms | 295ms | IO::Socket::::CORE:ssockoptIO::Socket::CORE:ssockopt (opcode)
100001 | 1 | 1 | 207ms | 207ms | IO::Socket::::CORE:getpeernameIO::Socket::CORE:getpeername (opcode)
1 | 1 | 1 | 1.96ms | 2.90ms | IO::Socket::::BEGIN@12IO::Socket::BEGIN@12
3 | 3 | 3 | 25µs | 6.80ms | IO::Socket::::importIO::Socket::import
1 | 1 | 1 | 23µs | 23µs | IO::Socket::::CORE:socketIO::Socket::CORE:socket (opcode)
1 | 1 | 1 | 13µs | 26µs | IO::Socket::::BEGIN@11IO::Socket::BEGIN@11
1 | 1 | 1 | 9µs | 32µs | IO::Socket::::socketIO::Socket::socket
1 | 1 | 1 | 8µs | 17µs | IO::Socket::::BEGIN@17IO::Socket::BEGIN@17
1 | 1 | 1 | 8µs | 12µs | IO::Socket::::bindIO::Socket::bind
1 | 1 | 1 | 7µs | 16µs | IO::Socket::::BEGIN@14IO::Socket::BEGIN@14
1 | 1 | 1 | 7µs | 36µs | IO::Socket::::BEGIN@13IO::Socket::BEGIN@13
1 | 1 | 1 | 7µs | 18µs | IO::Socket::::BEGIN@16IO::Socket::BEGIN@16
1 | 1 | 1 | 7µs | 18µs | IO::Socket::::sockoptIO::Socket::sockopt
1 | 1 | 1 | 7µs | 7µs | IO::Socket::::CORE:listenIO::Socket::CORE:listen (opcode)
1 | 1 | 1 | 7µs | 13µs | IO::Socket::::listenIO::Socket::listen
2 | 2 | 2 | 5µs | 5µs | IO::Socket::::register_domainIO::Socket::register_domain
1 | 1 | 1 | 4µs | 4µs | IO::Socket::::CORE:bindIO::Socket::CORE:bind (opcode)
100002 | 1 | 1 | 0s | 0s | IO::Socket::::CORE:acceptIO::Socket::CORE:accept (opcode)
0 | 0 | 0 | 0s | 0s | IO::Socket::::atmarkIO::Socket::atmark
0 | 0 | 0 | 0s | 0s | IO::Socket::::blockingIO::Socket::blocking
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::::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::::shutdownIO::Socket::shutdown
0 | 0 | 0 | 0s | 0s | IO::Socket::::sockdomainIO::Socket::sockdomain
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::::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 | 8µs |  |  | require 5.006;
10 |  |  |  |  |
11 | 2 | 25µs | 2 | 38µ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
12 | 3 | 131µs | 3 | 3.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
13 | 2 | 21µs | 2 | 65µ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
14 | 2 | 33µs | 2 | 25µ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
15 | 1 | 400ns |  |  | our(@ISA, $VERSION, @EXPORT_OK);
16 | 2 | 19µs | 2 | 30µ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
17 | 2 | 1.46ms | 2 | 26µ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 |  |  |  |  |
21 | 1 | 300ns |  |  | require IO::Socket::INET;
22 | 1 | 78µs |  |  | require IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian');
23 |  |  |  |  |
24 | 1 | 10µs |  |  | @ISA = qw(IO::Handle);
25 |  |  |  |  |
26 | 1 | 300ns |  |  | $VERSION = "1.36";
27 |  |  |  |  |
28 | 1 | 400ns |  |  | @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 {
31 | 3 | 1µs |  |  | my $pkg = shift;
32 | 3 | 10µ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 | 5µs | 3 | 49µ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 {
41 | 100003 | 268ms |  |  | my($class,%arg) = @_;
42 | 100003 | 411ms | 100003 | 3.09s | my $sock = $class->SUPER::new(); # spent 3.09s making 100003 calls to IO::Handle::new, avg 31µs/call
43 |  |  |  |  |
44 | 100003 | 921ms | 200006 | 9.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 |  |  |  |  |
46 | 100003 | 303ms |  |  | ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
47 |  |  |  |  |
48 | 100003 | 567ms | 1 | 168µs | return scalar(%arg) ? $sock->configure(\%arg) # spent 168µs making 1 call to IO::Socket::INET::configure
49 |  |  |  |  | : $sock;
50 |  |  |  |  | }
51 |  |  |  |  |
52 | 1 | 100ns |  |  | my @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 {
55 | 2 | 1µs |  |  | my($p,$d) = @_;
56 | 2 | 10µ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 |  |  |  |  | # 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 {
77 | 1 | 600ns |  |  | @_ == 4 or croak 'usage: $sock->socket(DOMAIN, TYPE, PROTOCOL)';
78 | 1 | 500ns |  |  | my($sock,$domain,$type,$protocol) = @_;
79 |  |  |  |  |
80 | 1 | 27µs | 1 | 23µs | socket($sock,$domain,$type,$protocol) or # spent 23µs making 1 call to IO::Socket::CORE:socket
81 |  |  |  |  | return undef;
82 |  |  |  |  |
83 | 1 | 900ns |  |  | ${*$sock}{'io_socket_domain'} = $domain;
84 | 1 | 600ns |  |  | ${*$sock}{'io_socket_type'} = $type;
85 | 1 | 700ns |  |  | ${*$sock}{'io_socket_proto'} = $protocol;
86 |  |  |  |  |
87 | 1 | 3µs |  |  | $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 |  |  |  |  | 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 |  |  |  |  |
165 |  |  |  |  | sub 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 {
202 | 100001 | 82.0ms |  |  | @_ == 1 or croak 'usage: $sock->close()';
203 | 100001 | 69.6ms |  |  | my $sock = shift;
204 | 100001 | 165ms |  |  | ${*$sock}{'io_socket_peername'} = undef;
205 | 100001 | 803ms | 100001 | 3.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 {
209 | 1 | 600ns |  |  | @_ == 2 or croak 'usage: $sock->bind(NAME)';
210 | 1 | 300ns |  |  | my $sock = shift;
211 | 1 | 400ns |  |  | my $addr = shift;
212 |  |  |  |  |
213 | 1 | 13µs | 1 | 4µ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 {
218 | 1 | 600ns |  |  | @_ >= 1 && @_ <= 2 or croak 'usage: $sock->listen([QUEUE])';
219 | 1 | 400ns |  |  | my($sock,$queue) = @_;
220 | 1 | 400ns |  |  | $queue = 5
221 |  |  |  |  | unless $queue && $queue > 0;
222 |  |  |  |  |
223 | 1 | 13µs | 1 | 7µ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 {
228 | 100002 | 115ms |  |  | @_ == 1 || @_ == 2 or croak 'usage $sock->accept([PKG])';
229 | 100002 | 77.0ms |  |  | my $sock = shift;
230 | 100002 | 63.6ms |  |  | my $pkg = shift || $sock;
231 | 100002 | 161ms |  |  | my $timeout = ${*$sock}{'io_socket_timeout'};
232 | 100002 | 417ms | 100002 | 14.5s | my $new = $pkg->new(Timeout => $timeout); # spent 14.5s making 100002 calls to IO::Socket::INET::new, avg 145µs/call
233 | 100002 | 51.7ms |  |  | my $peer = undef;
234 |  |  |  |  |
235 | 100002 | 47.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 |  |  |  |  |
247 | 100002 | 4.07s | 100002 | 0s | $peer = accept($new,$sock) # spent 0s making 100002 calls to IO::Socket::CORE:accept, avg 0s/call
248 |  |  |  |  | or return;
249 |  |  |  |  |
250 | 100001 | 782ms |  |  | ${*$new}{$_} = ${*$sock}{$_} for qw( io_socket_domain io_socket_type io_socket_proto );
251 |  |  |  |  |
252 | 100001 | 519ms |  |  | return wantarray ? ($new, $peer)
253 |  |  |  |  | : $new;
254 |  |  |  |  | }
255 |  |  |  |  |
256 |  |  |  |  | sub 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 {
262 | 200002 | 99.5ms |  |  | @_ == 1 or croak 'usage: $sock->peername()';
263 | 200002 | 66.5ms |  |  | my($sock) = @_;
264 | 200002 | 1.69s | 100001 | 207ms | ${*$sock}{'io_socket_peername'} ||= getpeername($sock); # spent 207ms making 100001 calls to IO::Socket::CORE:getpeername, avg 2µs/call
265 |  |  |  |  | }
266 |  |  |  |  |
267 |  |  |  |  | sub connected {
268 |  |  |  |  | @_ == 1 or croak 'usage: $sock->connected()';
269 |  |  |  |  | my($sock) = @_;
270 |  |  |  |  | getpeername($sock);
271 |  |  |  |  | }
272 |  |  |  |  |
273 |  |  |  |  | sub 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 |  |  |  |  |
293 |  |  |  |  | sub 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 |  |  |  |  |
303 |  |  |  |  | sub 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 {
311 | 100002 | 84.5ms |  |  | @_ == 4 or croak '$sock->setsockopt(LEVEL, OPTNAME, OPTVAL)';
312 | 100002 | 1.45s | 100002 | 295ms | setsockopt($_[0],$_[1],$_[2],$_[3]); # spent 295ms making 100002 calls to IO::Socket::CORE:ssockopt, avg 3µs/call
313 |  |  |  |  | }
314 |  |  |  |  |
315 | 1 | 200ns | 1 | 3µs | my $intsize = length(pack("i",0)); # spent 3µs making 1 call to main::CORE:pack
316 |  |  |  |  |
317 |  |  |  |  | sub 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 {
327 | 1 | 400ns |  |  | my $sock = shift;
328 | 1 | 5µs | 1 | 10µs | @_ == 1 ? $sock->getsockopt(SOL_SOCKET,@_) # spent 10µs making 1 call to IO::Socket::setsockopt
329 |  |  |  |  | : $sock->setsockopt(SOL_SOCKET,@_);
330 |  |  |  |  | }
331 |  |  |  |  |
332 |  |  |  |  | sub atmark {
333 |  |  |  |  | @_ == 1 or croak 'usage: $sock->atmark()';
334 |  |  |  |  | my($sock) = @_;
335 |  |  |  |  | sockatmark($sock);
336 |  |  |  |  | }
337 |  |  |  |  |
338 |  |  |  |  | sub 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 |  |  |  |  |
349 |  |  |  |  | sub 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 |  |  |  |  |
360 |  |  |  |  | sub 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 |  |  |  |  |
368 |  |  |  |  | sub 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 |  |  |  |  |
376 | 1 | 4µs |  |  | 1;
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