use strict;
our(@ISA, $VERSION);
use Exporter;
+use Errno;
# legacy
@ISA = qw(IO::Handle);
-$VERSION = "1.252";
+$VERSION = "1.26";
sub import {
my $pkg = shift;
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;
- };
- croak "$@" if $@ and $sock;
-
- return wantarray ? defined $peer ? ($new, $peer)
- : ()
- : defined $peer ? $new
- : undef;
+ $peer = accept($new,$sock)
+ or return;
+
+ return wantarray ? ($new, $peer)
+ : $new;
}
sub sockname {
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
+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.