package IO::Socket;
-require 5.000;
+require 5.005_64;
use IO::Handle;
use Socket 1.3;
use Carp;
use strict;
-use vars qw(@ISA $VERSION);
+our(@ISA, $VERSION);
use Exporter;
+use Errno;
# legacy
require IO::Socket::INET;
-require IO::Socket::UNIX;
+require IO::Socket::UNIX if ($^O ne 'epoc');
@ISA = qw(IO::Handle);
-$VERSION = "1.251";
+$VERSION = "1.26";
sub import {
my $pkg = shift;
}
sub socketpair {
- @_ == 4 || croak 'usage: IO::Socket->pair(DOMAIN, TYPE, PROTOCOL)';
+ @_ == 4 || croak 'usage: IO::Socket->socketpair(DOMAIN, TYPE, PROTOCOL)';
my($class,$domain,$type,$protocol) = @_;
my $sock1 = $class->new();
my $sock2 = $class->new();
my $sock = shift;
my $addr = shift;
my $timeout = ${*$sock}{'io_socket_timeout'};
-
+ my $err;
my $blocking;
$blocking = $sock->blocking(0) if $timeout;
- eval {
- croak 'connect: Bad address'
- if(@_ == 2 && !defined $_[1]);
-
- unless(connect($sock, $addr)) {
- if($timeout && ($! == &IO::EINPROGRESS)) {
- require IO::Select;
+ if (!connect($sock, $addr)) {
+ if ($timeout && $!{EINPROGRESS}) {
+ require IO::Select;
- my $sel = new IO::Select $sock;
+ my $sel = new IO::Select $sock;
- unless($sel->can_write($timeout) && defined($sock->peername)) {
- croak "connect: timeout";
- }
+ if (!$sel->can_write($timeout)) {
+ $err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
+ $@ = "connect: timeout";
}
- else {
- croak "connect: $!";
+ elsif(!connect($sock,$addr) && not $!{EISCONN}) {
+ # Some systems refuse to re-connect() to
+ # an already open socket and set errno to EISCONN.
+ $err = $!;
+ $@ = "connect: $!";
}
}
- };
+ else {
+ $err = $!;
+ $@ = "connect: $!";
+ }
+ }
- my $ret = $@ ? undef : $sock;
+ $sock->blocking(1) if $blocking;
- $sock->blocking($blocking) if $timeout;
+ $! = $err if $err;
- $ret;
+ $err ? undef : $sock;
}
sub bind {
my $new = $pkg->new(Timeout => $timeout);
my $peer = undef;
- eval {
- if($timeout) {
- require IO::Select;
+ if($timeout) {
+ require IO::Select;
- my $sel = new IO::Select $sock;
+ my $sel = new IO::Select $sock;
+
+ unless ($sel->can_read($timeout)) {
+ $@ = 'accept: timeout';
+ $! = (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
+ return;
+ }
+ }
- croak "accept: timeout"
- unless $sel->can_read($timeout);
- }
- $peer = accept($new,$sock) || undef;
- };
+ $peer = accept($new,$sock)
+ or return;
- return wantarray ? defined $peer ? ($new, $peer)
- : ()
- : defined $peer ? $new
- : undef;
+ return wantarray ? ($new, $peer)
+ : $new;
}
sub sockname {
sub protocol {
@_ == 1 or croak 'usage: $sock->protocol()';
my($sock) = @_;
- ${*$sock}{'io_socket_protocol'};
+ ${*$sock}{'io_socket_proto'};
}
1;
configuration method of the package for that domain, See below.
NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
-
+
As of VERSION 1.18 all IO::Socket objects have autoflush turned on
by default. This was not the case with earlier releases.
new object will be created in the same class as the listen socket, unless
C<PKG> is specified. This object can be used to communicate with the client
that was trying to connect. In a scalar context the new socket is returned,
-or undef upon failure. In an array context a two-element array is returned
-containing the new socket and the peer address, the list will
+or undef upon failure. In a list context a two-element array is returned
+containing the new socket and the peer address; the list will
be empty upon failure.
-Additional methods that are provided are
+=item socketpair(DOMAIN, TYPE, PROTOCOL)
+
+Call C<socketpair> and return a list of two sockets created, or an
+empty list on failure.
+
+=back
+
+Additional methods that are provided are:
+
+=over 4
=item timeout([VAL])