X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;ds=sidebyside;f=perl%2Fconsole.pl;h=4ba23d43502e7aefe0de3fe0abb65b3fa9d0aa60;hb=6e858487b4db7054748d3d82830249bb134265b4;hp=4dba480b03ea56b19d60b8d68a89b382a9d6cabe;hpb=21ee7b1845f8fc5ab10c6a33a058cfbd11d7a705;p=spider.git diff --git a/perl/console.pl b/perl/console.pl index 4dba480b..4ba23d43 100755 --- a/perl/console.pl +++ b/perl/console.pl @@ -10,7 +10,7 @@ # # Copyright (c) 1999 Dirk Koopman G1TLH # -# $Id$ +# # require 5.004; @@ -23,8 +23,12 @@ 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 strict; + +use AnyEvent; use Msg; use IntMsg; use DXVars; @@ -32,24 +36,44 @@ use DXDebug; use DXUtil; use DXDebug; use IO::File; +use Time::HiRes qw(gettimeofday tv_interval); use Curses 1.06; +use Text::Wrap; use Console; +use vars qw($maxkhist $maxshist $foreground $background $mycallcolor @colors ); + # # initialisation # -$call = ""; # the callsign being used -$conn = 0; # the connection object for the cluster -$lasttime = time; # lasttime something happened on the interface +my $call = ""; # the callsign being used +my $conn = 0; # the connection object for the cluster +my $lasttime = time; # lasttime something happened on the interface + +my $connsort = "local"; +my @khistory = (); +my @shistory = (); +my $khistpos = 0; +my $pos; +my $lth; +my $bot; +my $top; +my $pagel = 25; +my $cols = 80; +my $lines = 25; +my $scr; +my $spos = $pos = $lth = 0; +my $inbuf = ""; +my @time = (); + +my $lastmin = 0; +my $sigint; +my $sigterm; +my $decease; -$connsort = "local"; -@khistory = (); -@shistory = (); -$khistpos = 0; -$spos = $pos = $lth = 0; -$inbuf = ""; +#$SIG{WINCH} = sub {@time = gettimeofday}; sub mydbg { @@ -61,16 +85,16 @@ sub mydbg sub do_initscr { $scr = new Curses; - if ($has_colors) { + if ($main::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("0", $main::foreground, $main::background); +# init_pair(0, $main::background, $main::foreground); + init_pair(1, COLOR_RED, $main::background); + init_pair(2, COLOR_YELLOW, $main::background); + init_pair(3, COLOR_GREEN, $main::background); + init_pair(4, COLOR_CYAN, $main::background); + init_pair(5, COLOR_BLUE, $main::background); + init_pair(6, COLOR_MAGENTA, $main::background); init_pair(7, COLOR_RED, COLOR_BLUE); init_pair(8, COLOR_YELLOW, COLOR_BLUE); init_pair(9, COLOR_GREEN, COLOR_BLUE); @@ -79,17 +103,19 @@ sub do_initscr 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) }; + eval { assume_default_colors($main::foreground, $main::background) } unless $main::is_win; } - + $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); @@ -106,23 +132,32 @@ sub do_resize initscr(); raw(); noecho(); - $lines = LINES; + nonl(); + $lines = LINES; $cols = COLS; - $has_colors = has_colors(); + $main::has_colors = has_colors(); do_initscr(); - $winch = 0; - $SIG{'WINCH'} = sub {$winch = 1}; show_screen(); } +my $ceasing = 0; + # cease communications sub cease { my $sendz = shift; + + print "ceasing ($ceasing)\r\n"; + + return if $ceasing; + ++$ceasing; + $conn->disconnect if $conn; - endwin(); dbgclose(); + endwin(); + $decease->send; + print @_ if @_; exit(0); } @@ -136,7 +171,7 @@ sub sig_term # determine the colour of the line sub setattr { - if ($has_colors) { + if ($main::has_colors) { foreach my $ref (@colors) { if ($_[0] =~ m{$$ref[0]}) { $top->attrset($$ref[1]); @@ -168,7 +203,8 @@ sub show_screen $top->addstr("\n") if $spos > 0; setattr($line); $top->addstr($line); - $top->attrset(COLOR_PAIR(0)) if $has_colors; +# $top->addstr("\n"); + $top->attrset(COLOR_PAIR(0)) if $main::has_colors; $spos = @shistory; } else { @@ -184,15 +220,16 @@ sub show_screen $p = 0 if $p < 0; $top->move(0, 0); - $top->attrset(COLOR_PAIR(0)) if $has_colors; + $top->attrset(COLOR_PAIR(0)) if $main::has_colors; $top->clrtobot(); for ($i = 0; $i < $pagel && $p < @shistory; $p++) { my $line = $shistory[$p]; my $lines = measure($line); last if $i + $lines > $pagel; + $top->addstr("\n") if $i; setattr($line); - $top->addstr($i, 0, $line); - $top->attrset(COLOR_PAIR(0)) if $has_colors; + $top->addstr($line); + $top->attrset(COLOR_PAIR(0)) if $main::has_colors; $i += $lines; } $spos = $p; @@ -206,9 +243,9 @@ sub show_screen $scr->addstr($lines-4, 0, $str); $scr->addstr($size); - $scr->attrset($mycallcolor) if $has_colors; + $scr->attrset($mycallcolor) if $main::has_colors; $scr->addstr($call); - $scr->attrset(COLOR_PAIR(0)) if $has_colors; + $scr->attrset(COLOR_PAIR(0)) if $main::has_colors; $scr->addstr($add); $scr->refresh(); # $top->refresh(); @@ -219,8 +256,16 @@ sub addtotop { while (@_) { my $inbuf = shift; - push @shistory, $inbuf; - shift @shistory if @shistory > $maxshist; + 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(); } @@ -235,7 +280,9 @@ sub rec_socket if (defined $msg) { my ($sort, $call, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/; + $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); @@ -263,43 +310,43 @@ sub rec_stdin # 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; @@ -322,7 +369,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; @@ -361,7 +408,7 @@ sub rec_stdin $pos = 0; } elsif ($r eq KEY_END || $r eq "\005") { $pos = $lth; - } elsif ($r eq KEY_BACKSPACE || $r eq "\010" || $r eq "\0177") { + } 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; @@ -387,7 +434,7 @@ sub rec_stdin } elsif ($r eq KEY_RESIZE || $r eq "\0632") { do_resize(); return; - } elsif (is_pctext($r)) { + } elsif (defined $r && is_pctext($r)) { # move the top screen back to the bottom if you type something if ($spos < @shistory) { $spos = @shistory; @@ -424,13 +471,39 @@ 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) { +# mydbg("Got Resize"); +# do_resize(); + next; + } + if (defined $ch) { + if ($ch ne '-1') { + rec_stdin($ch); + } + } + $top->refresh() if $top->is_wintouched; + $bot->refresh(); +} # # deal with args # $call = uc shift @ARGV if @ARGV; -$call = uc $myalias if !$call; +$call = uc $main::myalias if !$call; my ($scall, $ssid) = split /-/, $call; $ssid = undef unless $ssid && $ssid =~ /^\d+$/; if ($ssid) { @@ -438,74 +511,57 @@ if ($ssid) { $call = "$scall-$ssid"; } -if ($call eq $mycall) { - print "You cannot connect as your cluster callsign ($mycall)\n"; +if ($call eq $main::mycall) { + print "You cannot connect as your cluster callsign ($main::mycall)\n"; exit(0); } +# create end condvar +$decease = AnyEvent->condvar; + dbginit(); -$conn = IntMsg->connect("$clusteraddr", $clusterport, \&rec_socket); +$conn = IntMsg->connect("$main::clusteraddr", $main::clusterport, \&rec_socket); if (! $conn) { - if (-r "$data/offline") { - open IN, "$data/offline" or die; + if (-r "$main::root/data/offline") { + open IN, "$main::root/data/offline" or die; while () { print $_; } close IN; } else { - print "Sorry, the cluster $mycall is currently off-line\n"; + print "Sorry, the cluster $main::mycall is currently off-line\n"; } exit(0); } -$conn->set_error(sub{cease(0)}); - unless ($DB::VERSION) { - $SIG{'INT'} = \&sig_term; - $SIG{'TERM'} = \&sig_term; + $sigint = AnyEvent->signal(signal=>'INT', cb=> sub{$decease->send}); + $sigterm = AnyEvent->signal(signal=>'TERM', cb=> sub{$decease->send}); } -$SIG{'HUP'} = \&sig_term; +#$SIG{'HUP'} = \&sig_term; +my $sighup = AnyEvent->signal(signal=>'HUP', cb=> sub{$decease->send}); +$conn->{sock}->on_eof(sub{$decease->send}); +$conn->{sock}->on_error(sub{$decease->send}); # start up do_resize(); -$SIG{__DIE__} = \&sig_term; +#$SIG{__DIE__} = \&sig_term; +#my $sigdie = AnyEvent->signal(signal=>'__DIE__', cb=> sub{$decease->send}); $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_later("I$call|set/nobeep"); #Msg->set_event_handler(\*STDIN, "read" => \&rec_stdin); -my $lastmin = 0; -for (;;) { - my $t; - 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 ($winch) { -# mydbg("Got Resize"); -# do_resize(); - next; - } - if (defined $ch) { - if ($ch ne '-1') { - rec_stdin($ch); - } - } - $top->refresh() if $top->is_wintouched; - $bot->refresh(); -} +$Text::Wrap::Columns = $cols; + +my $event_loop = AnyEvent->timer(after => 0, interval => 0.010, cb => sub{idle_loop()}); + +$decease->recv; -exit(0); +cease(0);