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.

diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm
index 3b2e4b2cc222cbbd7378c4154f8815127bc409a4..fcc60b86ded201972dbe8b9d7c7dd74a03f8b4ad 100644 (file)
--- 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 1249b0b69f8842f323d13ff245a68774fcc7e452..642649e844e45567d07557f7a9f8630dbaf43d45 100644 (file)
--- 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 81c2e40a0090aa09ecdeba30e94dd01ae6cd70a6..3e30372ff1111bbac4923b6837c5a01618d8d620 100644 (file)
--- 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 bc64c5cb0cb03889039b843fdb2ba709d673031f..bd8de8c3c2229ffc1195819680063ae06b0e28ec 100755 (executable)
--- 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();