X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fconsole.pl;h=97b6220df84dbdec0663dc3263c368bc19faee32;hb=2747e0fe4269e9a7e095c333598191eb9dca63fc;hp=8f028aa7ab9d7e8b2e9bde85e2386b1f66b8caf0;hpb=6f82c4f1701f45cbae4bce7518eb40e645e6360a;p=spider.git diff --git a/perl/console.pl b/perl/console.pl index 8f028aa7..97b6220d 100755 --- a/perl/console.pl +++ b/perl/console.pl @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/env perl # # this is the operators console. # @@ -10,10 +10,11 @@ # # Copyright (c) 1999 Dirk Koopman G1TLH # -# $Id$ +# # require 5.004; +use warnings; # search local then perl directories BEGIN { @@ -23,16 +24,26 @@ BEGIN { unshift @INC, "$root/perl"; # this IS the right way round! unshift @INC, "$root/local"; + $is_win = ($^O =~ /^MS/ || $^O =~ /^OS-2/) ? 1 : 0; # is it Windows? } -use Msg; +$clusteraddr = '127.0.0.1'; +$clusterport = 27754; + +use Mojo::IOLoop; + use DXVars; +use SysVar; + +use Msg; +use IntMsg; 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; @@ -50,54 +61,84 @@ $connsort = "local"; $khistpos = 0; $spos = $pos = $lth = 0; $inbuf = ""; +@time = (); +$lastmin = 0; +$idle = 0; + + +#$SIG{WINCH} = sub {@time = gettimeofday}; + +sub mydbg +{ + local *STDOUT = undef; + dbg(@_); +} # do the screen initialisation sub do_initscr { $scr = new Curses; - raw(); - noecho(); - $has_colors = has_colors(); - 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); 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) } unless $is_win; } - - $top = $scr->subwin(LINES()-4, COLS, 0, 0); + + $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); + $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; + $pagel = $lines-4; $mycallcolor = COLOR_PAIR(1) unless $mycallcolor; } sub do_resize { - undef $scr; + 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 @_; @@ -130,8 +171,8 @@ sub measure return 0 unless $line; my $l = length $line; - my $lines = int ($l / COLS()); - $lines++ if $l / COLS() > $lines; + my $lines = int ($l / $cols); + $lines++ if $l / $cols > $lines; return $lines; } @@ -139,10 +180,16 @@ sub measure sub show_screen { if ($spos == @shistory - 1) { - # if we really are scrolling thru at the end of the history my $line = $shistory[$spos]; - $top->addstr("\n") if $spos > 0; + my $y = $spos; + if ($spos >= $pagel) { + $top->scrl(1); + $y = $pagel-1; +# $top->addstr("\r"); + } + $top->move($y, 0); + $top->refresh; setattr($line); $top->addstr($line); $top->attrset(COLOR_PAIR(0)) if $has_colors; @@ -166,9 +213,9 @@ sub show_screen for ($i = 0; $i < $pagel && $p < @shistory; $p++) { my $line = $shistory[$p]; my $lines = measure($line); - last if $i + $lines > $pagel; + $top->move($i, 0); setattr($line); - $top->addstr($i, 0, $line); + $top->addstr($line); $top->attrset(COLOR_PAIR(0)) if $has_colors; $i += $lines; } @@ -176,13 +223,15 @@ sub show_screen $spos = @shistory if $spos > @shistory; } my $shl = @shistory; + my $size = $lines . 'x' . $cols . '-'; my $add = "-$spos-$shl"; my $time = ztime(time); - my $str = "-" . $time . '-' x (COLS() - (length($call) + length($add) + length($time) + 1)); - $scr->addstr(LINES()-4, 0, $str); + 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->addstr($call); $scr->attrset(COLOR_PAIR(0)) if $has_colors; $scr->addstr($add); $scr->refresh(); @@ -194,8 +243,17 @@ sub addtotop { while (@_) { my $inbuf = shift; - push @shistory, $inbuf; - shift @shistory if @shistory > $maxshist; + if ($inbuf =~ s/\x07+$//) { + beep(); + } + $inbuf =~ s/\s+$//s; + if (length $inbuf > $cols) { + $Text::Wrap::Columns = $cols; + push @shistory, wrap('',"\t", $inbuf); + } else { + push @shistory, $inbuf; + } + shift @shistory while @shistory > $maxshist; } show_screen(); } @@ -208,13 +266,25 @@ sub rec_socket cease(1); } if (defined $msg) { - my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/; + my ($sort, $incall, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/; + + # change my call if my node says "tonight Michael you are Jane" or something like that... + $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 ..... cease(0); } + # ****************************************************** + # ****************************************************** + # any other sorts that might happen are silently ignored. + # ****************************************************** + # ****************************************************** + } else { + cease(0); } $top->refresh(); $lasttime = time; @@ -222,9 +292,7 @@ sub rec_socket sub rec_stdin { - my ($fh) = @_; - - $r = $bot->getch(); + my $r = shift;; # my $prbuf; # $prbuf = $buf; @@ -232,43 +300,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) { - # 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; + $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; } } - push @khistory, $inbuf if $inbuf; - shift @khistory if @khistory > $maxkhist; - $khistpos = @khistory; - $bot->move(0,0); - $bot->clrtoeol(); - $bot->addstr(substr($inbuf, 0, COLS)); + 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) if $inbuf; + addtotop($inbuf); # send it to the cluster - $inbuf = " " unless $inbuf; $conn->send_later("I$call|$inbuf"); $inbuf = ""; $pos = $lth = 0; @@ -291,7 +360,7 @@ sub rec_stdin } elsif ($r eq KEY_PPAGE || $r eq "\032") { if ($spos > 0) { my ($i, $l); - for ($i = 0; $i <= $pagel && $spos >= 0; ) { + for ($i = 0; $i < $pagel-1 && $spos >= 0; ) { $l = measure($shistory[$spos]); $i += $l; $spos-- if $i <= $pagel; @@ -330,7 +399,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; @@ -353,13 +422,18 @@ 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); @@ -371,7 +445,8 @@ sub rec_stdin $pos++; $lth++; } elsif ($r eq "\014" || $r eq "\022") { - #do_resize(); + touchwin(curscr, 1); + refresh(curscr); return; } elsif ($r eq "\013") { $inbuf = substr($inbuf, 0, $pos); @@ -387,6 +462,46 @@ sub rec_stdin $bot->refresh(); } +sub idle_loop +{ + my $t; + + $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) { + next; + } + if (defined $ch) { + if ($ch ne '-1') { + rec_stdin($ch); + } + } + $top->refresh() if $top->is_wintouched; + $bot->refresh(); +} + +sub on_connect +{ + my $conn = shift; + $conn->send_later("A$call|$connsort width=$cols"); + $conn->send_later("I$call|set/page $maxshist"); + #$conn->send_later("I$call|set/nobeep"); +} + +sub on_disconnect +{ + $conn = shift; + Mojo::IOLoop->remove($idle); + Mojo::IOLoop->stop; +} # # deal with args @@ -394,57 +509,43 @@ 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); -if (! $conn) { - if (-r "$data/offline") { - open IN, "$data/offline" or die; - while () { - print $_; - } - close IN; - } else { - print "Sorry, the cluster $mycall is currently off-line\n"; - } - exit(0); -} +dbginit(); +unless ($DB::VERSION) { + $SIG{'INT'} = \&sig_term; + $SIG{'TERM'} = \&sig_term; +} -$SIG{'INT'} = \&sig_term; -$SIG{'TERM'} = \&sig_term; -#$SIG{'WINCH'} = \&do_resize; -$SIG{'HUP'} = 'IGNORE'; +$SIG{'HUP'} = \&sig_term; -do_initscr(); +# start up +do_resize(); $SIG{__DIE__} = \&sig_term; -$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); +$Text::Wrap::Columns = $cols; my $lastmin = 0; -for (;;) { - my $t; - Msg->event_loop(1, 1); - $t = time; - if ($t > $lasttime) { - my ($min)= (gmtime($t))[1]; - if ($min != $lastmin) { - show_screen(); - $lastmin = $min; - } - $lasttime = $t; - } - $top->refresh() if $top->is_wintouched; - $bot->refresh(); -} -exit(0); + +$conn = IntMsg->connect($clusteraddr, $clusterport, rproc => \&rec_socket); +$conn->{on_connect} = \&on_connect; +$conn->{on_disconnect} = \&on_disconnect; + +$idle = Mojo::IOLoop->recurring(0.100 => \&idle_loop); +Mojo::IOLoop->start; + + +cease(0);