added console.pl

diff --git a/Changes b/Changes
index 85b364f5e9464b245c604db0433b53f61735ad46..d82b0d0e2800e951d52bcb969ea3adaffd0ae00a 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,5 @@
+08Jun99=======================================================================
+1. Started work on the curses based operator console.
 03Jun99=======================================================================
 1. cluster seems to have a memory leak, put DESTROY functions in where 
 appropriate.

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index d9abfad6f3a4d6f17c1ae236a61ed9557aa2687b..d9e59c4937bc9211cc8425a804760879dfba6aa6 100644 (file)
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -389,7 +389,7 @@ sub normal
                                # now check the call over
                                my $node = DXCluster->get_exact($call);
                                if ($node) {
-                                       my $dxchan;
+                                       my $dxchan;
                                        if (($dxchan = DXChannel->get($call)) && $dxchan != $self) {
                                                dbg('chan', "LOOP: $call connected locally");
                                        }

diff --git a/perl/console.pl b/perl/console.pl
new file mode 100755 (executable)
index 0000000..1219215
--- /dev/null
+++ b/perl/console.pl
@@ -0,0 +1,171 @@
+#!/usr/bin/perl -w
+#
+# this is the operators console.
+#
+# Calling syntax is:-
+#
+# console.pl [callsign] 
+#
+# if the callsign isn't given then the sysop callsign in DXVars.pm is assumed
+#
+# Copyright (c) 1999 Dirk Koopman G1TLH
+#
+# $Id$
+# 
+
+require 5.004;
+
+# search local then perl directories
+BEGIN {
+       # root of directory tree for this system
+       $root = "/spider"; 
+       $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
+       
+       unshift @INC, "$root/perl";     # this IS the right way round!
+       unshift @INC, "$root/local";
+}
+
+use Msg;
+use DXVars;
+use DXDebug;
+use IO::File;
+use Curses;
+
+use Carp qw{cluck};
+
+# cease communications
+sub cease
+{
+       my $sendz = shift;
+       if ($conn && $sendz) {
+               $conn->send_now("Z$call|bye...\n");
+       }
+       endwin();
+       dbgclose();
+#      $SIG{__WARN__} = sub {my $a = shift; cluck($a); };
+       sleep(1);
+       exit(0);        
+}
+
+# terminate program from signal
+sub sig_term
+{
+       cease(1);
+}
+
+# handle incoming messages
+sub rec_socket
+{
+       my ($con, $msg, $err) = @_;
+       if (defined $err && $err) {
+               cease(1);
+       }
+       if (defined $msg) {
+               my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/;
+               
+               if ($sort eq 'D') {
+                       $top->addstr("$line\n");
+               } elsif ($sort eq 'Z') { # end, disconnect, go, away .....
+                       cease(0);
+               }         
+       }
+       $lasttime = time; 
+}
+
+sub rec_stdin
+{
+       my ($fh) = @_;
+
+       $r = $bot->getch();
+       
+       #  my $prbuf;
+       #  $prbuf = $buf;
+       #  $prbuf =~ s/\r/\\r/;
+       #  $prbuf =~ s/\n/\\n/;
+       #  print "sys: $r ($prbuf)\n";
+       if (defined $r) {
+               if ($r eq "\n" || $r eq "\r") {
+                       $inbuf = " " unless $inbuf;
+                       $conn->send_later("I|$call|$inbuf");
+                       $inbuf = "";
+               } else {
+                       $inbuf .= $r;
+               }
+       } 
+       $bot->refresh();
+}
+
+
+#
+# initialisation
+#
+
+$call = "";                     # the callsign being used
+$conn = 0;                      # the connection object for the cluster
+$lasttime = time;               # lasttime something happened on the interface
+
+$connsort = "local";
+
+#
+# deal with args
+#
+
+$call = uc shift @ARGV if @ARGV;
+$call = uc $myalias if !$call;
+
+if ($call eq $mycall) {
+       print "You cannot connect as your cluster callsign ($mycall)\n";
+       exit(0);
+}
+
+$conn = Msg->connect("$clusteraddr", $clusterport, \&rec_socket);
+if (! $conn) {
+       if (-r "$data/offline") {
+               open IN, "$data/offline" or die;
+               while (<IN>) {
+                       print $_;
+               }
+               close IN;
+       } else {
+               print "Sorry, the cluster $mycall is currently off-line\n";
+       }
+       exit(0);
+}
+
+
+$SIG{'INT'} = \&sig_term;
+$SIG{'TERM'} = \&sig_term;
+$SIG{'HUP'} = 'IGNORE';
+
+$scr = new Curses;
+cbreak();
+$top = $scr->subwin(LINES()-4, COLS, 0, 0);
+$top->intrflush(0);
+$top->scrollok(1);
+$scr->addstr(LINES()-4, 0, '-' x COLS);
+$bot = $scr->subwin(3, COLS, LINES()-3, 0);
+$bot->intrflush(0);
+$bot->scrollok(1);
+$bot->keypad(1);
+$scr->refresh();
+
+$pages = LINES()-6;
+
+$conn->send_now("A$call|$connsort");
+$conn->send_now("I|$call|set/page $pages");
+$conn->send_now("I|$call|set/nobeep");
+
+Msg->set_event_handler(\*STDIN, "read" => \&rec_stdin);
+
+for (;;) {
+       my $t;
+       Msg->event_loop(1, 0.010);
+       $top->refresh() if $top->is_wintouched;
+       $bot->refresh();
+       $t = time;
+       if ($t > $lasttime) {
+               $lasttime = $t;
+       }
+}
+
+exit(0);