X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FMsg.pm;h=8be2fc1bf071d39dd464907de8397da7fdd27891;hb=41beb204d8c619d5929f9b1368972885e1f49965;hp=03151ca1976aa8906a2b7d7566143ae65dd83f8f;hpb=61660841afb3901002602e4956f09de5567bc950;p=spider.git

diff --git a/perl/Msg.pm b/perl/Msg.pm
index 03151ca1..8be2fc1b 100644
--- a/perl/Msg.pm
+++ b/perl/Msg.pm
@@ -16,7 +16,7 @@ use IO::Socket;
 use DXDebug;
 use Timer;
 
-use vars qw(%rd_callbacks %wt_callbacks %er_callbacks $rd_handles $wt_handles $er_handles $now %conns $noconns $blocking_supported);
+use vars qw(%rd_callbacks %wt_callbacks %er_callbacks $rd_handles $wt_handles $er_handles $now %conns $noconns $blocking_supported $cnum);
 
 %rd_callbacks = ();
 %wt_callbacks = ();
@@ -33,11 +33,11 @@ BEGIN {
         require POSIX; POSIX->import(qw(O_NONBLOCK F_SETFL F_GETFL))
     };
 	if ($@ || $main::is_win) {
-		print STDERR "POSIX Blocking *** NOT *** supported $@\n";
+#		print STDERR "POSIX Blocking *** NOT *** supported $@\n";
 		$blocking_supported = 0;
 	} else {
 		$blocking_supported = 1;
-		print STDERR "POSIX Blocking enabled\n";
+#		print STDERR "POSIX Blocking enabled\n";
 	}
 
 
@@ -53,6 +53,8 @@ my $eagain = eval {EAGAIN()};
 my $einprogress = eval {EINPROGRESS()};
 my $ewouldblock = eval {EWOULDBLOCK()};
 $^W = $w;
+$cnum = 0;
+
 
 #
 #-----------------------------------------------------------------
@@ -73,9 +75,11 @@ sub new
 		csort => 'telnet',
 		timeval => 60,
 		blocking => 0,
-		cnum => ++$noconns,
+		cnum => (($cnum < 999) ? (++$cnum) : ($cnum = 1)),
     };
 
+	$noconns++;
+	
 	dbg('connll', "Connection created ($noconns)");
 	return bless $conn, $class;
 }
@@ -119,6 +123,7 @@ sub conns
 		$call = $pkg->{call} unless $call;
 		return undef unless $call;
 		dbg('connll', "changing $pkg->{call} to $call") if exists $pkg->{call} && $call ne $pkg->{call};
+		delete $conns{$pkg->{call}} if exists $pkg->{call} && exists $conns{$pkg->{call}} && $pkg->{call} ne $call; 
 		$pkg->{call} = $call;
 		$ref = $conns{$call} = $pkg;
 		dbg('connll', "Connection $pkg->{cnum} $call stored");
@@ -282,13 +287,11 @@ sub _send {
         delete $conn->{send_offset};
         $offset = 0;
         shift @$rq;
-        last unless $flush; # Go back to select and wait
+        #last unless $flush; # Go back to select and wait
                             # for it to fire again.
     }
     # Call me back if queue has not been drained.
-    if (@$rq) {
-        set_event_handler ($sock, write => sub {$conn->_send(0)});
-    } else {
+    unless (@$rq) {
         set_event_handler ($sock, write => undef);
 		if (exists $conn->{close_on_empty}) {
 			&{$conn->{eproc}}($conn, undef) if exists $conn->{eproc};
@@ -395,7 +398,9 @@ FINISH:
 		&{$conn->{eproc}}($conn, $!) if exists $conn->{eproc};
 		$conn->disconnect;
     } else {
-		$conn->dequeue if exists $conn->{msg};
+		unless ($conn->{disable_read}) {
+			$conn->dequeue if exists $conn->{msg};
+		}
 	}
 }
 
@@ -441,6 +446,13 @@ sub close_all_clients
 	}
 }
 
+sub disable_read
+{
+	my $conn = shift;
+	set_event_handler ($conn->{sock}, read => undef);
+	return $_[0] ? $conn->{disable_read} = $_[0] : $_[0];
+}
+
 #
 #----------------------------------------------------
 # Event loop routines used by both client and server