X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fconsole.pl;h=32c6cf5f109d9e2cd6911d5ece1ebe6634640b27;hb=c7abd10080945488d7ea9d850aba2a8b565b4c57;hp=faf7c5ce062890e26090264a64b4d617203e038f;hpb=36476fc1fa5aeefc5d34ff9e8bb9c08fafcfe589;p=spider.git diff --git a/perl/console.pl b/perl/console.pl index faf7c5ce..32c6cf5f 100755 --- a/perl/console.pl +++ b/perl/console.pl @@ -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 @@ -132,23 +133,6 @@ sub doresize do_initscr(); $inscroll = 0; - dbg("resize: l=$lines c=$cols"); - dbg("resize: sh=". scalar @sh ); -# my @tsh; -# my $t; -# while (defined ($t = shift @sh)) { -# dbg("t: $t(" , length $t . ')'); -# if ($t =~ /^\t/) { -# $t =~ s/^\t/ /; -# push(@tsh, pop(@tsh) . $t) -# } else { -# push(@tsh, $t); -# } -# dbg("tsh: " . scalar @tsh); -# } -# dbg("resize: tsh=". scalar @tsh ); -# $spos = @tsh < $pagel ? 0 : @tsh - $pagel; - # addtotop(@tsh); $spos = @sh < $pagel ? 0 : @sh - $pagel; show_screen(); $conn->send_later("C$call|$cols") if $conn; @@ -184,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 @@ -203,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; @@ -216,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'); @@ -313,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"); @@ -348,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; @@ -363,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); @@ -469,15 +419,18 @@ 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; - dbg("addtotop: $l $inbuf"); if ($l > $cols) { $inbuf =~ s/\s+/ /g; if (length $inbuf > $cols) { $Text::Wrap::columns = $cols; - push @sh, split /\n/, wrap('',' ' x 19, $inbuf); + 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; } @@ -485,6 +438,7 @@ sub addtotop push @sh, $inbuf; } } + show_screen() unless $inscroll; } @@ -496,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(); } @@ -507,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); } @@ -554,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"); }