Profile of /usr/local/lib/perl5/5.10.1/darwin-2level/IO/Socket.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For 01.HTTP.t
Run on Tue May 4 15:25:55 2010
Reported on Tue May 4 15:26:09 2010

File | /usr/local/lib/perl5/5.10.1/darwin-2level/IO/Socket.pm
Statements Executed | 128
Statement Execution Time | 2.84ms

Subroutines — ordered by exclusive time
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
2 | 1 | 1 | 1.30ms | 41.1ms | IO::Socket::::connectIO::Socket::connect
1 | 1 | 1 | 934µs | 2.32ms | IO::Socket::::BEGIN@12IO::Socket::BEGIN@12
4 | 2 | 2 | 194µs | 194µs | IO::Socket::::CORE:connectIO::Socket::CORE:connect (opcode)
2 | 1 | 2 | 115µs | 115µs | IO::Socket::::CORE:socketIO::Socket::CORE:socket (opcode)
6 | 3 | 2 | 85µs | 129µs | IO::Socket::::blockingIO::Socket::blocking
2 | 1 | 1 | 79µs | 124ms | IO::Socket::::newIO::Socket::new
2 | 1 | 1 | 48µs | 164µs | IO::Socket::::socketIO::Socket::socket
6 | 2 | 1 | 40µs | 65µs | IO::Socket::::peernameIO::Socket::peername
2 | 1 | 2 | 25µs | 25µs | IO::Socket::::CORE:getpeernameIO::Socket::CORE:getpeername (opcode)
1 | 1 | 1 | 18µs | 47µs | IO::Socket::::BEGIN@11IO::Socket::BEGIN@11
2 | 2 | 2 | 18µs | 1.34ms | IO::Socket::::importIO::Socket::import
1 | 1 | 1 | 10µs | 40µs | IO::Socket::::BEGIN@13IO::Socket::BEGIN@13
1 | 1 | 1 | 9µs | 22µs | IO::Socket::::BEGIN@17IO::Socket::BEGIN@17
1 | 1 | 1 | 8µs | 24µs | IO::Socket::::BEGIN@16IO::Socket::BEGIN@16
1 | 1 | 1 | 6µs | 9µs | IO::Socket::::BEGIN@14IO::Socket::BEGIN@14
2 | 2 | 2 | 6µs | 6µs | IO::Socket::::register_domainIO::Socket::register_domain
1 | 1 | 2 | 4µs | 4µs | IO::Socket::::CORE:packIO::Socket::CORE:pack (opcode)
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::::closeIO::Socket::close
0 | 0 | 0 | 0s | 0s | IO::Socket::::configureIO::Socket::configure
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::::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::::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 | 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 use IO::Handle; # 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 use Socket 1.3; # 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 use Carp; # 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 use strict; # 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 use Exporter; # 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 use Errno; # 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 sub import {
31 | 4 | 7µs |  |  | my $pkg = shift;
32 | 4 | 4µ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 |  |  |  |  | my $callpkg = caller;
36 |  |  |  |  | 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 sub new {
41 | 10 | 73µs |  |  | my($class,%arg) = @_;
42 |  |  |  |  | my $sock = $class->SUPER::new(); # spent 53µs making 2 calls to IO::Handle::new, avg 26µs/call
43 |  |  |  |  |
44 | 1 | 8µ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 |  |  |  |  | ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
47 |  |  |  |  |
48 |  |  |  |  | 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 sub register_domain {
55 | 4 | 12µs |  |  | my($p,$d) = @_;
56 |  |  |  |  | $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 sub socket {
77 | 14 | 163µs |  |  | @_ == 4 or croak 'usage: $sock->socket(DOMAIN, TYPE, PROTOCOL)';
78 |  |  |  |  | my($sock,$domain,$type,$protocol) = @_;
79 |  |  |  |  |
80 |  |  |  |  | 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 |  |  |  |  | ${*$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 |  |  |  |  | # 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 sub connect {
106 | 22 | 242µs |  |  | @_ == 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; # spent 57µs making 2 calls to IO::Socket::blocking, avg 28µs/call
114 | 2 | 26µs | 2 | 175µs | if (!connect($sock, $addr)) { # spent 175µs making 2 calls to IO::Socket::CORE:connect, avg 87µs/call
115 | 8 | 281µs | 2 | 54µs | if (defined $timeout && ($!{EINPROGRESS} || $!{EWOULDBLOCK})) { # spent 54µs making 2 calls to Errno::FETCH, avg 27µs/call
116 |  |  |  |  | require IO::Select;
117 |  |  |  |  |
118 |  |  |  |  | my $sel = new IO::Select $sock; # spent 101µs making 2 calls to IO::Select::new, avg 51µs/call
119 |  |  |  |  |
120 |  |  |  |  | undef $!;
121 | 1 | 7µ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 |  |  |  |  | $sock->blocking(1) if $blocking; # spent 49µs making 2 calls to IO::Socket::blocking, avg 24µs/call
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 |  |  |  |  | # 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 sub blocking {
155 | 12 | 134µs |  |  | my $sock = shift;
156 |  |  |  |  |
157 |  |  |  |  | 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 sub peername {
250 | 18 | 73µs |  |  | @_ == 1 or croak 'usage: $sock->peername()';
251 |  |  |  |  | my($sock) = @_;
252 |  |  |  |  | ${*$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 sub IO::Socket::CORE:connect; # xsub
|  |  |  |  | # 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 sub IO::Socket::CORE:getpeername; # xsub
|  |  |  |  | # 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 sub IO::Socket::CORE:pack; # xsub
|  |  |  |  | # 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 sub IO::Socket::CORE:socket; # xsub