From 84e68f5fca6f33df5e2c7c801038043d339aaac2 Mon Sep 17 00:00:00 2001 From: djk Date: Tue, 8 Jun 1999 21:32:21 +0000 Subject: [PATCH] added console.pl --- Changes | 2 + perl/DXProt.pm | 2 +- perl/console.pl | 171 ++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 174 insertions(+), 1 deletion(-) create mode 100755 perl/console.pl diff --git a/Changes b/Changes index 85b364f5..d82b0d0e 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,5 @@ +08Jun99======================================================================= +1. Started work on the curses based operator console. 03Jun99======================================================================= 1. cluster seems to have a memory leak, put DESTROY functions in where appropriate. diff --git a/perl/DXProt.pm b/perl/DXProt.pm index d9abfad6..d9e59c49 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -389,7 +389,7 @@ sub normal # now check the call over my $node = DXCluster->get_exact($call); if ($node) { - my $dxchan; + my $dxchan; if (($dxchan = DXChannel->get($call)) && $dxchan != $self) { dbg('chan', "LOOP: $call connected locally"); } diff --git a/perl/console.pl b/perl/console.pl new file mode 100755 index 00000000..12192152 --- /dev/null +++ b/perl/console.pl @@ -0,0 +1,171 @@ +#!/usr/bin/perl -w +# +# this is the operators console. +# +# Calling syntax is:- +# +# console.pl [callsign] +# +# if the callsign isn't given then the sysop callsign in DXVars.pm is assumed +# +# Copyright (c) 1999 Dirk Koopman G1TLH +# +# $Id$ +# + +require 5.004; + +# search local then perl directories +BEGIN { + # root of directory tree for this system + $root = "/spider"; + $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'}; + + unshift @INC, "$root/perl"; # this IS the right way round! + unshift @INC, "$root/local"; +} + +use Msg; +use DXVars; +use DXDebug; +use IO::File; +use Curses; + +use Carp qw{cluck}; + +# cease communications +sub cease +{ + my $sendz = shift; + if ($conn && $sendz) { + $conn->send_now("Z$call|bye...\n"); + } + endwin(); + dbgclose(); +# $SIG{__WARN__} = sub {my $a = shift; cluck($a); }; + sleep(1); + exit(0); +} + +# terminate program from signal +sub sig_term +{ + cease(1); +} + +# handle incoming messages +sub rec_socket +{ + my ($con, $msg, $err) = @_; + if (defined $err && $err) { + cease(1); + } + if (defined $msg) { + my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/; + + if ($sort eq 'D') { + $top->addstr("$line\n"); + } elsif ($sort eq 'Z') { # end, disconnect, go, away ..... + cease(0); + } + } + $lasttime = time; +} + +sub rec_stdin +{ + my ($fh) = @_; + + $r = $bot->getch(); + + # my $prbuf; + # $prbuf = $buf; + # $prbuf =~ s/\r/\\r/; + # $prbuf =~ s/\n/\\n/; + # print "sys: $r ($prbuf)\n"; + if (defined $r) { + if ($r eq "\n" || $r eq "\r") { + $inbuf = " " unless $inbuf; + $conn->send_later("I|$call|$inbuf"); + $inbuf = ""; + } else { + $inbuf .= $r; + } + } + $bot->refresh(); +} + + +# +# initialisation +# + +$call = ""; # the callsign being used +$conn = 0; # the connection object for the cluster +$lasttime = time; # lasttime something happened on the interface + +$connsort = "local"; + +# +# deal with args +# + +$call = uc shift @ARGV if @ARGV; +$call = uc $myalias if !$call; + +if ($call eq $mycall) { + print "You cannot connect as your cluster callsign ($mycall)\n"; + exit(0); +} + +$conn = Msg->connect("$clusteraddr", $clusterport, \&rec_socket); +if (! $conn) { + if (-r "$data/offline") { + open IN, "$data/offline" or die; + while () { + print $_; + } + close IN; + } else { + print "Sorry, the cluster $mycall is currently off-line\n"; + } + exit(0); +} + + +$SIG{'INT'} = \&sig_term; +$SIG{'TERM'} = \&sig_term; +$SIG{'HUP'} = 'IGNORE'; + +$scr = new Curses; +cbreak(); +$top = $scr->subwin(LINES()-4, COLS, 0, 0); +$top->intrflush(0); +$top->scrollok(1); +$scr->addstr(LINES()-4, 0, '-' x COLS); +$bot = $scr->subwin(3, COLS, LINES()-3, 0); +$bot->intrflush(0); +$bot->scrollok(1); +$bot->keypad(1); +$scr->refresh(); + +$pages = LINES()-6; + +$conn->send_now("A$call|$connsort"); +$conn->send_now("I|$call|set/page $pages"); +$conn->send_now("I|$call|set/nobeep"); + +Msg->set_event_handler(\*STDIN, "read" => \&rec_stdin); + +for (;;) { + my $t; + Msg->event_loop(1, 0.010); + $top->refresh() if $top->is_wintouched; + $bot->refresh(); + $t = time; + if ($t > $lasttime) { + $lasttime = $t; + } +} + +exit(0); -- 2.43.0