X-Git-Url: http://scm.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;ds=sidebyside;f=perl%2FMsg.pm;h=1ed5377c20f890238aba810e798f4c54ec5bfeef;hb=ee8c2e94a865274a859ffc3e57d043e24dcf39df;hp=ec07d61da6878851f6b8f11f19aba403e5729cbd;hpb=51ed97f9175c71dd611f8333adeee346760d6a98;p=spider.git

diff --git a/perl/Msg.pm b/perl/Msg.pm
index ec07d61d..1ed5377c 100644
--- a/perl/Msg.pm
+++ b/perl/Msg.pm
@@ -66,6 +66,7 @@ sub new
 		lineend => "\r\n",
 		csort => 'telnet',
 		timeval => 60,
+		blocking => 0,
     };
 
 	$noconns++;
@@ -154,7 +155,11 @@ sub connect {
 	my $proto = getprotobyname('tcp');
 	$sock->socket(AF_INET, SOCK_STREAM, $proto) or return undef;
 	
-	blocking($sock, 0);
+	if ($conn->{blocking}) {
+		blocking($sock, 0);
+		$conn->{blocking} = 0;
+	}
+
 	my $ip = gethostbyname($to_host);
 #	my $r = $sock->connect($to_port, $ip);
 	my $r = connect($sock, pack_sockaddr_in($to_port, $ip));
@@ -235,7 +240,10 @@ sub _send {
     # return to the event loop only after every message, or if it
     # is likely to block in the middle of a message.
 
-	blocking($sock, $flush);
+	if ($conn->{blocking} != $flush) {
+		blocking($sock, $flush);
+		$conn->{blocking} = $flush;
+	}
     my $offset = (exists $conn->{send_offset}) ? $conn->{send_offset} : 0;
 
     while (@$rq) {
@@ -354,7 +362,10 @@ sub _rcv {                     # Complement to _send
     return unless defined($sock);
 
 	my @lines;
-	blocking($sock, 0);
+	if ($conn->{blocking}) {
+		blocking($sock, 0);
+		$conn->{blocking} = 0;
+	}
 	$bytes_read = sysread ($sock, $msg, 1024, 0);
 	if (defined ($bytes_read)) {
 		if ($bytes_read > 0) {
@@ -380,22 +391,26 @@ FINISH:
 sub new_client {
 	my $server_conn = shift;
     my $sock = $server_conn->{sock}->accept();
-    my $conn = $server_conn->new($server_conn->{rproc});
-	$conn->{sock} = $sock;
-    my ($rproc, $eproc) = &{$server_conn->{rproc}} ($conn, $conn->{peerhost} = $sock->peerhost(), $conn->{peerport} = $sock->peerport());
-	$conn->{sort} = 'Incoming';
-	if ($eproc) {
-		$conn->{eproc} = $eproc;
-        set_event_handler ($sock, error => $eproc);
+	if ($sock) {
+		my $conn = $server_conn->new($server_conn->{rproc});
+		$conn->{sock} = $sock;
+		my ($rproc, $eproc) = &{$server_conn->{rproc}} ($conn, $conn->{peerhost} = $sock->peerhost(), $conn->{peerport} = $sock->peerport());
+		$conn->{sort} = 'Incoming';
+		if ($eproc) {
+			$conn->{eproc} = $eproc;
+			set_event_handler ($sock, error => $eproc);
+		}
+		if ($rproc) {
+			$conn->{rproc} = $rproc;
+			my $callback = sub {$conn->_rcv};
+			set_event_handler ($sock, read => $callback);
+		} else {  # Login failed
+			&{$conn->{eproc}}($conn, undef) if exists $conn->{eproc};
+			$conn->disconnect();
+		}
+	} else {
+		dbg('err', "Msg: error on accept ($!)");
 	}
-    if ($rproc) {
-        $conn->{rproc} = $rproc;
-        my $callback = sub {$conn->_rcv};
-        set_event_handler ($sock, read => $callback);
-    } else {  # Login failed
-		&{$conn->{eproc}}($conn, undef) if exists $conn->{eproc};
-        $conn->disconnect();
-    }
 }
 
 sub close_server
@@ -413,6 +428,7 @@ sub close_all_clients
 	}
 }
 
+#
 #----------------------------------------------------
 # Event loop routines used by both client and server
 
@@ -480,6 +496,15 @@ sub event_loop {
     }
 }
 
+sub sleep
+{
+	my ($pkg, $interval) = @_;
+	my $now = time;
+	while (time - $now < $interval) {
+		$pkg->event_loop(10, 0.01);
+	}
+}
+
 sub DESTROY
 {
 	my $conn = shift;