From a26a82ebeee2135468113c64fc25c5f9ad1000cb Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Fri, 10 Dec 2021 15:38:42 +0000 Subject: [PATCH] Fix slots around the time Fill the slots around the time in the order set/dxgid, set/usstate, set/dxcq or set/dxicq --- Changes | 3 ++ cmd/set/dxcq.pl | 8 ++--- cmd/set/dxitu.pl | 8 ++--- cmd/set/usstate.pl | 16 ++++----- cmd/show/log.pl | 2 +- perl/DXChannel.pm | 2 +- perl/DXCommandmode.pm | 68 ++++++++++++++++++-------------------- perl/DXLogPrint.pm | 2 +- perl/Timer.pm | 2 ++ perl/console.pl | 12 ++++--- scripts/user_default.issue | 4 +++ 11 files changed, 68 insertions(+), 59 deletions(-) diff --git a/Changes b/Changes index 85ec11cf..bbd8c452 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,6 @@ +10Dec21======================================================================= +1. Fix the output of set/dxgrid, set/usstate and set/dxcq or set/dxitu to how + it was always supposed to be since 2003. 09Dec21======================================================================= 1. Moved isregistered to DXChannel for safety... 08Dec21======================================================================= diff --git a/cmd/set/dxcq.pl b/cmd/set/dxcq.pl index bfe40760..f3de3303 100644 --- a/cmd/set/dxcq.pl +++ b/cmd/set/dxcq.pl @@ -22,10 +22,10 @@ foreach $call (@args) { push @out, $self->msg('dxituu', $call); $user->wantdxitu(0); } - if ($user->wantusstate) { - push @out, $self->msg('usstateu', $call); - $user->wantusstate(0); - } +# if ($user->wantusstate) { +# push @out, $self->msg('usstateu', $call); +# $user->wantusstate(0); +# } $user->put; push @out, $self->msg('dxcqs', $call); } else { diff --git a/cmd/set/dxitu.pl b/cmd/set/dxitu.pl index 0e002ba7..a8fd500e 100644 --- a/cmd/set/dxitu.pl +++ b/cmd/set/dxitu.pl @@ -18,10 +18,10 @@ foreach $call (@args) { my $user = DXUser::get_current($call); if ($user) { $user->wantdxitu(1); - if ($user->wantdxcq) { - push @out, $self->msg('dxcqu', $call); - $user->wantdxcq(0); - } +# if ($user->wantdxcq) { +# push @out, $self->msg('dxcqu', $call); +# $user->wantdxcq(0); +# } if ($user->wantusstate) { push @out, $self->msg('usstateu', $call); $user->wantusstate(0); diff --git a/cmd/set/usstate.pl b/cmd/set/usstate.pl index 3babc880..af307240 100644 --- a/cmd/set/usstate.pl +++ b/cmd/set/usstate.pl @@ -20,14 +20,14 @@ foreach $call (@args) { my $user = DXUser::get_current($call); if ($user) { $user->wantusstate(1); - if ($user->wantdxitu) { - push @out, $self->msg('dxituu', $call); - $user->wantdxitu(0); - } - if ($user->wantdxcq) { - push @out, $self->msg('dxcqu', $call); - $user->wantdxcq(0); - } +# if ($user->wantdxitu) { +# push @out, $self->msg('dxituu', $call); +# $user->wantdxitu(0); +# } +# if ($user->wantdxcq) { +# push @out, $self->msg('dxcqu', $call); +# $user->wantdxcq(0); +# } $user->put; push @out, $self->msg('usstates', $call); } else { diff --git a/cmd/show/log.pl b/cmd/show/log.pl index b1023f29..ec84daa0 100644 --- a/cmd/show/log.pl +++ b/cmd/show/log.pl @@ -24,7 +24,7 @@ sub handle next if $from && $to > $from; } unless ($to) { - ($to) = $f =~ /^(\d+)$/o if !$to; # is it a to count? + ($to) = $f =~ /^(\d+)$/ if !$to; # is it a to count? next if $to; } unless ($f =~ /^\d+/) { diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 9d6b33a1..a0bc6ab9 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -770,7 +770,7 @@ sub isregistered my $self = shift; # the sysop is registered! - return 1 if $self->call eq $main::myalias || $self->call eq $main::mycall; + return 1 if $self->{call} eq $main::myalias || $self->{call} eq $main::mycall; if ($main::reqreg) { return $self->{registered}; diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 13943472..71a888bf 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -112,6 +112,7 @@ sub start $pagelth = $default_pagelth unless defined $pagelth; $self->{pagelth} = $pagelth; ($self->{width}) = $line =~ /width=(\d+)/; $line =~ s/\s*width=\d+\s*//; + $self->{enhanced} = $line =~ /\benhanced\b/; $line =~ s/\s*enhanced\s*//; if ($line =~ /host=/) { my ($h) = $line =~ /host=(\d+\.\d+\.\d+\.\d+)/; $line =~ s/\s*host=\d+\.\d+\.\d+\.\d+// if $h; @@ -124,7 +125,7 @@ sub start $self->{width} = 80 unless $self->{width} && $self->{width} > 80; $self->{consort} = $line; # save the connection type - LogDbg('DXCommand', "$call connected from $self->{hostname}"); + LogDbg('DXCommand', "$call connected from $self->{hostname} cols $self->width" . $self->{enhanced}?"enhanced":''); # set some necessary flags on the user if they are connecting $self->{beep} = $user->wantbeep; @@ -1004,40 +1005,51 @@ sub format_dx_spot my $self = shift; my $t = ztime($_[2]); - my $loc = ''; - my $clth = 30 + $self->{width} - 80; # allow comment to grow according the screen width - # --$clth if $self->{consort} eq 'local'; + my ($slot1, $slot2) = ('', ''); + my $clth = 30 + $self->{width} - 80; # allow comment to grow according the screen width my $comment = substr (($_[3] || ''), 0, $clth); $comment =~ s/\t/ /g; - $comment .= ' ' x ($clth - (length($comment))); - if ($self->{user}->wantgrid) { + if (!$slot1 && $self->{user}->wantgrid) { my $ref = DXUser::get_current($_[1]); if ($ref && $ref->qra) { - my $cloc = ' ' . substr($ref->qra, 0, 4); - $comment = substr $comment, 0, ($clth - (length($comment)+length($cloc))); - $comment .= $cloc; + $slot1 = ' ' . substr($ref->qra, 0, 4); + } + } + if (!$slot1 && $self->{user}->wantusstate) { + $slot1 = " $_[12]" if $_[12]; + } + unless ($slot1) { + if ($self->{user}->wantdxitu) { + $slot1 = sprintf(" %2d", $_[8]) if defined $_[8]; + } elsif ($self->{user}->wantdxcq) { + $slot1 = sprintf(" %2d", $_[9]) if defined $_[9]; } + } + $comment = substr($comment, 0, $clth-length($slot1)) . $slot1 if $slot1; + + if (!$slot2 && $self->{user}->wantgrid) { my $origin = $_[4]; $origin =~ s/-#$//; # sigh...... - $ref = DXUser::get_current($origin); + my $ref = DXUser::get_current($origin); if ($ref && $ref->qra) { - $loc = ' ' . substr($ref->qra, 0, 4); + $slot2 = ' ' . substr($ref->qra, 0, 4); + } + } + if (!$slot2 && $self->{user}->wantusstate) { + $slot2 = " $_[13]" if $_[13]; + } + unless ($slot2) { + if ($self->{user}->wantdxitu) { + $slot2 = sprintf(" %2d", $_[10]) if defined $_[10]; + } elsif ($self->{user}->wantdxcq) { + $slot2 = sprintf(" %2d", $_[11]) if defined $_[11]; } - } elsif ($self->{user}->wantdxitu) { - $loc = ' ' . sprintf("%2d", $_[10]) if defined $_[10]; - $comment = substr($comment, 0, $clth-3) . ' ' . sprintf("%2d", $_[8]) if defined $_[8]; - } elsif ($self->{user}->wantdxcq) { - $loc = ' ' . sprintf("%2d", $_[11]) if defined $_[11]; - $comment = substr($comment, 0, $clth-3) . ' ' . sprintf("%2d", $_[9]) if defined $_[9]; - } elsif ($self->{user}->wantusstate) { - $loc = ' ' . $_[13] if $_[13]; - $comment = substr($comment, 0, $clth-3) . ' ' . $_[12] if $_[12]; } - return sprintf "DX de %-8.8s%10.1f %-12.12s %-s $t$loc", "$_[4]:", $_[0], $_[1], $comment; + return sprintf "DX de %-8.8s%10.1f %-12.12s %-s $t$slot2", "$_[4]:", $_[0], $_[1], $comment; } @@ -1397,19 +1409,5 @@ sub user_count return ($users, $maxusers); } -sub isregistered -{ - my $self = shift; - - # the sysop is registered! - return 1 if $self->call eq $main::myalias || $self->call eq $main::mycall; - - if ($main::reqreg) { - return $self->{registered}; - } else { - return 1; - } -} - 1; __END__ diff --git a/perl/DXLogPrint.pm b/perl/DXLogPrint.pm index 0d99eb41..244402d6 100644 --- a/perl/DXLogPrint.pm +++ b/perl/DXLogPrint.pm @@ -60,7 +60,7 @@ sub print } if ($who) { $hint .= ' && ' if $hint; - $hint .= q{m{\Q$who\E}oi}; + $hint .= q{m{\Q$who\E}i}; } $hint = "next unless $hint" if $hint; $hint .= "; next unless m{^\\d+\\^$pattern\\^}" if $pattern; diff --git a/perl/Timer.pm b/perl/Timer.pm index e0f760b8..e5ffa524 100644 --- a/perl/Timer.pm +++ b/perl/Timer.pm @@ -10,6 +10,8 @@ package Timer; +use Mojo::IOLoop; + use vars qw(@timerchain $notimers $lasttime); use DXDebug; diff --git a/perl/console.pl b/perl/console.pl index c175122b..f8d95515 100755 --- a/perl/console.pl +++ b/perl/console.pl @@ -285,7 +285,7 @@ sub rec_stdin show_screen(); } - addtotop($inbuf); + addtotop(' ', $inbuf); # send it to the cluster $conn->send_later("I$call|$inbuf"); @@ -418,11 +418,13 @@ sub rec_stdin # add a line to the end of the top screen sub addtotop { + my $sort = shift; + while (@_) { my $inbuf = shift; my $l = length $inbuf; - dbg("addtotop: $l $inbuf"); - if ($l > $cols) { + dbg("addtotop: $sort $l $inbuf") if isdbg('console'); + if ($l > $cols && grep $sort eq $_, qw(T A C)) { $inbuf =~ s/\s+/ /g; if (length $inbuf > $cols) { $Text::Wrap::columns = $cols; @@ -458,7 +460,7 @@ sub rec_socket $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); + addtotop($sort, $line); } elsif ($sort && $sort eq 'Z') { # end, disconnect, go, away ..... cease(0); } @@ -503,7 +505,7 @@ sub idle_loop sub on_connect { my $conn = shift; - $conn->send_later("A$call|$connsort width=$cols"); + $conn->send_later("A$call|$connsort width=$cols enhanced"); $conn->send_later("I$call|set/page $maxshist"); #$conn->send_later("I$call|set/nobeep"); } diff --git a/scripts/user_default.issue b/scripts/user_default.issue index 0b4aaec1..9a8bde4a 100644 --- a/scripts/user_default.issue +++ b/scripts/user_default.issue @@ -4,5 +4,9 @@ blank + sh/dx 5 blank - +sh/u +blank - sh/wwv 1 +blank - +sh/wcy 1 blank + -- 2.34.1