X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fclient.pl;h=845414339c7bf3e2cae040cc43c4993ee9ca5acb;hb=1cf4bd14be226274d5deb05da8480ab91a5dac52;hp=c3efad349185290ce4161c976d8bffef90ce27fc;hpb=6b6a8002929017b6d4217f68fa492a2d728ee1fe;p=spider.git

diff --git a/perl/client.pl b/perl/client.pl
index c3efad34..84541433 100755
--- a/perl/client.pl
+++ b/perl/client.pl
@@ -12,9 +12,10 @@
 # $Id$
 # 
 
+# search local then perl directories
 BEGIN {
+  unshift @INC, "/spider/perl";   # this IS the right way round!
   unshift @INC, "/spider/local";
-  unshift @INC, "/spider/perl";
 }
 
 use Msg;
@@ -26,6 +27,10 @@ $call = "";                     # the callsign being used
 $conn = 0;                      # the connection object for the cluster
 $lastbit = "";                  # the last bit of an incomplete input line
 $mynl = "\n";                   # standard terminator
+$lasttime = time;               # lasttime something happened on the interface
+$outqueue = "";                 # the output queue length
+$buffered = 1;                  # buffer output
+$savenl = "";                   # an NL that has been saved from last time
 
 # cease communications
 sub cease
@@ -65,18 +70,39 @@ sub rec_socket
 	
 	if ($sort eq 'D') {
 	   my $snl = $mynl;
+	   my $newsavenl = "";
 	   $snl = "" if $mode == 0;
-	   $snl = ' ' if ($mode && $line =~ />$/);
+	   if ($mode && $line =~ />$/) {
+	     $newsavenl = $snl;
+		 $snl = ' ';
+	   }
 	   $line =~ s/\n/\r/og if $mode == 1;
 	   #my $p = qq($line$snl);
-	   print $line, $snl;
+	   if ($buffered) {
+	     if (length $outqueue >= 128) {
+	       print $outqueue;
+		   $outqueue = "";
+	     }
+	     $outqueue .= "$savenl$line$snl";
+		 $lasttime = time;
+	   } else {
+	     print $savenl, $line, $snl;;
+	   }
+	   $savenl = $newsavenl;
 	} elsif ($sort eq 'M') {
 	  $mode = $line;               # set new mode from cluster
       setmode();
+	} elsif ($sort eq 'B') {
+	  if ($buffered && $outqueue) {
+	    print $outqueue;
+		$outqueue = "";
+	  }
+	  $buffered = $line;           # set buffered or unbuffered
     } elsif ($sort eq 'Z') {       # end, disconnect, go, away .....
 	  cease(0);
     }	  
-  } 
+  }
+  $lasttime = time; 
 }
 
 sub rec_stdin
@@ -105,21 +131,27 @@ sub rec_stdin
 	  foreach $first (@lines) {
 	    $conn->send_now("D$call|$first");
 	  }
-	  $lastbit = $buf;  
+	  $lastbit = $buf;
+	  $savenl = "";     # reset savenl 'cos we will have done a newline on input
 	} else {
 	  $conn->send_now("D$call|$buf");
 	}
   } elsif ($r == 0) {
     cease(1);
   }
+  $lasttime = time;
 }
 
 $call = uc shift @ARGV;
-$call = uc $mycall if !$call; 
+$call = uc $myalias if !$call; 
 $connsort = lc shift @ARGV;
 $connsort = 'local' if !$connsort;
-$mode = ($connsort =~ /^ax/) ? 1 : 2;
+$mode = ($connsort =~ /^ax/o) ? 1 : 2;
 setmode();
+if ($call eq $mycall) {
+  print "You cannot connect as your cluster callsign ($mycall)", $nl;
+  cease(0);
+}
 
 #select STDOUT; $| = 1;
 STDOUT->autoflush(1);
@@ -131,5 +163,17 @@ $SIG{'HUP'} = \&sig_term;
 $conn = Msg->connect("$clusteraddr", $clusterport, \&rec_socket);
 $conn->send_now("A$call|$connsort");
 Msg->set_event_handler(\*STDIN, "read" => \&rec_stdin);
-Msg->event_loop();
+
+for (;;) {
+  my $t;
+  Msg->event_loop(1, 0.010);
+  $t = time;
+  if ($t > $lasttime) {
+    if ($outqueue) {
+	  print $outqueue;
+	  $outqueue = "";
+	}
+	$lasttime = $t;
+  }
+}