X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fconsole.pl;h=32c6cf5f109d9e2cd6911d5ece1ebe6634640b27;hb=c7abd10080945488d7ea9d850aba2a8b565b4c57;hp=2a88f5b5db7aff99cd7dc3bf8d2ba86f6b3f5ef4;hpb=9e6322c41076ff462cb37416e28c3742567dc62a;p=spider.git diff --git a/perl/console.pl b/perl/console.pl index 2a88f5b5..32c6cf5f 100755 --- a/perl/console.pl +++ b/perl/console.pl @@ -13,7 +13,7 @@ # # -require 5.004; +require 5.16.1; use warnings; # search local then perl directories @@ -27,8 +27,6 @@ BEGIN { $is_win = ($^O =~ /^MS/ || $^O =~ /^OS-2/) ? 1 : 0; # is it Windows? } -$clusteraddr = '127.0.0.1'; -$clusterport = 27754; use Mojo::IOLoop; @@ -51,6 +49,9 @@ use Console; # 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 @@ -134,6 +135,7 @@ sub doresize $inscroll = 0; $spos = @sh < $pagel ? 0 : @sh - $pagel; show_screen(); + $conn->send_later("C$call|$cols") if $conn; } # cease communications @@ -166,17 +168,6 @@ sub setattr } } -# 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 @@ -185,11 +176,6 @@ 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; @@ -198,7 +184,6 @@ sub show_screen $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'); @@ -295,18 +280,13 @@ sub rec_stdin $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"); @@ -330,12 +310,6 @@ sub rec_stdin } } 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; @@ -345,12 +319,6 @@ sub rec_stdin } } 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); @@ -451,17 +419,26 @@ sub rec_stdin # 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; } @@ -473,8 +450,8 @@ sub rec_socket 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(); } @@ -484,17 +461,13 @@ sub rec_socket $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); } @@ -518,10 +491,10 @@ 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; @@ -531,7 +504,7 @@ sub idle_loop 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"); } @@ -550,7 +523,11 @@ 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; @@ -569,8 +546,6 @@ if ($call eq $mycall) { exit(0); } -dbginit(); - unless ($DB::VERSION) { $SIG{'INT'} = \&sig_term; $SIG{'TERM'} = \&sig_term; @@ -578,13 +553,13 @@ unless ($DB::VERSION) { $SIG{'HUP'} = \&sig_term; -# start up + +# start upb +$Text::Wrap::columns = $cols; doresize(); $SIG{__DIE__} = \&sig_term; -#$Text::Wrap::Columns = $cols; - my $lastmin = 0; @@ -592,7 +567,7 @@ $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 {