| File | /usr/local/lib/perl5/5.10.1/darwin-2level/IO/Socket.pm |
| Statements Executed | 126 |
| Statement Execution Time | 2.84ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 2 | 1 | 1 | 1.30ms | 41.1ms | IO::Socket::connect |
| 1 | 1 | 1 | 934µs | 2.32ms | IO::Socket::BEGIN@12 |
| 4 | 2 | 2 | 194µs | 194µs | IO::Socket::CORE:connect (opcode) |
| 2 | 1 | 2 | 115µs | 115µs | IO::Socket::CORE:socket (opcode) |
| 6 | 3 | 2 | 85µs | 129µs | IO::Socket::blocking |
| 2 | 1 | 1 | 79µs | 124ms | IO::Socket::new |
| 2 | 1 | 1 | 48µs | 164µs | IO::Socket::socket |
| 6 | 2 | 1 | 40µs | 65µs | IO::Socket::peername |
| 2 | 1 | 2 | 25µs | 25µs | IO::Socket::CORE:getpeername (opcode) |
| 1 | 1 | 1 | 18µs | 47µs | IO::Socket::BEGIN@11 |
| 2 | 2 | 2 | 18µs | 1.34ms | IO::Socket::import |
| 1 | 1 | 1 | 10µs | 40µs | IO::Socket::BEGIN@13 |
| 1 | 1 | 1 | 9µs | 22µs | IO::Socket::BEGIN@17 |
| 1 | 1 | 1 | 8µs | 24µs | IO::Socket::BEGIN@16 |
| 1 | 1 | 1 | 6µs | 9µs | IO::Socket::BEGIN@14 |
| 2 | 2 | 2 | 6µs | 6µs | IO::Socket::register_domain |
| 1 | 1 | 2 | 4µs | 4µs | IO::Socket::CORE:pack (opcode) |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::accept |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::atmark |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::bind |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::close |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::configure |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::connected |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::getsockopt |
| 0 | 0 | 0 | 0s | 0s | IO::Socket::listen |
| 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::setsockopt |
| 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::sockopt |
| 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 | 16µs | require 5.006; | ||
| 10 | |||||
| 11 | 3 | 30µs | 2 | 76µs | # spent 47µs (18+29) within IO::Socket::BEGIN@11 which was called
# once (18µs+29µs) by IO::Socket::INET::BEGIN@11 at line 11 # spent 47µs making 1 call to IO::Socket::BEGIN@11
# spent 29µs making 1 call to Exporter::import |
| 12 | 3 | 228µs | 3 | 3.14ms | # spent 2.32ms (934µs+1.39) within IO::Socket::BEGIN@12 which was called
# once (934µs+1.39ms) by IO::Socket::INET::BEGIN@11 at line 12 # spent 2.32ms making 1 call to IO::Socket::BEGIN@12
# spent 778µs making 1 call to Exporter::import
# spent 38µs making 1 call to UNIVERSAL::VERSION |
| 13 | 3 | 22µs | 2 | 69µs | # spent 40µs (10+30) within IO::Socket::BEGIN@13 which was called
# once (10µs+30µs) by IO::Socket::INET::BEGIN@11 at line 13 # spent 40µs making 1 call to IO::Socket::BEGIN@13
# spent 30µs making 1 call to Exporter::import |
| 14 | 3 | 32µs | 2 | 11µs | # spent 9µ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 # spent 9µs making 1 call to IO::Socket::BEGIN@14
# spent 2µs making 1 call to strict::import |
| 15 | 1 | 500ns | our(@ISA, $VERSION, @EXPORT_OK); | ||
| 16 | 3 | 20µs | 2 | 40µs | # spent 24µs (8+16) within IO::Socket::BEGIN@16 which was called
# once (8µs+16µs) by IO::Socket::INET::BEGIN@11 at line 16 # spent 24µs making 1 call to IO::Socket::BEGIN@16
# spent 16µs making 1 call to Exporter::import |
| 17 | 3 | 1.35ms | 2 | 34µs | # spent 22µs (9+13) within IO::Socket::BEGIN@17 which was called
# once (9µs+13µs) by IO::Socket::INET::BEGIN@11 at line 17 # spent 22µs making 1 call to IO::Socket::BEGIN@17
# spent 13µs making 1 call to Exporter::import |
| 18 | |||||
| 19 | # legacy | ||||
| 20 | |||||
| 21 | 1 | 400ns | require IO::Socket::INET; | ||
| 22 | 1 | 79µs | require IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian'); | ||
| 23 | |||||
| 24 | 1 | 11µs | @ISA = qw(IO::Handle); | ||
| 25 | |||||
| 26 | 1 | 300ns | $VERSION = "1.31"; | ||
| 27 | |||||
| 28 | 1 | 500ns | @EXPORT_OK = qw(sockatmark); | ||
| 29 | |||||
| 30 | # spent 1.34ms (18µs+1.32) within IO::Socket::import which was called 2 times, avg 670µs/call:
# once (11µs+683µs) by IO::Socket::UNIX::BEGIN@11 at line 11 of IO/Socket/UNIX.pm
# once (7µs+641µs) by IO::Socket::INET::BEGIN@11 at line 11 of IO/Socket/INET.pm | ||||
| 31 | 2 | 1µs | my $pkg = shift; | ||
| 32 | 2 | 6µ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 | 2 | 1µs | my $callpkg = caller; | ||
| 36 | 2 | 3µs | 2 | 38µs | Exporter::export 'Socket', $callpkg, @_; # spent 38µs making 2 calls to Exporter::export, avg 19µs/call |
| 37 | } | ||||
| 38 | } | ||||
| 39 | |||||
| 40 | # spent 124ms (79µs+124) within IO::Socket::new which was called 2 times, avg 62.2ms/call:
# 2 times (79µs+124ms) by IO::Socket::INET::new at line 37 of IO/Socket/INET.pm, avg 62.2ms/call | ||||
| 41 | 2 | 13µs | my($class,%arg) = @_; | ||
| 42 | 2 | 22µs | 2 | 53µs | my $sock = $class->SUPER::new(); # spent 53µs making 2 calls to IO::Handle::new, avg 26µs/call |
| 43 | |||||
| 44 | 2 | 18µs | 4 | 160µs | $sock->autoflush(1); # spent 147µs making 2 calls to IO::Handle::autoflush, avg 74µs/call
# spent 13µs making 2 calls to SelectSaver::DESTROY, avg 6µs/call |
| 45 | |||||
| 46 | 2 | 5µs | ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout}; | ||
| 47 | |||||
| 48 | 2 | 22µs | 2 | 124ms | return scalar(%arg) ? $sock->configure(\%arg) # spent 124ms making 2 calls to Net::HTTP::configure, avg 62.1ms/call |
| 49 | : $sock; | ||||
| 50 | } | ||||
| 51 | |||||
| 52 | 1 | 100ns | 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 LWP::Protocol::implementor at line 22 of IO/Socket/INET.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 164µs (48+115) within IO::Socket::socket which was called 2 times, avg 82µs/call:
# 2 times (48µs+115µs) by IO::Socket::INET::configure at line 180 of IO/Socket/INET.pm, avg 82µs/call | ||||
| 77 | 2 | 4µs | @_ == 4 or croak 'usage: $sock->socket(DOMAIN, TYPE, PROTOCOL)'; | ||
| 78 | 2 | 5µs | my($sock,$domain,$type,$protocol) = @_; | ||
| 79 | |||||
| 80 | 2 | 136µs | 2 | 115µs | socket($sock,$domain,$type,$protocol) or # spent 115µs making 2 calls to IO::Socket::CORE:socket, avg 58µs/call |
| 81 | return undef; | ||||
| 82 | |||||
| 83 | 2 | 3µs | ${*$sock}{'io_socket_domain'} = $domain; | ||
| 84 | 2 | 2µs | ${*$sock}{'io_socket_type'} = $type; | ||
| 85 | 2 | 2µs | ${*$sock}{'io_socket_proto'} = $protocol; | ||
| 86 | |||||
| 87 | 2 | 10µ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 | # spent 41.1ms (1.30+39.8) within IO::Socket::connect which was called 2 times, avg 20.5ms/call:
# 2 times (1.30ms+39.8ms) by IO::Socket::INET::connect at line 257 of IO/Socket/INET.pm, avg 20.5ms/call | ||||
| 106 | 2 | 2µs | @_ == 2 or croak 'usage: $sock->connect(NAME)'; | ||
| 107 | 2 | 1µs | my $sock = shift; | ||
| 108 | 2 | 2µs | my $addr = shift; | ||
| 109 | 2 | 2µs | my $timeout = ${*$sock}{'io_socket_timeout'}; | ||
| 110 | 2 | 300ns | my $err; | ||
| 111 | 2 | 300ns | my $blocking; | ||
| 112 | |||||
| 113 | 2 | 14µs | 2 | 57µs | $blocking = $sock->blocking(0) if $timeout; # spent 57µs making 2 calls to IO::Socket::blocking, avg 28µs/call |
| 114 | 2 | 200µs | 2 | 175µs | if (!connect($sock, $addr)) { # spent 175µs making 2 calls to IO::Socket::CORE:connect, avg 87µs/call |
| 115 | 2 | 30µs | 2 | 54µs | if (defined $timeout && ($!{EINPROGRESS} || $!{EWOULDBLOCK})) { # spent 54µs making 2 calls to Errno::FETCH, avg 27µs/call |
| 116 | 2 | 202µs | require IO::Select; | ||
| 117 | |||||
| 118 | 2 | 9µs | 2 | 101µs | my $sel = new IO::Select $sock; # spent 101µs making 2 calls to IO::Select::new, avg 51µs/call |
| 119 | |||||
| 120 | 2 | 2µs | undef $!; | ||
| 121 | 2 | 70µs | 6 | 39.1ms | if (!$sel->can_write($timeout)) { # spent 39.0ms making 2 calls to IO::Select::can_write, avg 19.5ms/call
# spent 58µs making 2 calls to Errno::FETCH, avg 29µs/call
# spent 20µs making 2 calls to IO::Socket::CORE:connect, avg 10µs/call |
| 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 | 2 | 10µs | 2 | 49µs | $sock->blocking(1) if $blocking; # spent 49µs making 2 calls to IO::Socket::blocking, avg 24µs/call |
| 142 | |||||
| 143 | 2 | 1µs | $! = $err if $err; | ||
| 144 | |||||
| 145 | 2 | 10µs | $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 | # spent 129µs (85+43) within IO::Socket::blocking which was called 6 times, avg 21µs/call:
# 2 times (37µs+20µs) by IO::Socket::connect at line 113, avg 28µs/call
# 2 times (34µs+15µs) by IO::Socket::connect at line 141, avg 24µs/call
# 2 times (15µs+8µs) by LWP::Protocol::http::_new_socket at line 48 of LWP/Protocol/http.pm, avg 11µs/call | ||||
| 155 | 6 | 4µs | my $sock = shift; | ||
| 156 | |||||
| 157 | 6 | 130µs | 6 | 43µs | return $sock->SUPER::blocking(@_) # spent 43µs making 6 calls to IO::Handle::blocking, avg 7µs/call |
| 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 | # spent 65µs (40+25) within IO::Socket::peername which was called 6 times, avg 11µs/call:
# 3 times (32µs+25µs) by IO::Socket::INET::peeraddr at line 291 of IO/Socket/INET.pm, avg 19µs/call
# 3 times (8µs+0s) by IO::Socket::INET::peerport at line 298 of IO/Socket/INET.pm, avg 3µs/call | ||||
| 250 | 6 | 2µs | @_ == 1 or croak 'usage: $sock->peername()'; | ||
| 251 | 6 | 3µs | my($sock) = @_; | ||
| 252 | 6 | 68µs | 2 | 25µs | ${*$sock}{'io_socket_peername'} ||= getpeername($sock); # spent 25µs making 2 calls to IO::Socket::CORE:getpeername, avg 12µs/call |
| 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 | 9µs | 1 | 4µs | my $intsize = length(pack("i",0)); # spent 4µ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 | 11µs | 1; | ||
| 356 | |||||
| 357 | __END__ | ||||
| 358 | |||||
| 359 | =head1 NAME | ||||
| 360 | |||||
| 361 | IO::Socket - Object interface to socket communications | ||||
| 362 | |||||
| 363 | =head1 SYNOPSIS | ||||
| 364 | |||||
| 365 | use IO::Socket; | ||||
| 366 | |||||
| 367 | =head1 DESCRIPTION | ||||
| 368 | |||||
| 369 | C<IO::Socket> provides an object interface to creating and using sockets. It | ||||
| 370 | is built upon the L<IO::Handle> interface and inherits all the methods defined | ||||
| 371 | by L<IO::Handle>. | ||||
| 372 | |||||
| 373 | C<IO::Socket> only defines methods for those operations which are common to all | ||||
| 374 | types of socket. Operations which are specified to a socket in a particular | ||||
| 375 | domain have methods defined in sub classes of C<IO::Socket> | ||||
| 376 | |||||
| 377 | C<IO::Socket> will export all functions (and constants) defined by L<Socket>. | ||||
| 378 | |||||
| 379 | =head1 CONSTRUCTOR | ||||
| 380 | |||||
| 381 | =over 4 | ||||
| 382 | |||||
| 383 | =item new ( [ARGS] ) | ||||
| 384 | |||||
| 385 | Creates an C<IO::Socket>, which is a reference to a | ||||
| 386 | newly created symbol (see the C<Symbol> package). C<new> | ||||
| 387 | optionally takes arguments, these arguments are in key-value pairs. | ||||
| 388 | C<new> only looks for one key C<Domain> which tells new which domain | ||||
| 389 | the socket will be in. All other arguments will be passed to the | ||||
| 390 | configuration method of the package for that domain, See below. | ||||
| 391 | |||||
| 392 | NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE | ||||
| 393 | |||||
| 394 | As of VERSION 1.18 all IO::Socket objects have autoflush turned on | ||||
| 395 | by default. This was not the case with earlier releases. | ||||
| 396 | |||||
| 397 | NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE | ||||
| 398 | |||||
| 399 | =back | ||||
| 400 | |||||
| 401 | =head1 METHODS | ||||
| 402 | |||||
| 403 | See L<perlfunc> for complete descriptions of each of the following | ||||
| 404 | supported C<IO::Socket> methods, which are just front ends for the | ||||
| 405 | corresponding built-in functions: | ||||
| 406 | |||||
| 407 | socket | ||||
| 408 | socketpair | ||||
| 409 | bind | ||||
| 410 | listen | ||||
| 411 | accept | ||||
| 412 | send | ||||
| 413 | recv | ||||
| 414 | peername (getpeername) | ||||
| 415 | sockname (getsockname) | ||||
| 416 | shutdown | ||||
| 417 | |||||
| 418 | Some methods take slightly different arguments to those defined in L<perlfunc> | ||||
| 419 | in attempt to make the interface more flexible. These are | ||||
| 420 | |||||
| 421 | =over 4 | ||||
| 422 | |||||
| 423 | =item accept([PKG]) | ||||
| 424 | |||||
| 425 | perform the system call C<accept> on the socket and return a new | ||||
| 426 | object. The new object will be created in the same class as the listen | ||||
| 427 | socket, unless C<PKG> is specified. This object can be used to | ||||
| 428 | communicate with the client that was trying to connect. | ||||
| 429 | |||||
| 430 | In a scalar context the new socket is returned, or undef upon | ||||
| 431 | failure. In a list context a two-element array is returned containing | ||||
| 432 | the new socket and the peer address; the list will be empty upon | ||||
| 433 | failure. | ||||
| 434 | |||||
| 435 | The timeout in the [PKG] can be specified as zero to effect a "poll", | ||||
| 436 | but you shouldn't do that because a new IO::Select object will be | ||||
| 437 | created behind the scenes just to do the single poll. This is | ||||
| 438 | horrendously inefficient. Use rather true select() with a zero | ||||
| 439 | timeout on the handle, or non-blocking IO. | ||||
| 440 | |||||
| 441 | =item socketpair(DOMAIN, TYPE, PROTOCOL) | ||||
| 442 | |||||
| 443 | Call C<socketpair> and return a list of two sockets created, or an | ||||
| 444 | empty list on failure. | ||||
| 445 | |||||
| 446 | =back | ||||
| 447 | |||||
| 448 | Additional methods that are provided are: | ||||
| 449 | |||||
| 450 | =over 4 | ||||
| 451 | |||||
| 452 | =item atmark | ||||
| 453 | |||||
| 454 | True if the socket is currently positioned at the urgent data mark, | ||||
| 455 | false otherwise. | ||||
| 456 | |||||
| 457 | use IO::Socket; | ||||
| 458 | |||||
| 459 | my $sock = IO::Socket::INET->new('some_server'); | ||||
| 460 | $sock->read($data, 1024) until $sock->atmark; | ||||
| 461 | |||||
| 462 | Note: this is a reasonably new addition to the family of socket | ||||
| 463 | functions, so all systems may not support this yet. If it is | ||||
| 464 | unsupported by the system, an attempt to use this method will | ||||
| 465 | abort the program. | ||||
| 466 | |||||
| 467 | The atmark() functionality is also exportable as sockatmark() function: | ||||
| 468 | |||||
| 469 | use IO::Socket 'sockatmark'; | ||||
| 470 | |||||
| 471 | This allows for a more traditional use of sockatmark() as a procedural | ||||
| 472 | socket function. If your system does not support sockatmark(), the | ||||
| 473 | C<use> declaration will fail at compile time. | ||||
| 474 | |||||
| 475 | =item connected | ||||
| 476 | |||||
| 477 | If the socket is in a connected state the peer address is returned. | ||||
| 478 | If the socket is not in a connected state then undef will be returned. | ||||
| 479 | |||||
| 480 | =item protocol | ||||
| 481 | |||||
| 482 | Returns the numerical number for the protocol being used on the socket, if | ||||
| 483 | known. If the protocol is unknown, as with an AF_UNIX socket, zero | ||||
| 484 | is returned. | ||||
| 485 | |||||
| 486 | =item sockdomain | ||||
| 487 | |||||
| 488 | Returns the numerical number for the socket domain type. For example, for | ||||
| 489 | an AF_INET socket the value of &AF_INET will be returned. | ||||
| 490 | |||||
| 491 | =item sockopt(OPT [, VAL]) | ||||
| 492 | |||||
| 493 | Unified method to both set and get options in the SOL_SOCKET level. If called | ||||
| 494 | with one argument then getsockopt is called, otherwise setsockopt is called. | ||||
| 495 | |||||
| 496 | =item socktype | ||||
| 497 | |||||
| 498 | Returns the numerical number for the socket type. For example, for | ||||
| 499 | a SOCK_STREAM socket the value of &SOCK_STREAM will be returned. | ||||
| 500 | |||||
| 501 | =item timeout([VAL]) | ||||
| 502 | |||||
| 503 | Set or get the timeout value associated with this socket. If called without | ||||
| 504 | any arguments then the current setting is returned. If called with an argument | ||||
| 505 | the current setting is changed and the previous value returned. | ||||
| 506 | |||||
| 507 | =back | ||||
| 508 | |||||
| 509 | =head1 SEE ALSO | ||||
| 510 | |||||
| 511 | L<Socket>, L<IO::Handle>, L<IO::Socket::INET>, L<IO::Socket::UNIX> | ||||
| 512 | |||||
| 513 | =head1 AUTHOR | ||||
| 514 | |||||
| 515 | Graham Barr. atmark() by Lincoln Stein. Currently maintained by the | ||||
| 516 | Perl Porters. Please report all bugs to <perl5-porters@perl.org>. | ||||
| 517 | |||||
| 518 | =head1 COPYRIGHT | ||||
| 519 | |||||
| 520 | Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved. | ||||
| 521 | This program is free software; you can redistribute it and/or | ||||
| 522 | modify it under the same terms as Perl itself. | ||||
| 523 | |||||
| 524 | The atmark() implementation: Copyright 2001, Lincoln Stein <lstein@cshl.org>. | ||||
| 525 | This module is distributed under the same terms as Perl itself. | ||||
| 526 | Feel free to use, modify and redistribute it as long as you retain | ||||
| 527 | the correct attribution. | ||||
| 528 | |||||
| 529 | =cut | ||||
# spent 194µs within IO::Socket::CORE:connect which was called 4 times, avg 49µs/call:
# 2 times (175µs+0s) by IO::Socket::connect at line 114 of IO/Socket.pm, avg 87µs/call
# 2 times (20µs+0s) by IO::Socket::connect at line 121 of IO/Socket.pm, avg 10µs/call | |||||
# spent 25µs within IO::Socket::CORE:getpeername which was called 2 times, avg 12µs/call:
# 2 times (25µs+0s) by IO::Socket::peername at line 252 of IO/Socket.pm, avg 12µs/call | |||||
# spent 4µs within IO::Socket::CORE:pack which was called
# once (4µs+0s) by IO::Socket::INET::BEGIN@11 at line 303 of IO/Socket.pm | |||||
# spent 115µs within IO::Socket::CORE:socket which was called 2 times, avg 58µs/call:
# 2 times (115µs+0s) by IO::Socket::socket at line 80 of IO/Socket.pm, avg 58µs/call |