diff options
| author | Karl Berry <karl@freefriends.org> | 2012-11-20 18:08:54 +0000 |
|---|---|---|
| committer | Karl Berry <karl@freefriends.org> | 2012-11-20 18:08:54 +0000 |
| commit | c5add2ea5067382269ae6f19e345fda0b9a7bd21 (patch) | |
| tree | 02f512fda46d93079c9dc59c0d76f0e398150f83 /Master/tlpkg/tlperl/lib/IO/Socket.pm | |
| parent | 6c35e87bdc5a3f64833dbbc42e7d42e683db9d5b (diff) | |
perl 5.16.2, compiled without optimization for Windows (from siep)
git-svn-id: svn://tug.org/texlive/trunk@28315 c570f23f-e606-0410-a88d-b1316a301751
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 |