X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FMsg.pm;h=5aef961ee4f4162593228d0c1abd71a41dd52fef;hb=60bd15a823797c01182ebfb8b6b3a5bf10065b42;hp=57880ed112f825f9d445a4bdf7397375f4ac0835;hpb=0a86c4341dfe313546f605c32959810cbf5bc288;p=spider.git diff --git a/perl/Msg.pm b/perl/Msg.pm index 57880ed1..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,23 +133,21 @@ sub blocking return unless $blocking_supported; # Make the handle stop blocking, the Windows way. - if ($^O eq 'MSWin32') { - my $set_it = $_[1]; - - # 126 is FIONBIO (some docs say 0x7F << 16) - ioctl( $_[0], - 0x80000000 | (4 << 16) | (ord('f') << 8) | 126, - $set_it - ) or confess "Can't set the handle non-blocking: $!"; - } - - 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 @@ -375,11 +387,6 @@ sub new_server { return $self; } -eval "use Socket qw(IPPROTO_TCP TCP_NODELAY)"; -if ($@) { - sub IPPROTO_TCP {6;} - sub TCP_NODELAY {1;}; -} sub nolinger { @@ -394,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')) {