X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fclient.pl;h=f44120f2ef09631ce82a0395d0970c45899c257f;hb=20b0104deaeab77fa7ab1444dbcedfcdbf5865f8;hp=b2dcfa3a7223d4cebba279b334de3e66a7525d64;hpb=f46017e7bef9ee062cd5a8648d214eabe585da25;p=spider.git diff --git a/perl/client.pl b/perl/client.pl index b2dcfa3a..f44120f2 100755 --- a/perl/client.pl +++ b/perl/client.pl @@ -12,19 +12,25 @@ # $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; use DXVars; -$mode = 1; # 1 - \n = \r as EOL, 2 - \n = \n, 0 - transparent +$mode = 2; # 1 - \n = \r as EOL, 2 - \n = \n, 0 - transparent $call = ""; # the callsign being used @stdoutq = (); # the queue of stuff to send out to the user $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 @@ -45,16 +51,11 @@ sub sig_term sub setmode { if ($mode == 1) { - $nl = "\r"; + $mynl = "\r"; } else { - $nl = "\n"; - } - $/ = $nl; - if ($mode == 0) { - $\ = undef; - } else { - $\ = $nl; + $mynl = "\n"; } + $/ = $mynl; } # handle incoming messages @@ -68,16 +69,40 @@ sub rec_socket my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/; if ($sort eq 'D') { - $nl = "" if $mode == 0; + my $snl = $mynl; + my $newsavenl = ""; + $snl = "" if $mode == 0; + if ($mode && $line =~ />$/) { + $newsavenl = $snl; + $snl = ' '; + } $line =~ s/\n/\r/og if $mode == 1; - print $line; + #my $p = qq($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 @@ -106,21 +131,24 @@ 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 $ARGV[0]; -die "client.pl []\r\n" if (!$call); -$mode = $ARGV[1] if (@ARGV > 1); +$call = uc shift @ARGV; +$call = uc $mycall if !$call; +$connsort = lc shift @ARGV; +$connsort = 'local' if !$connsort; +$mode = ($connsort =~ /^ax/o) ? 1 : 2; setmode(); - #select STDOUT; $| = 1; STDOUT->autoflush(1); @@ -129,7 +157,19 @@ $SIG{'TERM'} = \&sig_term; $SIG{'HUP'} = \&sig_term; $conn = Msg->connect("$clusteraddr", $clusterport, \&rec_socket); -$conn->send_now("A$call|start"); +$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; + } +}