]> gb7djk.dxcluster.net Git - spider.git/blob - perl/console.pl
start PC90 development
[spider.git] / 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 IntMsg;
30 use DXVars;
31 use DXDebug;
32 use DXUtil;
33 use DXDebug;
34 use IO::File;
35 use Time::HiRes qw(gettimeofday tv_interval);
36 use Curses 1.06;
37
38 use Console;
39
40 #
41 # initialisation
42 #
43
44 $call = "";                     # the callsign being used
45 $conn = 0;                      # the connection object for the cluster
46 $lasttime = time;               # lasttime something happened on the interface
47
48 $connsort = "local";
49 @khistory = ();
50 @shistory = ();
51 $khistpos = 0;
52 $spos = $pos = $lth = 0;
53 $inbuf = "";
54 @time = ();
55
56 $SIG{WINCH} = sub {@time = gettimeofday};
57
58 sub mydbg
59 {
60         local *STDOUT = undef;
61         dbg(@_);
62 }
63
64 # do the screen initialisation
65 sub do_initscr
66 {
67         $scr = new Curses;
68         if ($has_colors) {
69                 start_color();
70                 init_pair("0", $foreground, $background);
71 #               init_pair(0, $background, $foreground);
72                 init_pair(1, COLOR_RED, $background);
73                 init_pair(2, COLOR_YELLOW, $background);
74                 init_pair(3, COLOR_GREEN, $background);
75                 init_pair(4, COLOR_CYAN, $background);
76                 init_pair(5, COLOR_BLUE, $background);
77                 init_pair(6, COLOR_MAGENTA, $background);
78                 init_pair(7, COLOR_RED, COLOR_BLUE);
79                 init_pair(8, COLOR_YELLOW, COLOR_BLUE);
80                 init_pair(9, COLOR_GREEN, COLOR_BLUE);
81                 init_pair(10, COLOR_CYAN, COLOR_BLUE);
82                 init_pair(11, COLOR_BLUE, COLOR_RED);
83                 init_pair(12, COLOR_MAGENTA, COLOR_BLUE);
84                 init_pair(13, COLOR_YELLOW, COLOR_GREEN);
85                 init_pair(14, COLOR_RED, COLOR_GREEN);
86                 eval { assume_default_colors($foreground, $background) };
87         }
88         
89         $top = $scr->subwin($lines-4, $cols, 0, 0);
90         $top->intrflush(0);
91         $top->scrollok(1);
92         $top->idlok(1);
93         $top->meta(1);
94 #       $scr->addstr($lines-4, 0, '-' x $cols);
95         $bot = $scr->subwin(3, $cols, $lines-3, 0);
96         $bot->intrflush(0);
97         $bot->scrollok(1);
98         $top->idlok(1);
99         $bot->keypad(1);
100         $bot->move(1,0);
101         $bot->meta(1);
102         $bot->nodelay(1);
103         $scr->refresh();
104         
105         $pagel = $lines-4;
106         $mycallcolor = COLOR_PAIR(1) unless $mycallcolor;
107 }
108
109 sub do_resize
110 {
111         endwin() if $scr;
112         initscr();
113         raw();
114         noecho();
115         nonl();
116         $lines = LINES;
117         $cols = COLS;
118         $has_colors = has_colors();
119         do_initscr();
120
121         show_screen();
122 }
123
124 # cease communications
125 sub cease
126 {
127         my $sendz = shift;
128         $conn->disconnect if $conn;
129         endwin();
130         dbgclose();
131         print @_ if @_;
132         exit(0);        
133 }
134
135 # terminate program from signal
136 sub sig_term
137 {
138         cease(1, @_);
139 }
140
141 # determine the colour of the line
142 sub setattr
143 {
144         if ($has_colors) {
145                 foreach my $ref (@colors) {
146                         if ($_[0] =~ m{$$ref[0]}) {
147                                 $top->attrset($$ref[1]);
148                                 last;
149                         }
150                 }
151         }
152 }
153
154 # measure the no of screen lines a line will take
155 sub measure
156 {
157         my $line = shift;
158         return 0 unless $line;
159
160         my $l = length $line;
161         my $lines = int ($l / $cols);
162         $lines++ if $l / $cols > $lines;
163         return $lines;
164 }
165
166 # display the top screen
167 sub show_screen
168 {
169         if ($spos == @shistory - 1) {
170
171                 # if we really are scrolling thru at the end of the history
172                 my $line = $shistory[$spos];
173                 $top->addstr("\n") if $spos > 0;
174                 setattr($line);
175                 $top->addstr($line);
176 #               $top->addstr("\n");
177                 $top->attrset(COLOR_PAIR(0)) if $has_colors;
178                 $spos = @shistory;
179                 
180         } else {
181                 
182                 # anywhere else
183                 my ($i, $l);
184                 my $p = $spos-1;
185                 for ($i = 0; $i < $pagel && $p >= 0; ) {
186                         $l = measure($shistory[$p]);
187                         $i += $l;
188                         $p-- if $i < $pagel;
189                 }
190                 $p = 0 if $p < 0;
191                 
192                 $top->move(0, 0);
193                 $top->attrset(COLOR_PAIR(0)) if $has_colors;
194                 $top->clrtobot();
195                 for ($i = 0; $i < $pagel && $p < @shistory; $p++) {
196                         my $line = $shistory[$p];
197                         my $lines = measure($line);
198                         last if $i + $lines > $pagel;
199                         $top->addstr("\n") if $i;
200                         setattr($line);
201                         $top->addstr($line);
202                         $top->attrset(COLOR_PAIR(0)) if $has_colors;
203                         $i += $lines;
204                 }
205                 $spos = $p;
206                 $spos = @shistory if $spos > @shistory;
207         }
208     my $shl = @shistory;
209         my $size = $lines . 'x' . $cols . '-'; 
210         my $add = "-$spos-$shl";
211     my $time = ztime(time);
212         my $str =  "-" . $time . '-' x ($cols - (length($size) + length($call) + length($add) + length($time) + 1));
213         $scr->addstr($lines-4, 0, $str);
214         
215         $scr->addstr($size);
216         $scr->attrset($mycallcolor) if $has_colors;
217         $scr->addstr($call);
218         $scr->attrset(COLOR_PAIR(0)) if $has_colors;
219     $scr->addstr($add);
220         $scr->refresh();
221 #       $top->refresh();
222 }
223
224 # add a line to the end of the top screen
225 sub addtotop
226 {
227         while (@_) {
228                 my $inbuf = shift;
229                 if ($inbuf =~ s/\x07+$//) {
230                         beep();
231                 }
232                 push @shistory, $inbuf;
233                 shift @shistory if @shistory > $maxshist;
234         }
235         show_screen();
236 }
237
238 # handle incoming messages
239 sub rec_socket
240 {
241         my ($con, $msg, $err) = @_;
242         if (defined $err && $err) {
243                 cease(1);
244         }
245         if (defined $msg) {
246                 my ($sort, $call, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/;
247                 
248                 $line =~ s/[\x00-\x06\x08\x0a-\x19\x1b-\x1f\x80-\x9f]/./g;         # immutable CSI sequence + control characters
249                 if ($sort && $sort eq 'D') {
250                         $line = " " unless length($line);
251                         addtotop($line);
252                 } elsif ($sort && $sort eq 'Z') { # end, disconnect, go, away .....
253                         cease(0);
254                 }         
255                 # ******************************************************
256                 # ******************************************************
257                 # any other sorts that might happen are silently ignored.
258                 # ******************************************************
259                 # ******************************************************
260         } else {
261                 cease(0);
262         }
263         $top->refresh();
264         $lasttime = time; 
265 }
266
267 sub rec_stdin
268 {
269         my $r = shift;;
270         
271         #  my $prbuf;
272         #  $prbuf = $buf;
273         #  $prbuf =~ s/\r/\\r/;
274         #  $prbuf =~ s/\n/\\n/;
275         #  print "sys: $r ($prbuf)\n";
276         if (defined $r) {
277
278                 $r = '0' if !$r;
279                 
280                 if ($r eq KEY_ENTER || $r eq "\n" || $r eq "\r") {
281                         
282                         # save the lines
283                         $inbuf = " " unless length $inbuf;
284
285                         # check for a pling and do a search back for a command
286                         if ($inbuf =~ /^!/o) {
287                                 my $i;
288                                 $inbuf =~ s/^!//o;
289                                 for ($i = $#khistory; $i >= 0; $i--) {
290                                         if ($khistory[$i] =~ /^$inbuf/) {
291                                                 $inbuf = $khistory[$i];
292                                                 last;
293                                         }
294                                 }
295                                 if ($i < 0) {
296                                         beep();
297                                         return;
298                                 }
299                         }
300                         push @khistory, $inbuf if length $inbuf;
301                         shift @khistory if @khistory > $maxkhist;
302                         $khistpos = @khistory;
303                         $bot->move(0,0);
304                         $bot->clrtoeol();
305                         $bot->addstr(substr($inbuf, 0, $cols));
306
307                         # add it to the monitor window
308                         unless ($spos == @shistory) {
309                                 $spos = @shistory;
310                                 show_screen();
311                         };
312                         addtotop($inbuf);
313                 
314                         # send it to the cluster
315                         $conn->send_later("I$call|$inbuf");
316                         $inbuf = "";
317                         $pos = $lth = 0;
318                 } elsif ($r eq KEY_UP || $r eq "\020") {
319                         if ($khistpos > 0) {
320                                 --$khistpos;
321                                 $inbuf = $khistory[$khistpos];
322                                 $pos = $lth = length $inbuf;
323                         } else {
324                                 beep();
325                         }
326                 } elsif ($r eq KEY_DOWN || $r eq "\016") {
327                         if ($khistpos < @khistory - 1) {
328                                 ++$khistpos;
329                                 $inbuf = $khistory[$khistpos];
330                                 $pos = $lth = length $inbuf;
331                         } else {
332                                 beep();
333                         }
334                 } elsif ($r eq KEY_PPAGE || $r eq "\032") {
335                         if ($spos > 0) {
336                                 my ($i, $l);
337                                 for ($i = 0; $i <= $pagel && $spos >= 0; ) {
338                                         $l = measure($shistory[$spos]);
339                                         $i += $l;
340                                         $spos-- if $i <= $pagel;
341                                 }
342                                 $spos = 0 if $spos < 0;
343                                 show_screen();
344                         } else {
345                                 beep();
346                         }
347                 } elsif ($r eq KEY_NPAGE || $r eq "\026") {
348                         if ($spos < @shistory - 1) {
349                                 my ($i, $l);
350                                 for ($i = 0; $i <= $pagel && $spos <= @shistory; ) {
351                                         $l = measure($shistory[$spos]);
352                                         $i += $l;
353                                         $spos++ if $i <= $pagel;
354                                 }
355                                 $spos = @shistory if $spos >= @shistory - 1;
356                                 show_screen();
357                         } else {
358                                 beep();
359                         }
360                 } elsif ($r eq KEY_LEFT || $r eq "\002") {
361                         if ($pos > 0) {
362                                 --$pos;
363                         } else {
364                                 beep();
365                         }
366                 } elsif ($r eq KEY_RIGHT || $r eq "\006") {
367                         if ($pos < $lth) {
368                                 ++$pos;
369                         } else {
370                                 beep();
371                         }
372                 } elsif ($r eq KEY_HOME || $r eq "\001") {
373                         $pos = 0;
374                 } elsif ($r eq KEY_END || $r eq "\005") {
375                         $pos = $lth;
376                 } elsif ($r eq KEY_BACKSPACE || $r eq "\010" || $r eq "\x7f") {
377                         if ($pos > 0) {
378                                 my $a = substr($inbuf, 0, $pos-1);
379                                 my $b = substr($inbuf, $pos) if $pos < $lth;
380                                 $b = "" unless $b;
381                                 
382                                 $inbuf = $a . $b;
383                                 --$lth;
384                                 --$pos;
385                         } else {
386                                 beep();
387                         }
388                 } elsif ($r eq KEY_DC || $r eq "\004") {
389                         if ($pos < $lth) {
390                                 my $a = substr($inbuf, 0, $pos);
391                                 my $b = substr($inbuf, $pos+1) if $pos < $lth;
392                                 $b = "" unless $b;
393                                 
394                                 $inbuf = $a . $b;
395                                 --$lth;
396                         } else {
397                                 beep();
398                         }
399                 } elsif ($r eq KEY_RESIZE || $r eq "\0632") {
400                         do_resize();
401                         return;
402                 } elsif (defined $r && is_pctext($r)) {
403                         # move the top screen back to the bottom if you type something
404                         if ($spos < @shistory) {
405                                 $spos = @shistory;
406                                 show_screen();
407                         }
408
409                 #       $r = ($r lt ' ' || $r gt "\x7e") ? sprintf("'%x", ord $r) : $r;
410                         
411                         # insert the character into the keyboard buffer
412                         if ($pos < $lth) {
413                                 my $a = substr($inbuf, 0, $pos);
414                                 my $b = substr($inbuf, $pos);
415                                 $inbuf = $a . $r . $b;
416                         } else {
417                                 $inbuf .= $r;
418                         }
419                         $pos++;
420                         $lth++;
421                 } elsif ($r eq "\014" || $r eq "\022") {
422                         touchwin(curscr, 1);
423                         refresh(curscr);
424                         return;
425                 } elsif ($r eq "\013") {
426                         $inbuf = substr($inbuf, 0, $pos);
427                         $lth = length $inbuf;
428                 } else {
429                         beep();
430                 }
431                 $bot->move(1, 0);
432                 $bot->clrtobot();
433                 $bot->addstr($inbuf);
434         } 
435         $bot->move(1, $pos);
436         $bot->refresh();
437 }
438
439
440 #
441 # deal with args
442 #
443
444 $call = uc shift @ARGV if @ARGV;
445 $call = uc $myalias if !$call;
446 my ($scall, $ssid) = split /-/, $call;
447 $ssid = undef unless $ssid && $ssid =~ /^\d+$/;  
448 if ($ssid) {
449         $ssid = 15 if $ssid > 15;
450         $call = "$scall-$ssid";
451 }
452
453 if ($call eq $mycall) {
454         print "You cannot connect as your cluster callsign ($mycall)\n";
455         exit(0);
456 }
457
458 dbginit();
459
460 $conn = IntMsg->connect("$clusteraddr", $clusterport, \&rec_socket);
461 if (! $conn) {
462         if (-r "$data/offline") {
463                 open IN, "$data/offline" or die;
464                 while (<IN>) {
465                         print $_;
466                 }
467                 close IN;
468         } else {
469                 print "Sorry, the cluster $mycall is currently off-line\n";
470         }
471         exit(0);
472 }
473
474 $conn->set_error(sub{cease(0)});
475
476
477 unless ($DB::VERSION) {
478         $SIG{'INT'} = \&sig_term;
479         $SIG{'TERM'} = \&sig_term;
480 }
481
482 $SIG{'HUP'} = \&sig_term;
483
484 # start up
485 do_resize();
486
487 $SIG{__DIE__} = \&sig_term;
488
489 $conn->send_later("A$call|$connsort width=$cols");
490 $conn->send_later("I$call|set/page $maxshist");
491 #$conn->send_later("I$call|set/nobeep");
492
493 #Msg->set_event_handler(\*STDIN, "read" => \&rec_stdin);
494
495 my $lastmin = 0;
496 for (;;) {
497         my $t;
498         Msg->event_loop(1, 0.01);
499         $t = time;
500         if ($t > $lasttime) {
501                 my ($min)= (gmtime($t))[1];
502                 if ($min != $lastmin) {
503                         show_screen();
504                         $lastmin = $min;
505                 }
506                 $lasttime = $t;
507         }
508         my $ch = $bot->getch();
509         if (@time && tv_interval(\@time, [gettimeofday]) >= 1) {
510 #               mydbg("Got Resize");
511 #               do_resize();
512                 next;
513         }
514         if (defined $ch) {
515                 if ($ch ne '-1') {
516                         rec_stdin($ch);
517                 }
518         }
519         $top->refresh() if $top->is_wintouched;
520         $bot->refresh();
521 }
522
523 exit(0);