#
#
-require 5.004;
+require 5.16.1;
+use strict;
use warnings;
+our $root;
+our $is_win;
+our $myalias;
+our $mycall;
+our $clusteraddr;
+our $clusterport;
+our $maxshist;
+our $maxkhist;
+our $foreground;
+our $background;
+our $mycallcolor;
+our @colors;
+
# search local then perl directories
BEGIN {
# root of directory tree for this system
$is_win = ($^O =~ /^MS/ || $^O =~ /^OS-2/) ? 1 : 0; # is it Windows?
}
-$clusteraddr = '127.0.0.1';
-$clusterport = 27754;
use Mojo::IOLoop;
# initialisation
#
-$call = ""; # the callsign being used
-$conn = 0; # the connection object for the cluster
-$lasttime = time; # lasttime something happened on the interface
+$clusteraddr //= '127.0.0.1';
+$clusterport //= 27754;
+
+our $call = ""; # the callsign being used
+our $node = ""; # the node callsign being used
+our $conn = 0; # the connection object for the cluster
+our $lasttime = time; # lasttime something happened on the interface
+
+our $connsort = "local";
+our @kh = ();
+our @sh = ();
+our $kpos = 0;
+our $inbuf = "";
+our $idle = 0;
+our $inscroll = 0;
+
+my $top;
+my $bot;
+my $lines;
+my $scr;
+my $cols;
+my $pagel;
+my $has_colors;
+our $pos;
+our $lth;
+my $sh;
+
+our $spos = $pos = $lth = 0;
+
-$connsort = "local";
-@kh = ();
-@sh = ();
-$kpos = 0;
-$spos = $pos = $lth = 0;
-$inbuf = "";
-$lastmin = 0;
-$idle = 0;
-$inscroll = 0;
#$SIG{WINCH} = sub {@time = gettimeofday};
$DXDebug::no_stdout = 1;
-sub mydbg
-{
- local *STDOUT = undef;
- dbg(@_);
-}
-
# do the screen initialisation
sub do_initscr
{
$scr = new Curses;
if ($has_colors) {
start_color();
- init_pair("0", $foreground, $background);
+ init_pair(0, $foreground, $background);
# init_pair(0, $background, $foreground);
init_pair(1, COLOR_RED, $background);
init_pair(2, COLOR_YELLOW, $background);
$inscroll = 0;
$spos = @sh < $pagel ? 0 : @sh - $pagel;
show_screen();
+ $conn->send_later("C$call|$cols") if $conn;
}
# cease communications
}
}
-# measure the no of screen lines a line will take
-sub measure
-{
- my $line = shift;
- return 0 unless $line;
-
- my $l = length $line;
- my $lines = int ($l / $cols);
- $lines++ if $l / $cols > $lines;
- return $lines;
-}
# display the top screen
sub show_screen
dbg("B: s:$spos h:" . scalar @sh) if isdbg('console');
my ($i, $l);
-# for ($i = 0; $i < $pagel && $p >= 0; ) {
-# $l = measure($sh[$p]);
-# $i += $l;
-# $p-- if $i < $pagel;
- # }
$spos = 0 if $spos < 0;
my $y = $spos;
$top->clrtobot();
for ($i = 0; $i < $pagel && $y < @sh; ++$y) {
my $line = $sh[$y];
-# my $lines = measure($line);
my $lines = 1;
$top->move($i, 0);
dbg("C: s:$spos y:$i sh:" . scalar @sh . " l:" . length($line) . " '$line'") if isdbg('console');
my $size = $lines . 'x' . $cols . '-';
my $add = "-$spos-$shl";
my $time = ztime(time);
- my $str = "-" . $time . '-' . ($inscroll ? 'S':'-') . '-' x ($cols - (length($size) + length($call) + length($add) + length($time) + 3));
+ my $c = "$call\@$node";
+ my $str = "-" . $time . '-' . ($inscroll ? 'S':'-') . '-' x ($cols - (length($size) + length($c) + length($add) + length($time) + 3));
$scr->addstr($lines-4, 0, $str);
$scr->addstr($size);
$scr->attrset($mycallcolor) if $has_colors;
- $scr->addstr($call);
+ $scr->addstr($c);
$scr->attrset(COLOR_PAIR(0)) if $has_colors;
$scr->addstr($add);
$scr->refresh();
$bot->clrtoeol();
$bot->addstr(substr($inbuf, 0, $cols));
- # add it to the monitor window
-# unless ($spos == @sh) {
-# $spos = @sh;
-# show_screen();
-# }
if ($inscroll && $spos < @sh) {
$spos = @sh - $pagel;
$inscroll = 0;
show_screen();
}
- addtotop($inbuf);
+ addtotop(' ', $inbuf);
# send it to the cluster
$conn->send_later("I$call|$inbuf");
}
} elsif ($r eq KEY_PPAGE || $r eq "\032") {
if ($spos > 0 && @sh > $pagel) {
-# my ($i, $l);
-# for ($i = 0; $i < $pagel-1 && $spos >= 0; ) {
-# $l = measure($sh[$spos]);
-# $i += $l;
-# --$spos if $i <= $pagel;
-# }
$spos -= $pagel+int($pagel/2);
$spos = 0 if $spos < 0;
$inscroll = 1;
}
} elsif ($r eq KEY_NPAGE || $r eq "\026") {
if ($inscroll && $spos < @sh) {
-# my ($i, $l);
-# for ($i = 0; $i <= $pagel && $spos < @sh; ) {
-# $l = measure($sh[$spos]);
-# $i += $l;
-# ++$spos if $i <= $pagel && $spos < @sh;
-# }
dbg("NPAGE sp:$spos $sh:". scalar @sh . " pl: $pagel") if isdbg('console');
$spos += int($pagel/2);
# add a line to the end of the top screen
sub addtotop
{
+ my $sort = shift;
while (@_) {
my $inbuf = shift;
my $l = length $inbuf;
if ($l > $cols) {
-# $Text::Wrap::Columns = $cols;
-# push @sh, wrap('',"\t", $inbuf);
- push @sh, $inbuf;
+ $inbuf =~ s/\s+/ /g;
+ if (length $inbuf > $cols) {
+ $Text::Wrap::columns = $cols;
+ my $token;
+ ($token) = $inbuf =~ m!^(.* de [-\w\d/\#]+:?\s+|\w{9}\@\d\d:\d\d:\d\d )!;
+ $token ||= ' ' x 19;
+ push @sh, split /\n/, wrap('', ' ' x length($token), $inbuf);
+ } else {
+ push @sh, $inbuf;
+ }
} else {
push @sh, $inbuf;
}
}
+
show_screen() unless $inscroll;
}
cease(1);
}
if (defined $msg) {
- dbg("msg: " . length($msg) . " '$msg'") if isdbg('console');
my ($sort, $incall, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/;
+ dbg("msg: " . length($msg) . " '$msg'") if isdbg('console');
if ($line =~ s/\x07+$//) {
beep();
}
$call = $incall if $call ne $incall;
$line =~ s/[\x00-\x06\x08\x0a-\x19\x1b-\x1f\x80-\x9f]/./g; # immutable CSI sequence + control characters
- if ($sort && $sort eq 'D') {
- $line = " " unless length($line);
- addtotop($line);
- } elsif ($sort && $sort eq 'Z') { # end, disconnect, go, away .....
+ if ($sort && $sort eq 'Z') { # end, disconnect, go, away .....
cease(0);
- }
- # ******************************************************
- # ******************************************************
- # any other sorts that might happen are silently ignored.
- # ******************************************************
- # ******************************************************
+ } else {
+ $line = " " unless length($line);
+ addtotop($sort, $line);
+ }
+
} else {
cease(0);
}
$lasttime = time;
}
+my $lastmin = 0;
sub idle_loop
{
}
my $ch = $bot->getch(); # this is here just to catch RESIZE events
if (defined $ch) {
- if ($ch == KEY_RESIZE) {
+ if ($ch eq KEY_RESIZE) {
doresize();
} else {
- rec_stdin($ch) unless $ch == '-1';
+ rec_stdin($ch) unless $ch eq '-1';
}
}
$top->refresh() if $top->is_wintouched;
sub on_connect
{
my $conn = shift;
- $conn->send_later("A$call|$connsort width=$cols");
- $conn->send_later("I$call|set/page $maxshist");
- #$conn->send_later("I$call|set/nobeep");
+ $conn->send_later("A$call|$connsort width=$cols enhanced");
+ $conn->send_later("I$call|set/page " . ($maxshist-5));
+ $conn->send_later("I$call|set/nobeep");
}
sub on_disconnect
while (@ARGV && $ARGV[0] =~ /^-/) {
my $arg = shift;
- dbgadd('console'), $maxshist = 200 if $arg eq '-x';
+ if ($arg eq '-x') {
+ dbginit('console');
+ dbgadd('console');
+ $maxshist = 200;
+ }
}
$call = uc shift @ARGV if @ARGV;
-$call = uc $myalias if !$call;
+$call = uc $myalias unless $call;
+$node = uc $mycall unless $node;
+
+$call = normalise_call($call);
my ($scall, $ssid) = split /-/, $call;
$ssid = undef unless $ssid && $ssid =~ /^\d+$/;
if ($ssid) {
- $ssid = 15 if $ssid > 15;
+ $ssid = 99 if $ssid > 99;
$call = "$scall-$ssid";
}
exit(0);
}
-dbginit();
-
unless ($DB::VERSION) {
$SIG{'INT'} = \&sig_term;
$SIG{'TERM'} = \&sig_term;
$SIG{'HUP'} = \&sig_term;
-# start up
+
+# start upb
+$Text::Wrap::columns = $cols;
doresize();
$SIG{__DIE__} = \&sig_term;
-#$Text::Wrap::Columns = $cols;
-
-my $lastmin = 0;
-
-
$conn = IntMsg->connect($clusteraddr, $clusterport, rproc => \&rec_socket);
$conn->{on_connect} = \&on_connect;
$conn->{on_disconnect} = \&on_disconnect;
-my $timer = Mojo::IOLoop->recurring(1, sub {DXLog::flushall()});
+my $timer = Mojo::IOLoop->recurring(1, sub {DXLog::flushall()}) if $DXDebug::fp;
$idle = Mojo::IOLoop->recurring(0.100 => \&idle_loop);
Mojo::IOLoop->singleton->reactor->io(\*STDIN => sub {
projects / spider.git / blobdiff