From c8a6bc3e45bfbbaad776f4a6f22b3e501c8fc1c9 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Sat, 4 Jul 2020 00:20:41 +0100 Subject: [PATCH] improve dbg tagging and dbgdump, Add call to conns It would appear that the $conn did not always have a callsign set on incoming connections. It does now. --- perl/DXDebug.pm | 8 +++++--- perl/DXUser.pm | 6 +++--- perl/Msg.pm | 4 +--- perl/cluster.pl | 6 +++--- 4 files changed, 12 insertions(+), 12 deletions(-) diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm index 3b2e4b2c..fcc60b86 100644 --- a/perl/DXDebug.pm +++ b/perl/DXDebug.pm @@ -119,8 +119,8 @@ sub dbg my @l = split /\n/, $r; foreach my $l (@l) { $l =~ s/([\x00-\x08\x0B-\x1f\x7f-\xff])/sprintf("%%%02X",ord($1))/eg; - print "$l\n" if defined \*STDOUT && !$no_stdout; my $tag = $_isdbg ? "($_isdbg) " : '(*) '; + print "$tag$l\n" if defined \*STDOUT && !$no_stdout; my $str = "$t^$tag$l"; &$callback($str) if $callback; if ($dbgringlth) { @@ -183,6 +183,7 @@ sub dbgdump my $l = shift; my $m = shift; if ($dbglevel{$l} || $l eq 'err') { + my @out; foreach my $l (@_) { for (my $o = 0; $o < length $l; $o += 16) { my $c = substr $l, $o, 16; @@ -190,11 +191,12 @@ sub dbgdump $c =~ s/[\x00-\x1f\x7f-\xff]/./g; my $left = 16 - length $c; $h .= ' ' x (2 * $left) if $left > 0; - dbg($m . sprintf("%4d:", $o) . "$h $c"); + push @out, $m . sprintf("%4d:", $o) . "$h $c"; $m = ' ' x (length $m); } } - } + dbg(@out) if isdbg($l); # yes, I know, I have my reasons; + } } sub dbgadd diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 1249b0b6..642649e8 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -678,7 +678,7 @@ sub wanttalk sub wantgrid { - return _want('grid', @_); + return _wantnot('grid', @_); } sub wantemail @@ -713,12 +713,12 @@ sub wantusstate sub wantdxcq { - return _want('dxcq', @_); + return _wantnot('dxcq', @_); } sub wantdxitu { - return _want('dxitu', @_); + return _wantnot('dxitu', @_); } sub wantgtk diff --git a/perl/Msg.pm b/perl/Msg.pm index 81c2e40a..3e30372f 100644 --- a/perl/Msg.pm +++ b/perl/Msg.pm @@ -345,9 +345,7 @@ sub _send_stuff my $lth = length $data; my $call = $conn->{call} || 'none'; if (isdbg('raw')) { - if (isdbg('raw')) { - dbgdump('raw', "$call send $lth: ", $lth); - } + dbgdump('raw', "$call send $lth:", $data); } if (defined $sock) { $sock->write($data); diff --git a/perl/cluster.pl b/perl/cluster.pl index bc64c5cb..bd8de8c3 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -235,7 +235,7 @@ sub new_channel $user->long($main::mylongitude); $user->qra($main::mylocator); } - $user->startt($main::systime); + $user->startt($main::systime); $conn->conns($call); $dxchan = Web->new($call, $conn, $user); $dxchan->enhanced(1); @@ -251,6 +251,7 @@ sub new_channel # is he locked out ? $user = DXUser::get_current($call); + $conn->conns($call); my $basecall = $call; $basecall =~ s/-\d+$//; # remember this for later multiple user processing my $lock; @@ -754,18 +755,17 @@ sub per_sec IsoTime::update($systime); DXCommandmode::process(); # process ongoing command mode stuff DXProt::process(); # process ongoing ak1a pcxx stuff - DXCron::process(); # do cron jobs DXXml::process(); DXConnect::process(); DXMsg::process(); DXDb::process(); DXUser::process(); DXDupe::process(); - DXCron::process(); # do cron jobs IsoTime::update($systime); DXConnect::process(); DXUser::process(); AGWMsg::process(); + DXCron::process(); # do cron jobs Timer::handler(); DXLog::flushall(); -- 2.43.0