X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FMsg.pm;h=f1f60edfb6f845e5e04604a41c1a49785380a33f;hb=9bba449d12641232d51d259f470ce6b21205c622;hp=aa5edc48bd4a8ba454005f3ff8c3e5df5f8fc7cf;hpb=503b6b1f503860def06f4e2121b0367e856081cd;p=spider.git

diff --git a/perl/Msg.pm b/perl/Msg.pm
index aa5edc48..f1f60edf 100644
--- a/perl/Msg.pm
+++ b/perl/Msg.pm
@@ -32,8 +32,9 @@ BEGIN {
     eval {
         require POSIX; POSIX->import(qw(O_NONBLOCK F_SETFL F_GETFL))
     };
-	if ($@) {
+	if ($@ || $main::is_win) {
 		print STDERR "POSIX Blocking *** NOT *** supported $@\n";
+		$blocking_supported = 0;
 	} else {
 		$blocking_supported = 1;
 		print STDERR "POSIX Blocking enabled\n";
@@ -195,7 +196,7 @@ sub disconnect {
 	$call ||= 'unallocated';
 	dbg('connll', "Connection $call disconnected");
 	
-	unless ($^O =~ /^MS/i) {
+	unless ($main::is_win) {
 		kill 'TERM', $conn->{pid} if exists $conn->{pid};
 	}
 
@@ -271,7 +272,10 @@ sub _send {
 					$conn->disconnect;
                     return 0; # fail. Message remains in queue ..
                 }
-            }
+            } elsif (isdbg('raw')) {
+				my $call = $conn->{call} || 'none';
+				dbgdump('raw', "$call send $bytes_written: ", $msg);
+			}
             $offset         += $bytes_written;
             $bytes_to_write -= $bytes_written;
         }
@@ -373,6 +377,10 @@ sub _rcv {                     # Complement to _send
 	if (defined ($bytes_read)) {
 		if ($bytes_read > 0) {
 			$conn->{msg} .= $msg;
+			if (isdbg('raw')) {
+				my $call = $conn->{call} || 'none';
+				dbgdump('raw', "$call read $bytes_read: ", $msg);
+			}
 		} 
 	} else {
 		if (_err_will_block($!)) {
@@ -481,7 +489,7 @@ sub event_loop {
        # Quit the loop if no handles left to process
         last unless ($rd_handles->count() || $wt_handles->count());
         
-		($rset, $wset) = IO::Select->select($rd_handles, $wt_handles, $er_handles, $timeout);
+		($rset, $wset, $eset) = IO::Select->select($rd_handles, $wt_handles, $er_handles, $timeout);
 		
         foreach $e (@$eset) {
             &{$er_callbacks{$e}}($e) if exists $er_callbacks{$e};