X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FMsg.pm;h=615feb1987e4a102def727f208d093107f63d85b;hb=407d9a80a8af1fa6c1ae2c8fbca833e49da6e816;hp=ae9c4c28699709a3f34a771d0062568f74323071;hpb=deb8356e97b2aacab345b791ab39784da8d3fe37;p=spider.git

diff --git a/perl/Msg.pm b/perl/Msg.pm
index ae9c4c28..615feb19 100644
--- a/perl/Msg.pm
+++ b/perl/Msg.pm
@@ -11,6 +11,13 @@
 package Msg;
 
 use strict;
+
+use vars qw($VERSION $BRANCH);
+$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
+$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0;
+$main::build += $VERSION;
+$main::branch += $BRANCH;
+
 use IO::Select;
 use IO::Socket;
 use DXDebug;
@@ -80,7 +87,7 @@ sub new
 
 	$noconns++;
 	
-	dbg('connll', "Connection created ($noconns)");
+	dbg("Connection created ($noconns)") if isdbg('connll');
 	return bless $conn, $class;
 }
 
@@ -122,11 +129,11 @@ sub conns
 	if (ref $pkg) {
 		$call = $pkg->{call} unless $call;
 		return undef unless $call;
-		dbg('connll', "changing $pkg->{call} to $call") if exists $pkg->{call} && $call ne $pkg->{call};
+		dbg("changing $pkg->{call} to $call") if isdbg('connll') && 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");
+		dbg("Connection $pkg->{cnum} $call stored") if isdbg('connll');
 	} else {
 		$ref = $conns{$call};
 	}
@@ -199,7 +206,7 @@ sub disconnect {
 		delete $conns{$call} if $ref && $ref == $conn;
 	}
 	$call ||= 'unallocated';
-	dbg('connll', "Connection $conn->{cnum} $call disconnected");
+	dbg("Connection $conn->{cnum} $call disconnected") if isdbg('connll');
 	
 	unless ($main::is_win) {
 		kill 'TERM', $conn->{pid} if exists $conn->{pid};
@@ -379,11 +386,29 @@ sub _rcv {                     # Complement to _send
 	$bytes_read = sysread ($sock, $msg, 1024, 0);
 	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);
 			}
+			if ($conn->{echo}) {
+				my @ch = split //, $msg;
+				my $out;
+				for (@ch) {
+					if (/[\cH\x7f]/) {
+						$out .= "\cH \cH";
+						$conn->{msg} =~ s/.$//;
+					} else {
+						$out .= $_;
+						$conn->{msg} .= $_;
+					}
+				}
+				if (defined $out) {
+					set_event_handler ($sock, write => sub{$conn->_send(0)});
+					push @{$conn->{outqueue}}, $out;
+				}
+			} else {
+				$conn->{msg} .= $msg;
+			}
 		} 
 	} else {
 		if (_err_will_block($!)) {
@@ -398,7 +423,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};
+		}
 	}
 }
 
@@ -425,7 +452,7 @@ sub new_client {
 			$conn->disconnect();
 		}
 	} else {
-		dbg('err', "Msg: error on accept ($!)");
+		dbg("Msg: error on accept ($!)") if isdbg('err');
 	}
 }
 
@@ -444,6 +471,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
@@ -527,7 +561,7 @@ sub DESTROY
 	my $call = $conn->{call} || 'unallocated';
 	my $host = $conn->{peerhost} || '';
 	my $port = $conn->{peerport} || '';
-	dbg('connll', "Connection $conn->{cnum} $call [$host $port] being destroyed");
+	dbg("Connection $conn->{cnum} $call [$host $port] being destroyed") if isdbg('connll');
 	$noconns--;
 }