X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;ds=sidebyside;f=perl%2FMsg.pm;h=5aef961ee4f4162593228d0c1abd71a41dd52fef;hb=60bd15a823797c01182ebfb8b6b3a5bf10065b42;hp=30519a0764b9c0ddec9dcc7330277cb68d600986;hpb=94b9e6854969b7c7419a4ef39eb83a70ca1a85f8;p=spider.git diff --git a/perl/Msg.pm b/perl/Msg.pm index 30519a07..5aef961e 100644 --- a/perl/Msg.pm +++ b/perl/Msg.pm @@ -52,12 +52,26 @@ BEGIN { eval { require Errno; Errno->import(qw(EAGAIN EINPROGRESS EWOULDBLOCK)); }; + + unless ($^O eq 'MSWin32') { + if ($] >= 5.6) { + eval { + require Socket; Socket->import(qw(IPPROTO_TCP TCP_NODELAY)); + }; + } else { + dbg("IPPROTO_TCP and TCP_NODELAY manually defined"); + eval 'sub IPPROTO_TCP { 6 };'; + eval 'sub TCP_NODELAY { 1 };'; + } + } # http://support.microsoft.com/support/kb/articles/Q150/5/37.asp # defines EINPROGRESS as 10035. We provide it here because some # Win32 users report POSIX::EINPROGRESS is not vendor-supported. if ($^O eq 'MSWin32') { eval '*EINPROGRESS = sub { 10036 };'; eval '*EWOULDBLOCK = *EAGAIN = sub { 10035 };'; + eval '*F_GETFL = sub { 0 };'; + eval '*F_SETFL = sub { 0 };'; $blocking_supported = 1; } } @@ -119,21 +133,21 @@ sub blocking return unless $blocking_supported; # Make the handle stop blocking, the Windows way. - if ($main::iswin) { - # 126 is FIONBIO (some docs say 0x7F << 16) - ioctl( $_[0], - 0x80000000 | (4 << 16) | (ord('f') << 8) | 126, - "$_[1]" - ); - } - - my $flags = fcntl ($_[0], F_GETFL, 0); - if ($_[1]) { - $flags &= ~O_NONBLOCK; + if ($main::is_win) { + # 126 is FIONBIO (some docs say 0x7F << 16) + ioctl( $_[0], + 0x80000000 | (4 << 16) | (ord('f') << 8) | 126, + "$_[1]" + ); } else { - $flags |= O_NONBLOCK; + my $flags = fcntl ($_[0], F_GETFL, 0); + if ($_[1]) { + $flags &= ~O_NONBLOCK; + } else { + $flags |= O_NONBLOCK; + } + fcntl ($_[0], F_SETFL, $flags); } - fcntl ($_[0], F_SETFL, $flags); } # save it @@ -373,14 +387,6 @@ sub new_server { return $self; } -my $oldw = $^W; -$^W = 0; -eval "use Socket qw(IPPROTO_TCP TCP_NODELAY)"; -$^W = $oldw; -if ($@ && !$main::inwin) { - sub IPPROTO_TCP {6;} - sub TCP_NODELAY {1;}; -} sub nolinger { @@ -395,7 +401,9 @@ sub nolinger setsockopt($conn->{sock}, SOL_SOCKET, SO_LINGER, pack("ll", 0, 0)) or confess "setsockopt linger: $!"; setsockopt($conn->{sock}, SOL_SOCKET, SO_KEEPALIVE, 1) or confess "setsockopt keepalive: $!"; - setsockopt($conn->{sock}, IPPROTO_TCP, TCP_NODELAY, 1) or confess "setsockopt: $!" unless $main::iswin; + unless ($main::is_win) { + setsockopt($conn->{sock}, IPPROTO_TCP, TCP_NODELAY, 1) or confess "setsockopt: $!"; + } $conn->{sock}->autoflush(0); if (isdbg('sock')) {