X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fconsole.pl;h=663618080dc1a69e444c6251d954cfcd0177a889;hb=refs%2Fheads%2Fnew-spawn;hp=eae1c0ff4451a477af22765c3d36cfd3f00bc538;hpb=d4af9b75c46cddd2cc830961eb615975ed260a9e;p=spider.git diff --git a/perl/console.pl b/perl/console.pl index eae1c0ff..66361808 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? } +$clusteraddr = '127.0.0.1'; +$clusterport = 27754; + +use Mojo::IOLoop; + +use DXVars; +use SysVar; + use Msg; use IntMsg; -use DXVars; 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; @@ -50,6 +61,12 @@ $connsort = "local"; $khistpos = 0; $spos = $pos = $lth = 0; $inbuf = ""; +@time = (); +$lastmin = 0; +$idle = 0; + + +#$SIG{WINCH} = sub {@time = gettimeofday}; sub mydbg { @@ -79,9 +96,9 @@ 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($foreground, $background) } unless $is_win; } - + $top = $scr->subwin($lines-4, $cols, 0, 0); $top->intrflush(0); $top->scrollok(1); @@ -114,8 +131,6 @@ sub do_resize $has_colors = has_colors(); do_initscr(); - $winch = 0; - $SIG{'WINCH'} = sub {$winch = 1}; show_screen(); } @@ -224,8 +239,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(); } @@ -240,6 +263,7 @@ 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); @@ -274,7 +298,7 @@ sub rec_stdin if ($r eq KEY_ENTER || $r eq "\n" || $r eq "\r") { # save the lines - $inbuf = " " unless length($inbuf); + $inbuf = " " unless length $inbuf; # check for a pling and do a search back for a command if ($inbuf =~ /^!/o) { @@ -291,7 +315,7 @@ sub rec_stdin return; } } - push @khistory, $inbuf if $inbuf; + push @khistory, $inbuf if length $inbuf; shift @khistory if @khistory > $maxkhist; $khistpos = @khistory; $bot->move(0,0); @@ -328,7 +352,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; @@ -367,7 +391,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; @@ -393,7 +417,7 @@ sub rec_stdin } elsif ($r eq KEY_RESIZE || $r eq "\0632") { do_resize(); return; - } elsif (defined 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; @@ -430,6 +454,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 @@ -451,23 +515,6 @@ if ($call eq $mycall) { dbginit(); -$conn = IntMsg->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); -} - -$conn->set_error(sub{cease(0)}); - - unless ($DB::VERSION) { $SIG{'INT'} = \&sig_term; $SIG{'TERM'} = \&sig_term; @@ -480,38 +527,17 @@ do_resize(); $SIG{__DIE__} = \&sig_term; -$conn->send_later("A$call|$connsort width=$cols"); -$conn->send_later("I$call|set/page $maxshist"); -$conn->send_later("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, 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(); -} -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);