X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FMsg.pm;h=e167269363d6f674ac24a016ce2fbabea51a7c0b;hb=076b94b8ba5b24af929056d5e4c5217427f93b9e;hp=403303dd05df5bafa77a2b8bb1e37c4d09e0587f;hpb=bc7d751b4d6e3e4c1b387c6695eed11dd0178fc6;p=spider.git

diff --git a/perl/Msg.pm b/perl/Msg.pm
index 403303dd..e1672693 100644
--- a/perl/Msg.pm
+++ b/perl/Msg.pm
@@ -15,8 +15,6 @@ use IO::Select;
 use IO::Socket;
 use DXDebug;
 use Timer;
-use Errno qw(EWOULDBLOCK EAGAIN EINPROGRESS);
-use POSIX qw(F_GETFL F_SETFL O_NONBLOCK);
 
 use vars qw(%rd_callbacks %wt_callbacks %er_callbacks $rd_handles $wt_handles $er_handles $now %conns $noconns);
 
@@ -33,9 +31,14 @@ my $blocking_supported = 0;
 BEGIN {
     # Checks if blocking is supported
     eval {
-        require POSIX; POSIX->import(qw (F_SETFL O_NONBLOCK));
+        require POSIX; POSIX->import(qw (F_SETFL F_GETFL O_NONBLOCK));
     };
     $blocking_supported = 1 unless $@;
+
+	# import as many of these errno values as are available
+	eval {
+		require Errno; Errno->import(qw(EAGAIN EINPROGRESS EWOULDBLOCK));
+	};
 }
 
 my $w = $^W;
@@ -63,6 +66,7 @@ sub new
 		lineend => "\r\n",
 		csort => 'telnet',
 		timeval => 60,
+		blocking => 0,
     };
 
 	$noconns++;
@@ -151,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));
@@ -232,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) {
@@ -280,6 +291,22 @@ sub _send {
     1;  # Success
 }
 
+sub dup_sock
+{
+	my $conn = shift;
+	my $oldsock = $conn->{sock};
+	my $rc = $rd_callbacks{$oldsock};
+	my $wc = $wt_callbacks{$oldsock};
+	my $ec = $er_callbacks{$oldsock};
+	my $sock = $oldsock->new_from_fd($oldsock, "w+");
+	if ($sock) {
+		set_event_handler($oldsock, read=>undef, write=>undef, error=>undef);
+		$conn->{sock} = $sock;
+		set_event_handler($sock, read=>$rc, write=>$wc, error=>$ec);
+		$oldsock->close;
+	}
+}
+
 sub _err_will_block {
 	return 0 unless $blocking_supported;
 	return ($_[0] == $eagain || $_[0] == $ewouldblock || $_[0] == $einprogress);
@@ -335,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) {
@@ -394,6 +424,7 @@ sub close_all_clients
 	}
 }
 
+#
 #----------------------------------------------------
 # Event loop routines used by both client and server
 
@@ -461,6 +492,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;