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