diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/IO/Socket.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/IO/Socket.pm | 18 |
1 files changed, 15 insertions, 3 deletions
diff --git a/Master/tlpkg/tlperl/lib/IO/Socket.pm b/Master/tlpkg/tlperl/lib/IO/Socket.pm index 31fa18f95d4..529423b5fde 100644 --- a/Master/tlpkg/tlperl/lib/IO/Socket.pm +++ b/Master/tlpkg/tlperl/lib/IO/Socket.pm @@ -1,3 +1,4 @@ + # IO::Socket.pm # # Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved. @@ -23,7 +24,7 @@ require IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian'); @ISA = qw(IO::Handle); -$VERSION = "1.32"; +$VERSION = "1.34"; @EXPORT_OK = qw(sockatmark); @@ -118,7 +119,18 @@ sub connect { my $sel = new IO::Select $sock; undef $!; - if (!$sel->can_write($timeout)) { + my($r,$w,$e) = IO::Select::select(undef,$sel,$sel,$timeout); + if(@$e[0]) { + # Windows return from select after the timeout in case of + # WSAECONNREFUSED(10061) if exception set is not used. + # This behavior is different from Linux. + # Using the exception + # set we now emulate the behavior in Linux + # - Karthik Rajagopalan + $err = $sock->getsockopt(SOL_SOCKET,SO_ERROR); + $@ = "connect: $err"; + } + elsif(!@$w[0]) { $err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1); $@ = "connect: timeout"; } @@ -524,7 +536,7 @@ L<Socket>, L<IO::Handle>, L<IO::Socket::INET>, L<IO::Socket::UNIX> =head1 AUTHOR Graham Barr. atmark() by Lincoln Stein. Currently maintained by the -Perl Porters. Please report all bugs to <perl5-porters@perl.org>. +Perl Porters. Please report all bugs to <perlbug@perl.org>. =head1 COPYRIGHT |