X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FMsg.pm;h=165596d270265b34c2fc5cba785cc633f1f58b5c;hb=532c5c9e14a48ec17d38dce5d904a3b612a2563b;hp=57880ed112f825f9d445a4bdf7397375f4ac0835;hpb=0a86c4341dfe313546f605c32959810cbf5bc288;p=spider.git diff --git a/perl/Msg.pm b/perl/Msg.pm index 57880ed1..165596d2 100644 --- a/perl/Msg.pm +++ b/perl/Msg.pm @@ -52,12 +52,25 @@ BEGIN { eval { require Errno; Errno->import(qw(EAGAIN EINPROGRESS EWOULDBLOCK)); }; + + eval { + require Socket; Socket->import(qw(IPPROTO_TCP TCP_NODELAY)); + }; + unless (*IPPROTO_TCP && !$^O =~ /^MS/) { + dbg("IPPROTO_TCP and TCP_NODELAY manually defined"); + eval '*IPPROTO_TCP = sub { 6 };'; + eval '*TCP_NODELAY = sub { 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 };'; + eval '*IPPROTO_TCP = sub { 6 };'; + eval '*TCP_NODELAY = sub { 1 };'; $blocking_supported = 1; } } @@ -119,23 +132,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 +386,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 +400,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')) {