X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fclient.pl;h=f44120f2ef09631ce82a0395d0970c45899c257f;hb=20b0104deaeab77fa7ab1444dbcedfcdbf5865f8;hp=0cdbe9c2b3f1e57f26706389a47586de570b976b;hpb=0017002e2dc438d49fcc090dc99b6d22f7037aa7;p=spider.git diff --git a/perl/client.pl b/perl/client.pl index 0cdbe9c2..f44120f2 100755 --- a/perl/client.pl +++ b/perl/client.pl @@ -12,14 +12,25 @@ # $Id$ # +# search local then perl directories +BEGIN { + unshift @INC, "/spider/perl"; # this IS the right way round! + unshift @INC, "/spider/local"; +} + 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 @@ -37,6 +48,16 @@ sub sig_term cease(1); } +sub setmode +{ + if ($mode == 1) { + $mynl = "\r"; + } else { + $mynl = "\n"; + } + $/ = $mynl; +} + # handle incoming messages sub rec_socket { @@ -45,19 +66,43 @@ sub rec_socket cease(1); } if (defined $msg) { - my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)|(.*)$/; + my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/; if ($sort eq 'D') { - my $nl = ($mode == 1) ? "\r" : "\n"; - $nl = "" if $mode == 0; - $line =~ s/\n/\r/o if $mode == 1; - print $line, $nl; + my $snl = $mynl; + my $newsavenl = ""; + $snl = "" if $mode == 0; + if ($mode && $line =~ />$/) { + $newsavenl = $snl; + $snl = ' '; + } + $line =~ s/\n/\r/og if $mode == 1; + #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 - } elsif ($sort eq 'Z') { # end, disconnect, go, away ..... + 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 @@ -73,7 +118,7 @@ sub rec_stdin # print "sys: $r $buf"; if ($r > 0) { if ($mode) { - $buf =~ s/\r/\n/o if $mode == 1; + $buf =~ s/\r/\n/og if $mode == 1; $dangle = !($buf =~ /\n$/); @lines = split /\n/, $buf; if ($dangle) { # pull off any dangly bits @@ -86,27 +131,45 @@ 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; +#select STDOUT; $| = 1; +STDOUT->autoflush(1); $SIG{'INT'} = \&sig_term; $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; + } +}