perl/console.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # this is the operators console.
   4 #
   5 # Calling syntax is:-
   6 #
   7 # console.pl [callsign]
   8 #
   9 # if the callsign isn't given then the sysop callsign in DXVars.pm is assumed
  10 #
  11 # Copyright (c) 1999 Dirk Koopman G1TLH
  12 #
  13 # $Id$
  14 #
  15
  16 require 5.004;
  17
  18 # search local then perl directories
  19 BEGIN {
  20         # root of directory tree for this system
  21         $root = "/spider";
  22         $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
  23
  24         unshift @INC, "$root/perl";     # this IS the right way round!
  25         unshift @INC, "$root/local";
  26 }
  27
  28 use Msg;
  29 use DXVars;
  30 use DXDebug;
  31 use IO::File;
  32 use Curses;
  33
  34 use Carp qw{cluck};
  35
  36 # cease communications
  37 sub cease
  38 {
  39         my $sendz = shift;
  40         if ($conn && $sendz) {
  41                 $conn->send_now("Z$call|bye...\n");
  42         }
  43         endwin();
  44         dbgclose();
  45 #       $SIG{__WARN__} = sub {my $a = shift; cluck($a); };
  46         sleep(1);
  47         exit(0);
  48 }
  49
  50 # terminate program from signal
  51 sub sig_term
  52 {
  53         cease(1);
  54 }
  55
  56 # handle incoming messages
  57 sub rec_socket
  58 {
  59         my ($con, $msg, $err) = @_;
  60         if (defined $err && $err) {
  61                 cease(1);
  62         }
  63         if (defined $msg) {
  64                 my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/;
  65
  66                 if ($sort eq 'D') {
  67                         $top->addstr("$line\n");
  68                 } elsif ($sort eq 'Z') { # end, disconnect, go, away .....
  69                         cease(0);
  70                 }
  71         }
  72         $lasttime = time;
  73 }
  74
  75 sub rec_stdin
  76 {
  77         my ($fh) = @_;
  78
  79         $r = $bot->getch();
  80
  81         #  my $prbuf;
  82         #  $prbuf = $buf;
  83         #  $prbuf =~ s/\r/\\r/;
  84         #  $prbuf =~ s/\n/\\n/;
  85         #  print "sys: $r ($prbuf)\n";
  86         if (defined $r) {
  87                 if ($r eq "\n" || $r eq "\r") {
  88                         $inbuf = " " unless $inbuf;
  89                         $conn->send_later("I|$call|$inbuf");
  90                         $inbuf = "";
  91                 } else {
  92                         $inbuf .= $r;
  93                 }
  94         }
  95         $bot->refresh();
  96 }
  97
  98
  99 #
 100 # initialisation
 101 #
 102
 103 $call = "";                     # the callsign being used
 104 $conn = 0;                      # the connection object for the cluster
 105 $lasttime = time;               # lasttime something happened on the interface
 106
 107 $connsort = "local";
 108
 109 #
 110 # deal with args
 111 #
 112
 113 $call = uc shift @ARGV if @ARGV;
 114 $call = uc $myalias if !$call;
 115
 116 if ($call eq $mycall) {
 117         print "You cannot connect as your cluster callsign ($mycall)\n";
 118         exit(0);
 119 }
 120
 121 $conn = Msg->connect("$clusteraddr", $clusterport, \&rec_socket);
 122 if (! $conn) {
 123         if (-r "$data/offline") {
 124                 open IN, "$data/offline" or die;
 125                 while (<IN>) {
 126                         print $_;
 127                 }
 128                 close IN;
 129         } else {
 130                 print "Sorry, the cluster $mycall is currently off-line\n";
 131         }
 132         exit(0);
 133 }
 134
 135
 136 $SIG{'INT'} = \&sig_term;
 137 $SIG{'TERM'} = \&sig_term;
 138 $SIG{'HUP'} = 'IGNORE';
 139
 140 $scr = new Curses;
 141 cbreak();
 142 $top = $scr->subwin(LINES()-4, COLS, 0, 0);
 143 $top->intrflush(0);
 144 $top->scrollok(1);
 145 $scr->addstr(LINES()-4, 0, '-' x COLS);
 146 $bot = $scr->subwin(3, COLS, LINES()-3, 0);
 147 $bot->intrflush(0);
 148 $bot->scrollok(1);
 149 $bot->keypad(1);
 150 $scr->refresh();
 151
 152 $pages = LINES()-6;
 153
 154 $conn->send_now("A$call|$connsort");
 155 $conn->send_now("I|$call|set/page $pages");
 156 $conn->send_now("I|$call|set/nobeep");
 157
 158 Msg->set_event_handler(\*STDIN, "read" => \&rec_stdin);
 159
 160 for (;;) {
 161         my $t;
 162         Msg->event_loop(1, 0.010);
 163         $top->refresh() if $top->is_wintouched;
 164         $bot->refresh();
 165         $t = time;
 166         if ($t > $lasttime) {
 167                 $lasttime = $t;
 168         }
 169 }
 170
 171 exit(0);