X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fconsole.pl;h=88ffb92787589a527ebf03f51983b053de466bdb;hb=e69a98ce612592a78aca2a3ac4e2388a06059955;hp=14c945a58987edabecd084078caf58eedca9ed38;hpb=30788e921ae7fb6ca54f043d21f154bfd884dcc6;p=spider.git diff --git a/perl/console.pl b/perl/console.pl index 14c945a5..88ffb927 100755 --- a/perl/console.pl +++ b/perl/console.pl @@ -26,12 +26,15 @@ BEGIN { } use Msg; +use IntMsg; use DXVars; use DXDebug; +use DXUtil; +use DXDebug; use IO::File; -use Curses; - -use Carp qw{cluck}; +use Time::HiRes qw(gettimeofday tv_interval); +use Curses 1.06; +use Text::Wrap; use Console; @@ -49,14 +52,81 @@ $connsort = "local"; $khistpos = 0; $spos = $pos = $lth = 0; $inbuf = ""; +@time = (); + +$SIG{WINCH} = sub {@time = gettimeofday}; + +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, $background, $foreground); + init_pair(1, COLOR_RED, $background); + init_pair(2, COLOR_YELLOW, $background); + init_pair(3, COLOR_GREEN, $background); + init_pair(4, COLOR_CYAN, $background); + init_pair(5, COLOR_BLUE, $background); + init_pair(6, COLOR_MAGENTA, $background); + init_pair(7, COLOR_RED, COLOR_BLUE); + init_pair(8, COLOR_YELLOW, COLOR_BLUE); + init_pair(9, COLOR_GREEN, COLOR_BLUE); + init_pair(10, COLOR_CYAN, COLOR_BLUE); + init_pair(11, COLOR_BLUE, COLOR_RED); + init_pair(12, COLOR_MAGENTA, COLOR_BLUE); + init_pair(13, COLOR_YELLOW, COLOR_GREEN); + init_pair(14, COLOR_RED, COLOR_GREEN); + eval { assume_default_colors($foreground, $background) }; + } + + $top = $scr->subwin($lines-4, $cols, 0, 0); + $top->intrflush(0); + $top->scrollok(1); + $top->idlok(1); + $top->meta(1); +# $scr->addstr($lines-4, 0, '-' x $cols); + $bot = $scr->subwin(3, $cols, $lines-3, 0); + $bot->intrflush(0); + $bot->scrollok(1); + $top->idlok(1); + $bot->keypad(1); + $bot->move(1,0); + $bot->meta(1); + $bot->nodelay(1); + $scr->refresh(); + + $pagel = $lines-4; + $mycallcolor = COLOR_PAIR(1) unless $mycallcolor; +} + +sub do_resize +{ + endwin() if $scr; + initscr(); + raw(); + noecho(); + nonl(); + $lines = LINES; + $cols = COLS; + $has_colors = has_colors(); + do_initscr(); + + show_screen(); +} # cease communications sub cease { my $sendz = shift; - if ($conn && $sendz) { - $conn->send_now("Z$call|bye...\n"); - } + $conn->disconnect if $conn; endwin(); dbgclose(); print @_ if @_; @@ -82,40 +152,93 @@ 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 { if ($spos == @shistory - 1) { # if we really are scrolling thru at the end of the history - my $line = $shistory[-1]; + my $line = $shistory[$spos]; $top->addstr("\n") if $spos > 0; setattr($line); $top->addstr($line); +# $top->addstr("\n"); $top->attrset(COLOR_PAIR(0)) if $has_colors; $spos = @shistory; } else { # anywhere else - my $p = $spos - $pages; - my $i; + my ($i, $l); + my $p = $spos-1; + for ($i = 0; $i < $pagel && $p >= 0; ) { + $l = measure($shistory[$p]); + $i += $l; + $p-- if $i < $pagel; + } $p = 0 if $p < 0; $top->move(0, 0); $top->attrset(COLOR_PAIR(0)) if $has_colors; $top->clrtobot(); - for ($i = 0; $i < $pages && $p < @shistory; $i++, $p++) { + for ($i = 0; $i < $pagel && $p < @shistory; $p++) { my $line = $shistory[$p]; - $line = substr($line, 0, COLS()) if length $line > COLS(); - $top->move($i, 0); + my $lines = measure($line); + last if $i + $lines > $pagel; + $top->addstr("\n") if $i; setattr($line); $top->addstr($line); $top->attrset(COLOR_PAIR(0)) if $has_colors; + $i += $lines; } $spos = $p; + $spos = @shistory if $spos > @shistory; } - $top->refresh(); + my $shl = @shistory; + my $size = $lines . 'x' . $cols . '-'; + my $add = "-$spos-$shl"; + my $time = ztime(time); + my $str = "-" . $time . '-' x ($cols - (length($size) + length($call) + length($add) + length($time) + 1)); + $scr->addstr($lines-4, 0, $str); + + $scr->addstr($size); + $scr->attrset($mycallcolor) if $has_colors; + $scr->addstr($call); + $scr->attrset(COLOR_PAIR(0)) if $has_colors; + $scr->addstr($add); + $scr->refresh(); +# $top->refresh(); +} + +# add a line to the end of the top screen +sub addtotop +{ + while (@_) { + my $inbuf = shift; + if ($inbuf =~ s/\x07+$//) { + beep(); + } + if (length $inbuf > $cols) { + $Text::Wrap::Columns = $cols; + push @shistory, wrap('',"\t", $inbuf); + } else { + push @shistory, $inbuf; + } + shift @shistory while @shistory > $maxshist; + } + show_screen(); } # handle incoming messages @@ -126,16 +249,22 @@ sub rec_socket cease(1); } if (defined $msg) { - my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/; + my ($sort, $call, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/; - if ($sort eq 'D') { - push @shistory, $line; - shift @shistory if @shistory > $maxshist; -# $spos = @shistory if $spos >= @shistory - 1; - show_screen(); - } elsif ($sort eq 'Z') { # end, disconnect, go, away ..... + $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 ..... cease(0); } + # ****************************************************** + # ****************************************************** + # any other sorts that might happen are silently ignored. + # ****************************************************** + # ****************************************************** + } else { + cease(0); } $top->refresh(); $lasttime = time; @@ -143,9 +272,7 @@ sub rec_socket sub rec_stdin { - my ($fh) = @_; - - $r = $bot->getch(); + my $r = shift;; # my $prbuf; # $prbuf = $buf; @@ -153,20 +280,44 @@ sub rec_stdin # $prbuf =~ s/\n/\\n/; # print "sys: $r ($prbuf)\n"; if (defined $r) { + + $r = '0' if !$r; + if ($r eq KEY_ENTER || $r eq "\n" || $r eq "\r") { # save the lines - if ($inbuf) { - push @khistory, $inbuf if $inbuf; - shift @khistory if @khistory > $maxkhist; - $khistpos = @khistory; - $bot->move(0,0); - $bot->clrtoeol(); - $bot->addstr(substr($inbuf, 0, COLS)); + $inbuf = " " unless length $inbuf; + + # check for a pling and do a search back for a command + if ($inbuf =~ /^!/o) { + my $i; + $inbuf =~ s/^!//o; + for ($i = $#khistory; $i >= 0; $i--) { + if ($khistory[$i] =~ /^$inbuf/) { + $inbuf = $khistory[$i]; + last; + } + } + if ($i < 0) { + beep(); + return; + } } + push @khistory, $inbuf if length $inbuf; + shift @khistory if @khistory > $maxkhist; + $khistpos = @khistory; + $bot->move(0,0); + $bot->clrtoeol(); + $bot->addstr(substr($inbuf, 0, $cols)); + + # add it to the monitor window + unless ($spos == @shistory) { + $spos = @shistory; + show_screen(); + }; + addtotop($inbuf); # send it to the cluster - $inbuf = " " unless $inbuf; $conn->send_later("I$call|$inbuf"); $inbuf = ""; $pos = $lth = 0; @@ -188,7 +339,12 @@ sub rec_stdin } } elsif ($r eq KEY_PPAGE || $r eq "\032") { if ($spos > 0) { - $spos -= $pages; + my ($i, $l); + for ($i = 0; $i <= $pagel-1 && $spos >= 0; ) { + $l = measure($shistory[$spos]); + $i += $l; + $spos-- if $i <= $pagel; + } $spos = 0 if $spos < 0; show_screen(); } else { @@ -196,8 +352,13 @@ sub rec_stdin } } elsif ($r eq KEY_NPAGE || $r eq "\026") { if ($spos < @shistory - 1) { - $spos += $pages; - $spos = @shistory if $spos > @shistory; + my ($i, $l); + for ($i = 0; $i <= $pagel && $spos <= @shistory; ) { + $l = measure($shistory[$spos]); + $i += $l; + $spos++ if $i <= $pagel; + } + $spos = @shistory if $spos >= @shistory - 1; show_screen(); } else { beep(); @@ -218,7 +379,7 @@ sub rec_stdin $pos = 0; } elsif ($r eq KEY_END || $r eq "\005") { $pos = $lth; - } elsif ($r eq KEY_BACKSPACE || $r eq "\010") { + } elsif ($r eq KEY_BACKSPACE || $r eq "\010" || $r eq "\x7f") { if ($pos > 0) { my $a = substr($inbuf, 0, $pos-1); my $b = substr($inbuf, $pos) if $pos < $lth; @@ -241,7 +402,19 @@ sub rec_stdin } else { beep(); } - } elsif ($r ge ' ' && $r le '~') { + } elsif ($r eq KEY_RESIZE || $r eq "\0632") { + do_resize(); + return; + } elsif (defined $r && is_pctext($r)) { + # move the top screen back to the bottom if you type something + if ($spos < @shistory) { + $spos = @shistory; + show_screen(); + } + + # $r = ($r lt ' ' || $r gt "\x7e") ? sprintf("'%x", ord $r) : $r; + + # insert the character into the keyboard buffer if ($pos < $lth) { my $a = substr($inbuf, 0, $pos); my $b = substr($inbuf, $pos); @@ -252,11 +425,9 @@ sub rec_stdin $pos++; $lth++; } elsif ($r eq "\014" || $r eq "\022") { - $top->touchwin(); - $bot->touchwin(); - $scr->touchwin(); - $scr->refresh(); - $top->refresh(); + touchwin(curscr, 1); + refresh(curscr); + return; } elsif ($r eq "\013") { $inbuf = substr($inbuf, 0, $pos); $lth = length $inbuf; @@ -278,13 +449,21 @@ sub rec_stdin $call = uc shift @ARGV if @ARGV; $call = uc $myalias if !$call; +my ($scall, $ssid) = split /-/, $call; +$ssid = undef unless $ssid && $ssid =~ /^\d+$/; +if ($ssid) { + $ssid = 15 if $ssid > 15; + $call = "$scall-$ssid"; +} if ($call eq $mycall) { print "You cannot connect as your cluster callsign ($mycall)\n"; exit(0); } -$conn = Msg->connect("$clusteraddr", $clusterport, \&rec_socket); +dbginit(); + +$conn = IntMsg->connect("$clusteraddr", $clusterport, \&rec_socket); if (! $conn) { if (-r "$data/offline") { open IN, "$data/offline" or die; @@ -298,57 +477,55 @@ if (! $conn) { exit(0); } +$conn->set_error(sub{cease(0)}); -$SIG{'INT'} = \&sig_term; -$SIG{'TERM'} = \&sig_term; -$SIG{'HUP'} = 'IGNORE'; - -$scr = new Curses; -raw(); -noecho(); -$has_colors = has_colors(); - -if ($has_colors) { - start_color(); - init_pair(0, $foreground, $background); - init_pair(1, COLOR_RED, $background); - init_pair(2, COLOR_YELLOW, $background); - init_pair(3, COLOR_GREEN, $background); - init_pair(4, COLOR_CYAN, $background); - init_pair(5, COLOR_BLUE, $background); - init_pair(6, COLOR_MAGENTA, $background); + +unless ($DB::VERSION) { + $SIG{'INT'} = \&sig_term; + $SIG{'TERM'} = \&sig_term; } -$top = $scr->subwin(LINES()-4, COLS, 0, 0); -$top->intrflush(0); -$top->scrollok(1); -$scr->addstr(LINES()-4, 0, '-' x COLS); -$bot = $scr->subwin(3, COLS, LINES()-3, 0); -$bot->intrflush(0); -$bot->scrollok(1); -$bot->keypad(1); -$bot->move(1,0); -$scr->refresh(); +$SIG{'HUP'} = \&sig_term; + +# start up +do_resize(); $SIG{__DIE__} = \&sig_term; -$pages = LINES()-4; +$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_now("A$call|$connsort"); -$conn->send_now("I$call|set/page $maxshist"); -$conn->send_now("I$call|set/nobeep"); +#Msg->set_event_handler(\*STDIN, "read" => \&rec_stdin); -Msg->set_event_handler(\*STDIN, "read" => \&rec_stdin); +$Text::Wrap::Columns = $cols; +my $lastmin = 0; for (;;) { my $t; - Msg->event_loop(1, 0.010); - $top->refresh() if $top->is_wintouched; - $bot->refresh(); + Msg->event_loop(1, 0.01); $t = time; if ($t > $lasttime) { + my ($min)= (gmtime($t))[1]; + if ($min != $lastmin) { + show_screen(); + $lastmin = $min; + } $lasttime = $t; } + my $ch = $bot->getch(); + if (@time && tv_interval(\@time, [gettimeofday]) >= 1) { +# mydbg("Got Resize"); +# do_resize(); + next; + } + if (defined $ch) { + if ($ch ne '-1') { + rec_stdin($ch); + } + } + $top->refresh() if $top->is_wintouched; + $bot->refresh(); } exit(0);