]> dxcluster.net Git - spider.git/blob - perl/console.pl
0cb15bd0fbc0171446f40fde6151ee100621f8d7
[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 DXVars;
30 use DXDebug;
31 use IO::File;
32 use Curses;
33
34 use Carp qw{cluck};
35
36 use Console;
37
38 #
39 # initialisation
40 #
41
42 $call = "";                     # the callsign being used
43 $conn = 0;                      # the connection object for the cluster
44 $lasttime = time;               # lasttime something happened on the interface
45
46 $connsort = "local";
47 @khistory = ();
48 @shistory = ();
49 $khistpos = 0;
50 $spos = $pos = $lth = 0;
51 $inbuf = "";
52
53 # cease communications
54 sub cease
55 {
56         my $sendz = shift;
57         if ($conn && $sendz) {
58                 $conn->send_now("Z$call|bye...\n");
59         }
60         endwin();
61         dbgclose();
62         print @_ if @_;
63         exit(0);        
64 }
65
66 # terminate program from signal
67 sub sig_term
68 {
69         cease(1, @_);
70 }
71
72 # determine the colour of the line
73 sub setattr
74 {
75         if ($has_colors) {
76                 foreach my $ref (@colors) {
77                         if ($_[0] =~ m{$$ref[0]}) {
78                                 $top->attrset($$ref[1]);
79                                 last;
80                         }
81                 }
82         }
83 }
84
85 # display the top screen
86 sub show_screen
87 {
88         if ($spos == @shistory - 1) {
89
90                 # if we really are scrolling thru at the end of the history
91                 my $line = $shistory[-1];
92                 $top->addstr("\n") if $spos > 0;
93                 setattr($line);
94                 $top->addstr($line);
95                 $top->attrset(COLOR_PAIR(0)) if $has_colors;
96                 $spos = @shistory;
97                 
98         } else {
99                 
100                 # anywhere else
101                 my $p = $spos - $pages;
102                 my $i;
103                 $p = 0 if $p < 0;
104                 
105                 $top->move(0, 0);
106                 $top->attrset(COLOR_PAIR(0)) if $has_colors;
107                 $top->clrtobot();
108                 for ($i = 0; $i < $pages && $p < @shistory; $i++, $p++) {
109                         my $line = $shistory[$p];
110                         $line = substr($line, 0, COLS()) if length $line > COLS();
111                         $top->move($i, 0);
112                         setattr($line);
113                         $top->addstr($line);
114                         $top->attrset(COLOR_PAIR(0)) if $has_colors;
115                 }
116                 $spos = $p;
117         }
118         $top->refresh();
119 }
120
121 # add a line to the end of the top screen
122 sub addtotop
123 {
124         my $inbuf = shift;
125         push @shistory, $inbuf;
126         shift @shistory if @shistory > $maxshist;
127         show_screen();
128 }
129
130 # handle incoming messages
131 sub rec_socket
132 {
133         my ($con, $msg, $err) = @_;
134         if (defined $err && $err) {
135                 cease(1);
136         }
137         if (defined $msg) {
138                 my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/;
139                 
140                 if ($sort eq 'D') {
141                         addtotop($line);
142                 } elsif ($sort eq 'Z') { # end, disconnect, go, away .....
143                         cease(0);
144                 }         
145         }
146         $top->refresh();
147         $lasttime = time; 
148 }
149
150 sub rec_stdin
151 {
152         my ($fh) = @_;
153
154         $r = $bot->getch();
155         
156         #  my $prbuf;
157         #  $prbuf = $buf;
158         #  $prbuf =~ s/\r/\\r/;
159         #  $prbuf =~ s/\n/\\n/;
160         #  print "sys: $r ($prbuf)\n";
161         if (defined $r) {
162                 if ($r eq KEY_ENTER || $r eq "\n" || $r eq "\r") {
163                         
164                         # save the lines
165                         if ($inbuf) {
166                                 push @khistory, $inbuf if $inbuf;
167                                 shift @khistory if @khistory > $maxkhist;
168                                 $khistpos = @khistory;
169                                 $bot->move(0,0);
170                                 $bot->clrtoeol();
171                                 $bot->addstr(substr($inbuf, 0, COLS));
172                         }
173
174                         # add it to the monitor window
175                         addtotop($inbuf) if $inbuf;
176                 
177                         # send it to the cluster
178                         $inbuf = " " unless $inbuf;
179                         $conn->send_later("I$call|$inbuf");
180                         $inbuf = "";
181                         $pos = $lth = 0;
182                 } elsif ($r eq KEY_UP || $r eq "\020") {
183                         if ($khistpos > 0) {
184                                 --$khistpos;
185                                 $inbuf = $khistory[$khistpos];
186                                 $pos = $lth = length $inbuf;
187                         } else {
188                                 beep();
189                         }
190                 } elsif ($r eq KEY_DOWN || $r eq "\016") {
191                         if ($khistpos < @khistory - 1) {
192                                 ++$khistpos;
193                                 $inbuf = $khistory[$khistpos];
194                                 $pos = $lth = length $inbuf;
195                         } else {
196                                 beep();
197                         }
198                 } elsif ($r eq KEY_PPAGE || $r eq "\032") {
199                         if ($spos > 0) {
200                                 $spos -= $pages;
201                                 $spos = 0 if $spos < 0;
202                                 show_screen();
203                         } else {
204                                 beep();
205                         }
206                 } elsif ($r eq KEY_NPAGE || $r eq "\026") {
207                         if ($spos < @shistory - 1) {
208                                 $spos += $pages;
209                                 $spos = @shistory if $spos > @shistory;
210                                 show_screen();
211                         } else {
212                                 beep();
213                         }
214                 } elsif ($r eq KEY_LEFT || $r eq "\002") {
215                         if ($pos > 0) {
216                                 --$pos;
217                         } else {
218                                 beep();
219                         }
220                 } elsif ($r eq KEY_RIGHT || $r eq "\006") {
221                         if ($pos < $lth) {
222                                 ++$pos;
223                         } else {
224                                 beep();
225                         }
226                 } elsif ($r eq KEY_HOME || $r eq "\001") {
227                         $pos = 0;
228                 } elsif ($r eq KEY_END || $r eq "\005") {
229                         $pos = $lth;
230                 } elsif ($r eq KEY_BACKSPACE || $r eq "\010") {
231                         if ($pos > 0) {
232                                 my $a = substr($inbuf, 0, $pos-1);
233                                 my $b = substr($inbuf, $pos) if $pos < $lth;
234                                 $b = "" unless $b;
235                                 
236                                 $inbuf = $a . $b;
237                                 --$lth;
238                                 --$pos;
239                         } else {
240                                 beep();
241                         }
242                 } elsif ($r eq KEY_DC || $r eq "\004") {
243                         if ($pos < $lth) {
244                                 my $a = substr($inbuf, 0, $pos);
245                                 my $b = substr($inbuf, $pos+1) if $pos < $lth;
246                                 $b = "" unless $b;
247                                 
248                                 $inbuf = $a . $b;
249                                 --$lth;
250                         } else {
251                                 beep();
252                         }
253                 } elsif ($r ge ' ' && $r le '~') {
254                         if ($pos < $lth) {
255                                 my $a = substr($inbuf, 0, $pos);
256                                 my $b = substr($inbuf, $pos);
257                                 $inbuf = $a . $r . $b;
258                         } else {
259                                 $inbuf .= $r;
260                         }
261                         $pos++;
262                         $lth++;
263                 } elsif ($r eq "\014" || $r eq "\022") {
264 #                       curscr()->refresh();
265                         return;
266                 } elsif ($r eq "\013") {
267                         $inbuf = substr($inbuf, 0, $pos);
268                         $lth = length $inbuf;
269                 } else {
270                         beep();
271                 }
272                 $bot->move(1, 0);
273                 $bot->clrtobot();
274                 $bot->addstr($inbuf);
275         } 
276         $bot->move(1, $pos);
277         $bot->refresh();
278 }
279
280
281 #
282 # deal with args
283 #
284
285 $call = uc shift @ARGV if @ARGV;
286 $call = uc $myalias if !$call;
287
288 if ($call eq $mycall) {
289         print "You cannot connect as your cluster callsign ($mycall)\n";
290         exit(0);
291 }
292
293 $conn = Msg->connect("$clusteraddr", $clusterport, \&rec_socket);
294 if (! $conn) {
295         if (-r "$data/offline") {
296                 open IN, "$data/offline" or die;
297                 while (<IN>) {
298                         print $_;
299                 }
300                 close IN;
301         } else {
302                 print "Sorry, the cluster $mycall is currently off-line\n";
303         }
304         exit(0);
305 }
306
307
308 $SIG{'INT'} = \&sig_term;
309 $SIG{'TERM'} = \&sig_term;
310 $SIG{'HUP'} = 'IGNORE';
311
312 $scr = new Curses;
313 raw();
314 noecho();
315 $has_colors = has_colors();
316
317 if ($has_colors) {
318         start_color();
319         init_pair(0, $foreground, $background);
320         init_pair(1, COLOR_RED, $background);
321         init_pair(2, COLOR_YELLOW, $background);
322         init_pair(3, COLOR_GREEN, $background);
323         init_pair(4, COLOR_CYAN, $background);
324         init_pair(5, COLOR_BLUE, $background);
325         init_pair(6, COLOR_MAGENTA, $background);
326 }
327
328 $top = $scr->subwin(LINES()-4, COLS, 0, 0);
329 $top->intrflush(0);
330 $top->scrollok(1);
331 $scr->addstr(LINES()-4, 0, '-' x COLS);
332 $bot = $scr->subwin(3, COLS, LINES()-3, 0);
333 $bot->intrflush(0);
334 $bot->scrollok(1);
335 $bot->keypad(1);
336 $bot->move(1,0);
337 $scr->refresh();
338
339 $SIG{__DIE__} = \&sig_term;
340
341 $pages = LINES()-4;
342
343 $conn->send_now("A$call|$connsort");
344 $conn->send_now("I$call|set/page $maxshist");
345 $conn->send_now("I$call|set/nobeep");
346
347 Msg->set_event_handler(\*STDIN, "read" => \&rec_stdin);
348
349 for (;;) {
350         my $t;
351         Msg->event_loop(1, 0.010);
352         $top->refresh() if $top->is_wintouched;
353         $bot->refresh();
354         $t = time;
355         if ($t > $lasttime) {
356                 $lasttime = $t;
357         }
358 }
359
360 exit(0);