| Filename | /usr/lib/perl/5.18/IO/Socket.pm |
| Statements | Executed 2700103 statements in 13.3s |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 100001 | 1 | 1 | 2.91s | 17.4s | IO::Socket::accept |
| 100003 | 1 | 1 | 2.19s | 13.5s | IO::Socket::new |
| 100001 | 1 | 1 | 1.21s | 5.14s | IO::Socket::close |
| 200002 | 2 | 1 | 1.13s | 1.34s | IO::Socket::peername |
| 100002 | 2 | 2 | 1.02s | 1.32s | IO::Socket::setsockopt |
| 100002 | 1 | 1 | 295ms | 295ms | IO::Socket::CORE:ssockopt (opcode) |
| 100001 | 1 | 1 | 207ms | 207ms | IO::Socket::CORE:getpeername (opcode) |
| 1 | 1 | 1 | 1.96ms | 2.90ms | IO::Socket::BEGIN@12 |
| 3 | 3 | 3 | 25µs | 6.80ms | IO::Socket::import |
| 1 | 1 | 1 | 23µs | 23µs | IO::Socket::CORE:socket (opcode) |
| 1 | 1 | 1 | 13µs | 26µs | IO::Socket::BEGIN@11 |
| 1 | 1 | 1 | 9µs | 32µs | IO::Socket::socket |
| 1 | 1 | 1 | 8µs | 17µs | IO::Socket::BEGIN@17 |
| 1 | 1 | 1 | 8µs | 12µs | IO::Socket::bind |
| 1 | 1 | 1 | 7µs | 16µs | IO::Socket::BEGIN@14 |
| 1 | 1 | 1 | 7µs | 36µs | IO::Socket::BEGIN@13 |
| 1 | 1 | 1 | 7µs | 18µs | IO::Socket::BEGIN@16 |
| 1 | 1 | 1 | 7µs | 18µs | IO::Socket::sockopt |
| 1 | 1 | 1 | 7µs | 7µs | IO::Socket::CORE:listen (opcode) |
| 1 | 1 | 1 | 7µs | 13µs | IO::Socket::listen |
| 2 | 2 | 2 | 5µs | 5µs | IO::Socket::register_domain |
| 1 | 1 | 1 | 4µs | 4µs | IO::Socket::CORE:bind (opcode) |
| 100002 | 1 | 1 | 0s | 0s | IO::Socket::CORE:accept (opcode) |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::atmark |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::blocking |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::configure |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::connect |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::connected |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::getsockopt |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::protocol |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::recv |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::send |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::shutdown |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::sockdomain |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::socketpair |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::sockname |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::socktype |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::timeout |
| 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 # 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 # 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 # 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 # 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 # 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 # 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 | ||||
| 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 | ||||
| 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 | ||||
| 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 | ||||
| 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 | ||||
| 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 | ||||
| 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 | ||||
| 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 | ||||
| 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 | ||||
| 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 | ||||
| 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 | ||||
| 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 | |||||
# spent 4µs within IO::Socket::CORE:bind which was called:
# once (4µs+0s) by IO::Socket::bind at line 213 | |||||
# 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 | |||||
# spent 7µs within IO::Socket::CORE:listen which was called:
# once (7µs+0s) by IO::Socket::listen at line 223 | |||||
# spent 23µs within IO::Socket::CORE:socket which was called:
# once (23µs+0s) by IO::Socket::socket at line 80 | |||||
# 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 |