]> scm.dxcluster.org Git - spider.git/blob - perl/console.pl
429f5d36245be86a35880a477356a2c6f1ec6f19
[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 # 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);