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("\n$line");
  68                 } elsif ($sort eq 'Z') { # end, disconnect, go, away .....
  69                         cease(0);
  70                 }
  71         }
  72         $top->refresh();
  73         $lasttime = time;
  74 }
  75
  76 sub rec_stdin
  77 {
  78         my ($fh) = @_;
  79
  80         $r = $bot->getch();
  81
  82         #  my $prbuf;
  83         #  $prbuf = $buf;
  84         #  $prbuf =~ s/\r/\\r/;
  85         #  $prbuf =~ s/\n/\\n/;
  86         #  print "sys: $r ($prbuf)\n";
  87         if (defined $r) {
  88                 if ($r eq KEY_ENTER || $r eq "\n" || $r eq "\r") {
  89
  90                         # save the lines
  91                         if ($inbuf) {
  92                                 push @history, $inbuf if $inbuf;
  93                                 shift @history if @history > $maxhist;
  94                                 $histpos = @history;
  95                                 $bot->move(0,0);
  96                                 $bot->clrtoeol();
  97                                 $bot->addstr(substr($inbuf, 0, COLS));
  98                         }
  99
 100                         # send it to the cluster
 101                         $inbuf = " " unless $inbuf;
 102                         $conn->send_later("I$call|$inbuf");
 103                         $inbuf = "";
 104                         $pos = $lth = 0;
 105                 } elsif ($r eq KEY_UP || $r eq KEY_PPAGE || $r eq "\020") {
 106                         if ($histpos > 0) {
 107                                 --$histpos;
 108                                 $inbuf = $history[$histpos];
 109                                 $pos = $lth = length $inbuf;
 110                         } else {
 111                                 beep();
 112                         }
 113                 } elsif ($r eq KEY_DOWN || $r eq KEY_NPAGE || $r eq "\016") {
 114                         if ($histpos < @history - 1) {
 115                                 ++$histpos;
 116                                 $inbuf = $history[$histpos];
 117                                 $pos = $lth = length $inbuf;
 118                         } else {
 119                                 beep();
 120                         }
 121                 } elsif ($r eq KEY_LEFT || $r eq "\002") {
 122                         if ($pos > 0) {
 123                                 --$pos;
 124                         } else {
 125                                 beep();
 126                         }
 127                 } elsif ($r eq KEY_RIGHT || $r eq "\006") {
 128                         if ($pos < $lth) {
 129                                 ++$pos;
 130                         } else {
 131                                 beep();
 132                         }
 133                 } elsif ($r eq KEY_HOME || $r eq "\001") {
 134                         $pos = 0;
 135                 } elsif ($r eq KEY_BACKSPACE || $r eq "\010") {
 136                         if ($pos > 0) {
 137                                 my $a = substr($inbuf, 0, $pos-1);
 138                                 my $b = substr($inbuf, $pos) if $pos < $lth;
 139                                 $b = "" unless $b;
 140
 141                                 $inbuf = $a . $b;
 142                                 --$lth;
 143                                 --$pos;
 144                         } else {
 145                                 beep();
 146                         }
 147                 } elsif ($r eq KEY_DC || $r eq "\004") {
 148                         if ($pos < $lth) {
 149                                 my $a = substr($inbuf, 0, $pos);
 150                                 my $b = substr($inbuf, $pos+1) if $pos < $lth;
 151                                 $b = "" unless $b;
 152
 153                                 $inbuf = $a . $b;
 154                                 --$lth;
 155                         } else {
 156                                 beep();
 157                         }
 158                 } elsif ($r ge ' ' && $r le '~') {
 159                         if ($pos < $lth) {
 160                                 my $a = substr($inbuf, 0, $pos);
 161                                 my $b = substr($inbuf, $pos);
 162                                 $inbuf = $a . $r . $b;
 163                         } else {
 164                                 $inbuf .= $r;
 165                         }
 166                         $pos++;
 167                         $lth++;
 168                 } elsif ($r eq "\014" || $r eq "\022") {
 169                         $scr->touchwin();
 170                         $scr->refresh();
 171                 } elsif ($r eq "\013") {
 172                         $inbuf = "";
 173                         $pos = $lth = 0;
 174                 } else {
 175                         beep();
 176                 }
 177                 $bot->move(1, 0);
 178                 $bot->clrtobot();
 179                 $bot->addstr($inbuf);
 180         }
 181         $bot->move(1, $pos);
 182         $bot->refresh();
 183 }
 184
 185
 186 #
 187 # initialisation
 188 #
 189
 190 $call = "";                     # the callsign being used
 191 $conn = 0;                      # the connection object for the cluster
 192 $lasttime = time;               # lasttime something happened on the interface
 193
 194 $connsort = "local";
 195 @history = ();
 196 $histpos = 0;
 197 $maxhist = 100;
 198 $pos = $lth = 0;
 199 $inbuf = "";
 200
 201 #
 202 # deal with args
 203 #
 204
 205 $call = uc shift @ARGV if @ARGV;
 206 $call = uc $myalias if !$call;
 207
 208 if ($call eq $mycall) {
 209         print "You cannot connect as your cluster callsign ($mycall)\n";
 210         exit(0);
 211 }
 212
 213 $conn = Msg->connect("$clusteraddr", $clusterport, \&rec_socket);
 214 if (! $conn) {
 215         if (-r "$data/offline") {
 216                 open IN, "$data/offline" or die;
 217                 while (<IN>) {
 218                         print $_;
 219                 }
 220                 close IN;
 221         } else {
 222                 print "Sorry, the cluster $mycall is currently off-line\n";
 223         }
 224         exit(0);
 225 }
 226
 227
 228 $SIG{'INT'} = \&sig_term;
 229 $SIG{'TERM'} = \&sig_term;
 230 $SIG{'HUP'} = 'IGNORE';
 231
 232 $scr = new Curses;
 233 raw();
 234 noecho();
 235 $top = $scr->subwin(LINES()-4, COLS, 0, 0);
 236 $top->intrflush(0);
 237 $top->scrollok(1);
 238 $scr->addstr(LINES()-4, 0, '-' x COLS);
 239 $bot = $scr->subwin(3, COLS, LINES()-3, 0);
 240 $bot->intrflush(0);
 241 $bot->scrollok(1);
 242 $bot->keypad(1);
 243 $bot->move(1,0);
 244 $scr->refresh();
 245
 246 $SIG{__DIE__} = \&sig_term;
 247
 248 $pages = LINES()-6;
 249
 250 $conn->send_now("A$call|$connsort");
 251 $conn->send_now("I$call|set/page $pages");
 252 $conn->send_now("I$call|set/nobeep");
 253
 254 Msg->set_event_handler(\*STDIN, "read" => \&rec_stdin);
 255
 256 for (;;) {
 257         my $t;
 258         Msg->event_loop(1, 0.010);
 259         $top->refresh() if $top->is_wintouched;
 260         $bot->refresh();
 261         $t = time;
 262         if ($t > $lasttime) {
 263                 $lasttime = $t;
 264         }
 265 }
 266
 267 exit(0);