#
#
-require 5.004;
+require 5.16.1;
use warnings;
# search local then perl directories
$is_win = ($^O =~ /^MS/ || $^O =~ /^OS-2/) ? 1 : 0; # is it Windows?
}
-$clusteraddr = '127.0.0.1';
-$clusterport = 27754;
use Mojo::IOLoop;
# initialisation
#
+$clusteraddr //= '127.0.0.1';
+$clusterport //= 27754;
+
$call = ""; # the callsign being used
$node = ""; # the node callsign being used
$conn = 0; # the connection object for the cluster
$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');
$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);
}
}
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("A$call|$connsort width=$cols enhanced");
$conn->send_later("I$call|set/page $maxshist");
#$conn->send_later("I$call|set/nobeep");
}
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;
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->{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