X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fconsole.pl;h=fad52b963e3b94121a3c677489c0d7b25e63698d;hb=4dfc1f60733b682dc1ac9724fd75395d1c41c62d;hp=48c7ff8c1c756210911f4250a79980f6ca0c3c2b;hpb=431c8a14cdecd0ec455b6619380687dbe84e2a35;p=spider.git diff --git a/perl/console.pl b/perl/console.pl index 48c7ff8c..fad52b96 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 @@ -52,6 +52,7 @@ use Console; # $call = ""; # the callsign being used +$node = ""; # the node callsign being used $conn = 0; # the connection object for the cluster $lasttime = time; # lasttime something happened on the interface @@ -69,19 +70,13 @@ $inscroll = 0; $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); @@ -137,8 +132,26 @@ 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; } # cease communications @@ -245,12 +258,13 @@ sub show_screen 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(); @@ -458,10 +472,15 @@ sub addtotop while (@_) { my $inbuf = shift; my $l = length $inbuf; + dbg("addtotop: $l $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; + push @sh, split /\n/, wrap('',' ' x 19, $inbuf); + } else { + push @sh, $inbuf; + } } else { push @sh, $inbuf; } @@ -522,10 +541,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; @@ -554,11 +573,17 @@ 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; + my ($scall, $ssid) = split /-/, $call; $ssid = undef unless $ssid && $ssid =~ /^\d+$/; if ($ssid) { @@ -571,8 +596,6 @@ if ($call eq $mycall) { exit(0); } -dbginit(); - unless ($DB::VERSION) { $SIG{'INT'} = \&sig_term; $SIG{'TERM'} = \&sig_term; @@ -580,12 +603,14 @@ unless ($DB::VERSION) { $SIG{'HUP'} = \&sig_term; -# start up + +# start upb +$Text::Wrap::Columns = $cols; doresize(); $SIG{__DIE__} = \&sig_term; -#$Text::Wrap::Columns = $cols; +$Text::Wrap::columns = $cols; my $lastmin = 0; @@ -594,7 +619,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 {