]> dxcluster.net Git - spider.git/commitdiff
changed debug api interface to use less CPU
authorminima <minima>
Thu, 14 Jun 2001 15:44:16 +0000 (15:44 +0000)
committerminima <minima>
Thu, 14 Jun 2001 15:44:16 +0000 (15:44 +0000)
24 files changed:
Changes
cmd/export.pl
cmd/show/qrz.pl
perl/AGWMsg.pm
perl/DXChannel.pm
perl/DXCluster.pm
perl/DXCommandmode.pm
perl/DXCron.pm
perl/DXDebug.pm
perl/DXHash.pm
perl/DXLog.pm
perl/DXMsg.pm
perl/DXProt.pm
perl/DXUser.pm
perl/ExtMsg.pm
perl/Filter.pm
perl/Msg.pm
perl/Route.pm
perl/Route/Node.pm
perl/Route/User.pm
perl/Spot.pm
perl/Timer.pm
perl/cluster.pl
perl/connect.pl

diff --git a/Changes b/Changes
index a62ab090b21800ff5cdf0a80cf6019b7dbf2f18f..798a2909a2296cb7c129c3076086e7a952558d61 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,5 @@
+14Jun01=======================================================================
+1. changed debug api to (potentially) use less cpu time
 13Jun01=======================================================================
 1. fix init cnd rinit cmds
 2. add missing clear/route cmd
index 723cdcb6ea33ed3ff9ec5d1cdfd3d0f989fef0f2..4616564fd104e2948236aee31d409d538e880150 100644 (file)
@@ -25,7 +25,7 @@ return (1, $self->msg('read2', $msgno)) unless $ref;
 if (-e $fn) {
        my $m = $self->msg('e16', $fn);
        Log('msg', $self->call . " tried to export $m");
-       dbg('msg', $m);
+       dbg($m) if isdbg('msg');
        return (1, $m);
 }
 
index 6779db42cbe32375d04f255402bf13fba7ced39d..c20be45deeb06f2c9f636145d3daee4ad8997ed6 100644 (file)
@@ -29,7 +29,7 @@ foreach $l (@list) {
                Log('call', "$call: show/qrz \U$l");
                my $state = "blank";
                while (my $result = $t->getline) {
-                       dbg('qrz', $result);
+                       dbg($result) if isdbg('qrz');
                        if ($state eq 'blank' && $result =~ /^\s*Callsign\s*:/i) {
                                $state = 'go';
                        } elsif ($state eq 'go') {
index a3253a5e44957e8af30cdd4a5bd6debd5e3d0def..2e74da7be3005c48fd22b4cf2ed43121ec801436 100644 (file)
@@ -50,10 +50,10 @@ sub init
        $rproc = shift;
        
        finish();
-       dbg('err', "AGW initialising and connecting to $addr/$port ...");
+       dbg("AGW initialising and connecting to $addr/$port ...");
        $sock = IO::Socket::INET->new(PeerAddr => $addr, PeerPort => $port, Proto=>'tcp', Timeout=>15);
        unless ($sock) {
-               dbg('err', "Cannot connect to AGW Engine at $addr/$port $!");
+               dbg("Cannot connect to AGW Engine at $addr/$port $!");
                return;
        }
        Msg::blocking($sock, 0);
@@ -83,7 +83,7 @@ sub finish
        return if $finishing;
        if ($sock) {
                $finishing = 1;
-               dbg('err', "AGW ending...");
+               dbg("AGW ending...");
                for (values %circuit) {
                        &{$_->{eproc}}() if $_->{eproc};
                        $_->disconnect;
@@ -114,15 +114,15 @@ sub _sendf
        
        $len = length $data; 
        if ($sort eq 'y' || $sort eq 'H') {
-               dbg('agwpoll', "AGW sendf: $sort '${from}'->'${to}' port: $port pid: $pid \"$data\"");
+               dbg("AGW sendf: $sort '${from}'->'${to}' port: $port pid: $pid \"$data\"") if isdbg('agwpoll');
        } elsif ($sort eq 'D') {
                if (isdbg('agw')) {
                        my $d = $data;
                        $d =~ s/\cM$//;
-                       dbg('agw', "AGW sendf: $sort '${from}'->'${to}' port: $port pid: $pid \"$d\"");
+                       dbg("AGW sendf: $sort '${from}'->'${to}' port: $port pid: $pid \"$d\"") if isdbg('agw');
                }
        } else {
-               dbg('agw', "AGW sendf: $sort '${from}'->'${to}' port: $port pid: $pid \"$data\"");
+               dbg("AGW sendf: $sort '${from}'->'${to}' port: $port pid: $pid \"$data\"") if isdbg('agw');
        }
        push @outqueue, pack('C x3 a1 x1 C x1 a10 a10 V x4 a*', $port, $sort, $pid, $from, $to, $len, $data);
        Msg::set_event_handler($sock, write=>\&_send);
@@ -213,7 +213,7 @@ FINISH:
 
 sub _error
 {
-       dbg('err', "error on AGW connection $addr/$port $!");
+       dbg("error on AGW connection $addr/$port $!");
        Msg::set_event_handler($sock, read=>undef, write=>undef, error=>undef);
        $sock = undef;
        for (%circuit) {
@@ -233,7 +233,7 @@ sub _decode
        
                # do a sanity check on the length
                if ($len > 2000) {
-                       dbg('err', "AGW: invalid length $len > 2000 received ($sort $port $pid '$from'->'$to')");
+                       dbg("AGW: invalid length $len > 2000 received ($sort $port $pid '$from'->'$to')");
                        finish();
                        return;
                }
@@ -261,13 +261,13 @@ sub _decode
                if ($sort eq 'D') {
                        my $d = unpack "Z*", $data;
                        $d =~ s/\cM$//;
-                       dbg('agw', "AGW Data In port: $port pid: $pid '$from'->'$to' length: $len \"$d\"");
+                       dbg("AGW Data In port: $port pid: $pid '$from'->'$to' length: $len \"$d\"") if isdbg('agw');
                        my $conn = _find($from eq $main::mycall ? $to : $from);
                        if ($conn) {
                                if ($conn->{state} eq 'WC') {
                                        if (exists $conn->{cmd}) {
                                                if (@{$conn->{cmd}}) {
-                                                       dbg('connect', $d);
+                                                       dbg($d) if isdbg('connect');
                                                        $conn->_docmd($d);
                                                }
                                        }
@@ -285,7 +285,7 @@ sub _decode
                                        }
                                }
                        } else {
-                               dbg('err', "AGW error Unsolicited Data!");
+                               dbg("AGW error Unsolicited Data!");
                        }
                } elsif ($sort eq 'I' || $sort eq 'S' || $sort eq 'U' || $sort eq 'M' || $sort eq 'T') {
                        my $d = unpack "Z*", $data;
@@ -294,12 +294,12 @@ sub _decode
                        
                        for (@lines) {
                                s/([\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg; 
-                               dbg('agw', "AGW Monitor port: $port \"$_\"");
+                               dbg("AGW Monitor port: $port \"$_\"") if isdbg('agw');
                        }
                } elsif ($sort eq 'C') {
                        my $d = unpack "Z*", $data;
                        $d =~ s/\cM$//;
-                       dbg('agw', "AGW Connect port: $port pid: $pid '$from'->'$to' \"$d\"");
+                       dbg("AGW Connect port: $port pid: $pid '$from'->'$to' \"$d\"") if isdbg('agw');
                        my $call = $from eq $main::mycall ? $to : $from;
                        my $conn = _find($call);
                        if ($conn) {
@@ -334,7 +334,7 @@ sub _decode
                } elsif ($sort eq 'd') {
                        my $d = unpack "Z*", $data;
                        $d =~ s/\cM$//;
-                       dbg('agw', "AGW '$from'->'$to' port: $port Disconnected ($d)");
+                       dbg("AGW '$from'->'$to' port: $port Disconnected ($d)") if isdbg('agw');
                        my $conn = _find($from eq $main::mycall ? $to : $from);
                        if ($conn) {
                                &{$conn->{eproc}}() if $conn->{eproc};
@@ -342,36 +342,36 @@ sub _decode
                        }
                } elsif ($sort eq 'y') {
                        my ($frames) = unpack "V", $data;
-                       dbg('agwpollans', "AGW Frames Outstanding on port $port = $frames");
+                       dbg("AGW Frames Outstanding on port $port = $frames") if isdbg('agwpollans');
                        my $conn = _find($from);
                        $conn->{oframes} = $frames if $conn;
                } elsif ($sort eq 'Y') {
                        my ($frames) = unpack "V", $data;
-                       dbg('agw', "AGW Frames Outstanding on circuit '$from'->'$to' = $frames");
+                       dbg("AGW Frames Outstanding on circuit '$from'->'$to' = $frames") if isdbg('agw');
                        my $conn = _find($from eq $main::mycall ? $to : $from);
                        $conn->{oframes} = $frames if $conn;
                } elsif ($sort eq 'H') {
                        unless ($from =~ /^\s+$/) {
                                my $d = unpack "Z*", $data;
                                $d =~ s/\cM$//;
-                               dbg('agw', "AGW Heard port: $port \"$d\"");
+                               dbg("AGW Heard port: $port \"$d\"") if isdbg('agw');
                        }
                } elsif ($sort eq 'X') {
                        my ($r) = unpack "C", $data;
                        $r = $r ? "Successful" : "Failed";
-                       dbg('err', "AGW Register $from $r");
+                       dbg("AGW Register $from $r");
                        finish() unless $r;
                } elsif ($sort eq 'R') {
                        my ($major, $minor) = unpack "v x2 v x2", $data;
-                       dbg('agw', "AGW Version $major.$minor");
+                       dbg("AGW Version $major.$minor") if isdbg('agw');
                } elsif ($sort eq 'G') {
                        my @ports = split /;/, $data;
                        $noports = shift @ports || '0';
-                       dbg('agw', "AGW $noports Ports available");
+                       dbg("AGW $noports Ports available") if isdbg('agw');
                        pop @ports while @ports > $noports;
                        for (@ports) {
                                next unless $_;
-                               dbg('agw', "AGW Port: $_");
+                               dbg("AGW Port: $_") if isdbg('agw');
                        }
                        for (my $i = 0; $i < $noports; $i++) {
                                _sendf('y', undef, undef, $i);
@@ -379,7 +379,7 @@ sub _decode
                        }
                } else {
                        my $d = unpack "Z*", $data;
-                       dbg('agw', "AGW decode $sort port: $port pid: $pid '$from'->'$to' length: $len \"$d\"");
+                       dbg("AGW decode $sort port: $port pid: $pid '$from'->'$to' length: $len \"$d\"") if isdbg('agw');
                }
        }
 }
@@ -436,7 +436,7 @@ sub enqueue
 #              _sendf('Y', $main::mycall, $conn->{call}, $conn->{agwport}, $conn->{agwpid});
                _sendf('D', $main::mycall, $conn->{agwcall}, $conn->{agwport}, $conn->{agwpid}, $msg . $conn->{lineend});
                my $len = length($msg) + 1; 
-               dbg('agw', "AGW Data Out port: $conn->{agwport} pid: $conn->{agwpid} '$main::mycall'->'$conn->{agwcall}' length: $len \"$msg\"");
+               dbg("AGW Data Out port: $conn->{agwport} pid: $conn->{agwpid} '$main::mycall'->'$conn->{agwcall}' length: $len \"$msg\"") if isdbg('agw');
        }
 }
 
index e702222267a6b12e404c6d5647add1deb9b40d89..f1e711e07d75cc3d1431818d0532f4bbbbbe9579 100644 (file)
@@ -110,7 +110,7 @@ sub DESTROY
                        delete $self->{$_};
                }
        }
-       dbg('chan', "DXChannel $self->{call} destroyed ($count)");
+       dbg("DXChannel $self->{call} destroyed ($count)") if isdbg('chan');
        $count--;
 }
 
@@ -146,7 +146,7 @@ sub alloc
        }
 
        $count++;
-       dbg('chan', "DXChannel $self->{call} created ($count)");
+       dbg("DXChannel $self->{call} created ($count)") if isdbg('chan');
        bless $self, $pkg; 
        return $channels{$call} = $self;
 }
@@ -297,7 +297,7 @@ sub send_now
         my @lines = split /\n/;
                for (@lines) {
                        $conn->send_now("$sort$call|$_");
-                       dbg('chan', "-> $sort $call $_");
+                       dbg("-> $sort $call $_") if isdbg('chan');
                }
        }
        $self->{t} = time;
@@ -318,7 +318,7 @@ sub send                                            # this is always later and always data
         my @lines = split /\n/;
                for (@lines) {
                        $conn->send_later("D$call|$_");
-                       dbg('chan', "-> D $call $_");
+                       dbg("-> D $call $_") if isdbg('chan');
                }
        }
        $self->{t} = time;
@@ -366,7 +366,7 @@ sub state
                $self->{oldstate} = $self->{state};
                $self->{state} = shift;
                $self->{func} = '' unless defined $self->{func};
-               dbg('state', "$self->{call} channel func $self->{func} state $self->{oldstate} -> $self->{state}\n");
+               dbg("$self->{call} channel func $self->{func} state $self->{oldstate} -> $self->{state}\n") if isdbg('state');
 
                # if there is any queued up broadcasts then splurge them out here
                if ($self->{delayed} && ($self->{state} eq 'prompt' || $self->{state} eq 'talk')) {
@@ -453,12 +453,12 @@ sub decode_input
        # the above regexp must work
        unless (defined $sort && defined $call && defined $line) {
 #              $data =~ s/([\x00-\x1f\x7f-\xff])/uc sprintf("%%%02x",ord($1))/eg;
-               dbg('err', "DUFF Line on $chcall: $data");
+               dbg("DUFF Line on $chcall: $data") if isdbg('err');
                return ();
        }
 
        if(ref($dxchan) && $call ne $chcall) {
-               dbg('err', "DUFF Line come in for $call on wrong channel $chcall" );
+               dbg("DUFF Line come in for $call on wrong channel $chcall") if isdbg('err');
                return();
        }
        
index 1b81065477c4c9daf5be1c55a4aa5d9e6b07570d..36d1d20f9db5e20e5d09a75a5dabbde5d078342c 100644 (file)
@@ -155,7 +155,7 @@ sub mynode
                unless ($noderef) {
                        my $mynode = $self->{mynode};
                        my $call = $self->{call};
-                       dbg('err', "parent node $mynode has disappeared from $call" );
+                       dbg("parent node $mynode has disappeared from $call") if isdbg('err');
                }
        }
        return $noderef;
@@ -173,7 +173,7 @@ sub dxchan
                unless ($dxchan) {
                        my $dxcall = $self->{dxchancall};
                        my $call = $self->{call};
-                       dbg('err', "parent dxchan $dxcall has disappeared from $call" );
+                       dbg("parent dxchan $dxcall has disappeared from $call") if isdbg('err');
                }
        }
        return $dxchan;
@@ -216,7 +216,7 @@ sub new
        my $self = $pkg->alloc($dxchan, $call, $confmode, $here);
        $self->{mynode} = $node->call;
        $node->add_user($call, $self);
-       dbg('cluster', "allocating user $call to $node->{call} in cluster\n");
+       dbg("allocating user $call to $node->{call} in cluster\n") if isdbg('cluster');
        return $self;
 }
 
@@ -227,7 +227,7 @@ sub del
        my $node = $self->mynode;
 
        $node->del_user($call);
-       dbg('cluster', "deleting user $call from $node->{call} in cluster\n");
+       dbg("deleting user $call from $node->{call} in cluster\n") if isdbg('cluster');
 }
 
 sub count
@@ -264,7 +264,7 @@ sub new
        $self->{mynode} = $self->call;  # for sh/station
        $self->{users} = 0;
        $nodes++;
-       dbg('cluster', "allocating node $call to cluster\n");
+       dbg("allocating node $call to cluster\n") if isdbg('cluster');
        return $self;
 }
 
@@ -290,7 +290,7 @@ sub del
                $ref->del();                    # this also takes them out of this list
        }
        delete $DXCluster::cluster{$call}; # remove me from the cluster table
-       dbg('cluster', "deleting node $call from cluster\n"); 
+       dbg("deleting node $call from cluster\n") if isdbg('cluster'); 
        $users -= $self->{users};    # it may be PC50 updated only therefore > 0
        $users = 0 if $users < 0;
        $nodes--;
index 9dc967b6d1a85e43cc353fc64c8317d5d50ecc18..32b1f86c4cade33ca79f84a633b43d2f5f2aec99 100644 (file)
@@ -288,7 +288,7 @@ sub run_cmd
        
        if ($self->{func}) {
                my $c = qq{ \@ans = $self->{func}(\$self, \$cmdline) };
-               dbg('eval', "stored func cmd = $c\n");
+               dbg("stored func cmd = $c\n") if isdbg('eval');
                eval  $c;
                if ($@) {
                        return ("Syserr: Eval err $errstr on stored func $self->{func}", $@);
@@ -308,14 +308,14 @@ sub run_cmd
                        
                        my ($path, $fcmd);
                        
-                       dbg('command', "cmd: $cmd");
+                       dbg("cmd: $cmd") if isdbg('command');
                        
                        # alias it if possible
                        my $acmd = CmdAlias::get_cmd($cmd);
                        if ($acmd) {
                                ($cmd, $args) = split /\s+/, "$acmd $args", 2;
                                $args = "" unless defined $args;
-                               dbg('command', "aliased cmd: $cmd $args");
+                               dbg("aliased cmd: $cmd $args") if isdbg('command');
                        }
                        
                        # first expand out the entry to a command
@@ -323,13 +323,13 @@ sub run_cmd
                        ($path, $fcmd) = search($main::cmd, $cmd, "pl") if !$path || !$fcmd;
 
                        if ($path && $cmd) {
-                               dbg('command', "path: $cmd cmd: $fcmd");
+                               dbg("path: $cmd cmd: $fcmd") if isdbg('command');
                        
                                my $package = find_cmd_name($path, $fcmd);
                                @ans = (0) if !$package ;
                                
                                if ($package) {
-                                       dbg('command', "package: $package");
+                                       dbg("package: $package") if isdbg('command');
                                        my $c;
                                        unless (exists $Cache{$package}->{'sub'}) {
                                                $c = eval $Cache{$package}->{'eval'};
@@ -349,7 +349,7 @@ sub run_cmd
                                        };
                                }
                        } else {
-                               dbg('command', "cmd: $cmd not found");
+                               dbg("cmd: $cmd not found") if isdbg('command');
                                if (++$self->{errors} > $maxerrors) {
                                        $self->send($self->msg('e26'));
                                        $self->disconnect;
@@ -409,7 +409,7 @@ sub disconnect
        }
 
        my @rout = $main::routeroot->del_user($call);
-       dbg('route', "B/C PC17 on $main::mycall for: $call");
+       dbg("B/C PC17 on $main::mycall for: $call") if isdbg('route');
 
        # issue a pc17 to everybody interested
        DXProt::route_pc17($DXProt::me, $main::routeroot, @rout) if @rout;
@@ -484,7 +484,7 @@ sub search
        
        # commands are lower case
        $short_cmd = lc $short_cmd;
-       dbg('command', "command: $path $short_cmd\n");
+       dbg("command: $path $short_cmd\n") if isdbg('command');
 
        # do some checking for funny characters
        return () if $short_cmd =~ /\/$/;
@@ -492,7 +492,7 @@ sub search
        # return immediately if we have it
        ($apath, $acmd) = split ',', $cmd_cache{$short_cmd} if $cmd_cache{$short_cmd};
        if ($apath && $acmd) {
-               dbg('command', "cached $short_cmd = ($apath, $acmd)\n");
+               dbg("cached $short_cmd = ($apath, $acmd)\n") if isdbg('command');
                return ($apath, $acmd);
        }
        
@@ -514,7 +514,7 @@ sub search
                        next if $l =~ /^\./;
                        if ($i < $#parts) {             # we are dealing with directories
                                if ((-d "$curdir/$l") && $p eq substr($l, 0, length $p)) {
-                                       dbg('command', "got dir: $curdir/$l\n");
+                                       dbg("got dir: $curdir/$l\n") if isdbg('command');
                                        $dirfn .= "$l/";
                                        $curdir .= "/$l";
                                        last;
@@ -528,7 +528,7 @@ sub search
                                        #                 chop $dirfn;               # remove trailing /
                                        $dirfn = "" unless $dirfn;
                                        $cmd_cache{"$short_cmd"} = join(',', ($path, "$dirfn$l")); # cache it
-                                       dbg('command', "got path: $path cmd: $dirfn$l\n");
+                                       dbg("got path: $path cmd: $dirfn$l\n") if isdbg('command');
                                        return ($path, "$dirfn$l"); 
                                }
                        }
@@ -627,7 +627,7 @@ sub find_cmd_name {
                        my @list = split /\n/, $eval;
                        my $line;
                        for (@list) {
-                               dbg('eval', $_, "\n");
+                               dbg($_ . "\n") if isdbg('eval');
                        }
                }
                
index 39776dccde4094ccfe6814568c185e58ff77c187..589dd246af98fc5be08a119b8f39ec03c12cf6e3 100644 (file)
@@ -60,7 +60,7 @@ sub cread
        my $fh = new IO::File;
        my $line = 0;
 
-       dbg('cron', "cron: reading $fn\n");
+       dbg("cron: reading $fn\n") if isdbg('cron');
        open($fh, $fn) or confess("cron: can't open $fn $!");
        while (<$fh>) {
                $line++;
@@ -79,9 +79,9 @@ sub cread
                if (!$err) {
                        $ref->{cmd} = $cmd;
                        push @crontab, $ref;
-                       dbg('cron', "cron: adding $_\n");
+                       dbg("cron: adding $_\n") if isdbg('cron');
                } else {
-                       dbg('cron', "cron: error on line $line '$_'\n");
+                       dbg("cron: error on line $line '$_'\n") if isdbg('cron');
                }
        }
        close($fh);
@@ -147,9 +147,9 @@ sub process
                                (!$cron->{wday} || grep $_ eq $wday, @{$cron->{wday}})  ){
                                
                                if ($cron->{cmd}) {
-                                       dbg('cron', "cron: $min $hour $mday $mon $wday -> doing '$cron->{cmd}'");
+                                       dbg("cron: $min $hour $mday $mon $wday -> doing '$cron->{cmd}'") if isdbg('cron');
                                        eval "$cron->{cmd}";
-                                       dbg('cron', "cron: cmd error $@") if $@;
+                                       dbg("cron: cmd error $@") if $@ && isdbg('cron');
                                }
                        }
                }
@@ -258,11 +258,11 @@ sub spawn
                                $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = $SIG{__WARN__} = 'DEFAULT';
                                alarm(0);
                        }
-                       exec "$line" or dbg('cron', "exec '$line' failed $!");
+                       exec "$line" or dbg("exec '$line' failed $!") if isdbg('cron');
                }
-               dbg('cron', "spawn of $line started");
+               dbg("spawn of $line started") if isdbg('cron');
        } else {
-               dbg('cron', "can't fork for $line $!");
+               dbg("can't fork for $line $!") if isdbg('cron');
        }
 
        # coordinate
@@ -287,10 +287,10 @@ sub run_cmd
 {
        my $line = shift;
        my @in = DXCommandmode::run_cmd($DXProt::me, $line);
-       dbg('cron', "cmd run: $line");
+       dbg("cmd run: $line") if isdbg('cron');
        for (@in) {
                s/\s*$//og;
-               dbg('cron', "cmd out: $_");
+               dbg("cmd out: $_") if isdbg('cron');
        }
 }
 1;
index 2cbdc2956e937b2e64fce2bf12354f271a37cdab..4b8d4f250575ed198ec5357db1ba7b88c2dd3a8e 100644 (file)
@@ -11,7 +11,7 @@ package DXDebug;
 
 require Exporter;
 @ISA = qw(Exporter);
-@EXPORT = qw(dbginit dbgstore dbg dbgadd dbgsub dbglist dbgdump isdbg dbgclose confess croak cluck);
+@EXPORT = qw(dbginit dbg dbgadd dbgsub dbglist dbgdump isdbg dbgclose confess croak cluck);
 
 use strict;
 use vars qw(%dbglevel $fp);
@@ -29,16 +29,18 @@ if (!defined $DB::VERSION) {
        local $^W=0;
        eval qq( sub confess { 
            \$SIG{__DIE__} = 'DEFAULT'; 
-        DXDebug::dbgstore(\$@, Carp::shortmess(\@_));
+        DXDebug::dbg(\$@);
+               DXDebug::dbg(Carp::shortmess(\@_));
            exit(-1); 
        }
        sub croak { 
                \$SIG{__DIE__} = 'DEFAULT'; 
-        DXDebug::dbgstore(\$@, Carp::longmess(\@_));
+        DXDebug::dbg(\$@);
+               DXDebug::dbg(Carp::longmess(\@_));
                exit(-1); 
        }
-       sub carp    { DXDebug::dbgstore(Carp::shortmess(\@_)); }
-       sub cluck   { DXDebug::dbgstore(Carp::longmess(\@_)); } 
+       sub carp    { DXDebug::dbg(Carp::shortmess(\@_)); }
+       sub cluck   { DXDebug::dbg(Carp::longmess(\@_)); } 
        );
 
     CORE::die(Carp::shortmess($@)) if $@;
@@ -51,8 +53,9 @@ if (!defined $DB::VERSION) {
 } 
 
 
-sub dbgstore
+sub dbg($)
 {
+       return unless $fp;
        my $t = time; 
        for (@_) {
                my $r = $_;
@@ -72,14 +75,16 @@ sub dbginit
        if (!defined $DB::VERSION) {
                $SIG{__WARN__} = sub { 
                        if ($_[0] =~ /Deep\s+recursion/i) {
-                               dbgstore($@, Carp::longmess(@_)); 
+                               dbg($@);
+                               dbg(Carp::longmess(@_)); 
                                CORE::die;
                        } else { 
-                               dbgstore($@, Carp::shortmess(@_));
+                               dbg($@);
+                               dbg(Carp::shortmess(@_));
                        }
                };
                
-               $SIG{__DIE__} = sub { dbgstore($@, Carp::longmess(@_)); };
+               $SIG{__DIE__} = sub { dbg($@); dbg(Carp::longmess(@_)); };
        }
 
        $fp = DXLog::new('debug', 'dat', 'd');
@@ -92,14 +97,6 @@ sub dbgclose
        undef $fp;
 }
 
-sub dbg
-{
-       my $l = shift;
-       if ($fp && ($dbglevel{$l} || $l eq 'err')) {
-           dbgstore(@_);
-       }
-}
-
 sub dbgdump
 {
        my $l = shift;
@@ -112,7 +109,7 @@ sub dbgdump
                                $c =~ s/[\x00-\x1f\x7f-\xff]/./g;
                                my $left = 16 - length $c;
                                $h .= ' ' x (2 * $left) if $left > 0;
-                               dbgstore($m . sprintf("%4d:", $o) . "$h $c");
+                               dbg($m . sprintf("%4d:", $o) . "$h $c");
                                $m = ' ' x (length $m);
                        }
                }
@@ -142,10 +139,10 @@ sub dbglist
        return keys (%dbglevel);
 }
 
-sub isdbg
+sub isdbg($)
 {
-       my $s = shift;
-       return $dbglevel{$s};
+       return unless $fp;
+       return $dbglevel{$_[0]};
 }
 
 sub shortmess 
index c809dfd3c6c0cd50ca41a8fed21734696c979077..870ac9cc4dedd17d01bbea823f840121b8bb95c0 100644 (file)
@@ -30,7 +30,7 @@ sub new
        my ($pkg, $name) = @_;
        my $s = readfilestr($main::data, $name);
        my $self = eval $s if $s;
-       dbg('err', "error in reading $name in DXHash $@") if $@;
+       dbg("error in reading $name in DXHash $@") if $@;
        $self = bless {name => $name}, $pkg unless $self;
        return $self;
 }
index 03dc42843ab162051bb19cac2eabaf78ed2f86bb..9f15c225f40dea9a01f7ce5b5aae8e9110fab522 100644 (file)
@@ -83,7 +83,7 @@ sub open
        $self->{year} = $year;
        $self->{thing} = $thing;
        
-#      DXDebug::dbg("dxlog", "opening $self->{fn}\n");
+#      DXDebug::dbg("opening $self->{fn}\n") if isdbg("dxlog");
        
        return $self->{fh};
 }
index 3ca756894a5ea2c3ce83602bdcef7504141acb7e..0d57ca7dced042fee6a2ad78d2ffbfe1f1dc98a4 100644 (file)
@@ -157,7 +157,7 @@ sub process
                        if (exists $busy{$f[2]}) {
                                my $ref = $busy{$f[2]};
                                my $tonode = $ref->{tonode};
-                               dbg('msg', "Busy, stopping msgno: $ref->{msgno} -> $f[2]");
+                               dbg("Busy, stopping msgno: $ref->{msgno} -> $f[2]") if isdbg('msg');
                                $ref->stop_msg($self->call);
                        }
 
@@ -173,7 +173,7 @@ sub process
                        $ref->{linesreq} = $f[10];
                        $ref->{stream} = $stream;
                        $ref->{count} = 0;      # no of lines between PC31s
-                       dbg('msg', "new message from $f[4] to $f[3] '$f[8]' stream $stream\n");
+                       dbg("new message from $f[4] to $f[3] '$f[8]' stream $stream\n") if isdbg('msg');
                        Log('msg', "Incoming message $f[4] to $f[3] '$f[8]'" );
                        $work{"$f[2]$stream"} = $ref; # store in work
                        $busy{$f[2]} = $ref; # set interlock
@@ -184,7 +184,7 @@ sub process
                        my $uref = DXUser->get_current($ref->{to});
                        if (is_callsign($ref->{to}) && !$ref->{private} && $uref && $uref->homenode) {
                                $ref->{private} = 1;
-                               dbg('msg', "set bull to $ref->{to} to private");
+                               dbg("set bull to $ref->{to} to private") if isdbg('msg');
                        }
                        last SWITCH;
                }
@@ -197,12 +197,12 @@ sub process
                                $ref->{count}++;
                                if ($ref->{count} >= $ref->{linesreq}) {
                                        $self->send(DXProt::pc31($f[2], $f[1], $f[3]));
-                                       dbg('msg', "stream $f[3]: $ref->{count} lines received\n");
+                                       dbg("stream $f[3]: $ref->{count} lines received\n") if isdbg('msg');
                                        $ref->{count} = 0;
                                }
                                $ref->{lastt} = $main::systime;
                        } else {
-                               dbg('msg', "PC29 from unknown stream $f[3] from $f[2]" );
+                               dbg("PC29 from unknown stream $f[3] from $f[2]") if isdbg('msg');
                                $self->send(DXProt::pc42($f[2], $f[1], $f[3])); # unknown stream
                        }
                        last SWITCH;
@@ -216,13 +216,13 @@ sub process
                                $ref->{count} = 0;
                                $ref->{linesreq} = 5;
                                $work{"$f[2]$f[3]"} = $ref;     # new ref
-                               dbg('msg', "incoming subject ack stream $f[3]\n");
+                               dbg("incoming subject ack stream $f[3]\n") if isdbg('msg');
                                $busy{$f[2]} = $ref; # interlock
                                push @{$ref->{lines}}, ($ref->read_msg_body);
                                $ref->send_tranche($self);
                                $ref->{lastt} = $main::systime;
                        } else {
-                               dbg('msg', "PC30 from unknown stream $f[3] from $f[2]" );
+                               dbg("PC30 from unknown stream $f[3] from $f[2]") if isdbg('msg');
                                $self->send(DXProt::pc42($f[2], $f[1], $f[3])); # unknown stream
                        } 
                        last SWITCH;
@@ -231,18 +231,18 @@ sub process
                if ($pcno == 31) {              # acknowledge a tranche of lines
                        my $ref = $work{"$f[2]$f[3]"};
                        if ($ref) {
-                               dbg('msg', "tranche ack stream $f[3]\n");
+                               dbg("tranche ack stream $f[3]\n") if isdbg('msg');
                                $ref->send_tranche($self);
                                $ref->{lastt} = $main::systime;
                        } else {
-                               dbg('msg', "PC31 from unknown stream $f[3] from $f[2]" );
+                               dbg("PC31 from unknown stream $f[3] from $f[2]") if isdbg('msg');
                                $self->send(DXProt::pc42($f[2], $f[1], $f[3])); # unknown stream
                        } 
                        last SWITCH;
                }
                
                if ($pcno == 32) {              # incoming EOM
-                       dbg('msg', "stream $f[3]: EOM received\n");
+                       dbg("stream $f[3]: EOM received\n") if isdbg('msg');
                        my $ref = $work{"$f[2]$f[3]"};
                        if ($ref) {
                                $self->send(DXProt::pc33($f[2], $f[1], $f[3])); # acknowledge it
@@ -263,7 +263,7 @@ sub process
                                                        if ($ref->{subject} eq $m->{subject} && $ref->{t} == $m->{t} && $ref->{from} eq $m->{from} && $ref->{to} eq $m->{to}) {
                                                                $ref->stop_msg($self->call);
                                                                my $msgno = $m->{msgno};
-                                                               dbg('msg', "duplicate message from $ref->{from} -> $ref->{to} to $msgno");
+                                                               dbg("duplicate message from $ref->{from} -> $ref->{to} to $msgno") if isdbg('msg');
                                                                Log('msg', "duplicate message from $ref->{from} -> $ref->{to} to $msgno");
                                                                return;
                                                        }
@@ -275,7 +275,7 @@ sub process
                                                # look for 'bad' to addresses 
                                                if ($ref->dump_it) {
                                                        $ref->stop_msg($self->call);
-                                                       dbg('msg', "'Bad' message $ref->{to}");
+                                                       dbg("'Bad' message $ref->{to}") if isdbg('msg');
                                                        Log('msg', "'Bad' message $ref->{to}");
                                                        return;
                                                }
@@ -291,7 +291,7 @@ sub process
                                }
                                $ref->stop_msg($self->call);
                        } else {
-                               dbg('msg', "PC32 from unknown stream $f[3] from $f[2]" );
+                               dbg("PC32 from unknown stream $f[3] from $f[2]") if isdbg('msg');
                                $self->send(DXProt::pc42($f[2], $f[1], $f[3])); # unknown stream
                        }
                        # queue_msg(0);
@@ -311,7 +311,7 @@ sub process
                                }
                                $ref->stop_msg($self->call);
                        } else {
-                               dbg('msg', "PC33 from unknown stream $f[3] from $f[2]" );
+                               dbg("PC33 from unknown stream $f[3] from $f[2]") if isdbg('msg');
                                $self->send(DXProt::pc42($f[2], $f[1], $f[3])); # unknown stream
                        } 
 
@@ -325,7 +325,7 @@ sub process
                        $f[3] =~ s/\.//og;      # remove dots
                        $f[3] =~ s/^\///o;   # remove the leading /
                        $f[3] = lc $f[3];       # to lower case;
-                       dbg('msg', "incoming file $f[3]\n");
+                       dbg("incoming file $f[3]\n") if isdbg('msg');
                        $f[3] = 'packclus/' . $f[3] unless $f[3] =~ /^packclus\//o;
                        
                        # create any directories
@@ -337,7 +337,7 @@ sub process
                                $fn .= "/$part";
                                next if -e $fn;
                                last SWITCH if !mkdir $fn, 0777;
-                               dbg('msg', "created directory $fn\n");
+                               dbg("created directory $fn\n") if isdbg('msg');
                        }
                        my $stream = next_transno($f[2]);
                        my $ref = DXMsg->alloc($stream, "$main::root/$f[3]", $self->call, time, !$f[4], $f[3], ' ', '0', '0');
@@ -357,7 +357,7 @@ sub process
                }
                
                if ($pcno == 42) {              # abort transfer
-                       dbg('msg', "stream $f[3]: abort received\n");
+                       dbg("stream $f[3]: abort received\n") if isdbg('msg');
                        my $ref = $work{"$f[2]$f[3]"};
                        if ($ref) {
                                $ref->stop_msg($self->call);
@@ -388,7 +388,7 @@ sub store
        my $lines = shift;
 
        if ($ref->{file}) {                     # a file
-               dbg('msg', "To be stored in $ref->{to}\n");
+               dbg("To be stored in $ref->{to}\n") if isdbg('msg');
                
                my $fh = new IO::File "$ref->{to}", "w";
                if (defined $fh) {
@@ -397,7 +397,7 @@ sub store
                                print $fh "$line\n";
                        }
                        $fh->close;
-                       dbg('msg', "file $ref->{to} stored\n");
+                       dbg("file $ref->{to} stored\n") if isdbg('msg');
                        Log('msg', "file $ref->{to} from $ref->{from} stored" );
                } else {
                        confess "can't open file $ref->{to} $!";  
@@ -407,7 +407,7 @@ sub store
                # attempt to open the message file
                my $fn = filename($ref->{msgno});
                
-               dbg('msg', "To be stored in $fn\n");
+               dbg("To be stored in $fn\n") if isdbg('msg');
                
                # now save the file, overwriting what's there, YES I KNOW OK! (I will change it if it's a problem)
                my $fh = new IO::File "$fn", "w";
@@ -423,7 +423,7 @@ sub store
                                print $fh "$line\n";
                        }
                        $fh->close;
-                       dbg('msg', "msg $ref->{msgno} stored\n");
+                       dbg("msg $ref->{msgno} stored\n") if isdbg('msg');
                        Log('msg', "msg $ref->{msgno} from $ref->{from} to $ref->{to} stored" );
                } else {
                        confess "can't open msg file $fn $!";  
@@ -437,13 +437,13 @@ sub del_msg
        my $self = shift;
        
        # remove it from the active message list
-       dbg('msg', "\@msg = " . scalar @msg . " before delete");
+       dbg("\@msg = " . scalar @msg . " before delete") if isdbg('msg');
        @msg = grep { $_ != $self } @msg;
        
        # remove the file
        unlink filename($self->{msgno});
-       dbg('msg', "deleting $self->{msgno}\n");
-       dbg('msg', "\@msg = " . scalar @msg . " after delete");
+       dbg("deleting $self->{msgno}\n") if isdbg('msg');
+       dbg("\@msg = " . scalar @msg . " after delete") if isdbg('msg');
 }
 
 # clean out old messages from the message queue
@@ -452,18 +452,18 @@ sub clean_old
        my $ref;
        
        # mark old messages for deletion
-       dbg('msg', "\@msg = " . scalar @msg . " before delete");
+       dbg("\@msg = " . scalar @msg . " before delete") if isdbg('msg');
        foreach $ref (@msg) {
                if (ref($ref) && !$ref->{keep} && $ref->{t} < $main::systime - $maxage) {
                        $ref->{deleteme} = 1;
                        unlink filename($ref->{msgno});
-                       dbg('msg', "deleting old $ref->{msgno}\n");
+                       dbg("deleting old $ref->{msgno}\n") if isdbg('msg');
                }
        }
        
        # remove them all from the active message list
        @msg = grep { !$_->{deleteme} } @msg;
-       dbg('msg', "\@msg = " . scalar @msg . " after delete");
+       dbg("\@msg = " . scalar @msg . " after delete") if isdbg('msg');
        $last_clean = $main::systime;
 }
 
@@ -479,21 +479,21 @@ sub read_msg_header
        
        $file = new IO::File "$fn";
        if (!$file) {
-           dbg('err', "Error reading $fn $!");
+           dbg("Error reading $fn $!");
            Log('err', "Error reading $fn $!");
                return undef;
        }
        $size = -s $fn;
        $line = <$file>;                        # first line
        if ($size == 0 || !$line) {
-           dbg('err', "Empty $fn $!");
+           dbg("Empty $fn $!");
            Log('err', "Empty $fn $!");
                return undef;
        }
        chomp $line;
        $size -= length $line;
        if (! $line =~ /^===/o) {
-               dbg('err', "corrupt first line in $fn ($line)");
+               dbg("corrupt first line in $fn ($line)");
                Log('err', "corrupt first line in $fn ($line)");
                return undef;
        }
@@ -505,7 +505,7 @@ sub read_msg_header
        chomp $line;
        $size -= length $line;
        if (! $line =~ /^===/o) {
-           dbg('err', "corrupt second line in $fn ($line)");
+           dbg("corrupt second line in $fn ($line)");
            Log('err', "corrupt second line in $fn ($line)");
                return undef;
        }
@@ -532,7 +532,7 @@ sub read_msg_body
        
        $file = new IO::File;
        if (!open($file, $fn)) {
-               dbg('err' ,"Error reading $fn $!");
+               dbg("Error reading $fn $!");
                Log('err' ,"Error reading $fn $!");
                return undef;
        }
@@ -576,7 +576,7 @@ sub queue_msg
        # bat down the message list looking for one that needs to go off site and whose
        # nearest node is not busy.
 
-       dbg('msg', "queue msg ($sort)\n");
+       dbg("queue msg ($sort)\n") if isdbg('msg');
        my @nodelist = DXChannel::get_all_nodes;
        foreach $ref (@msg) {
 
@@ -589,7 +589,7 @@ sub queue_msg
                # any time outs?
                if (exists $ref->{lastt} && $main::systime >= $ref->{lastt} + $timeout) {
                        my $node = $ref->{tonode};
-                       dbg('msg', "Timeout, stopping msgno: $ref->{msgno} -> $node");
+                       dbg("Timeout, stopping msgno: $ref->{msgno} -> $node") if isdbg('msg');
                        Log('msg', "Timeout, stopping msgno: $ref->{msgno} -> $node");
                        $ref->stop_msg($node);
                        
@@ -620,7 +620,7 @@ sub queue_msg
                                                $ref->start_msg($dxchan) if !get_busy($dxchan->call)  && $dxchan->state eq 'normal';
                                        }
                                } else {
-                                       dbg('route', "Route: No dxchan for $ref->{to} " . ref($clref) );
+                                       dbg("Route: No dxchan for $ref->{to} " . ref($clref) ) if isdbg('msg');
                                }
                        }
                }
@@ -667,7 +667,7 @@ sub start_msg
 {
        my ($self, $dxchan) = @_;
        
-       dbg('msg', "start msg $self->{msgno}\n");
+       dbg("start msg $self->{msgno}\n") if isdbg('msg');
        $self->{linesreq} = 10;
        $self->{count} = 0;
        $self->{tonode} = $dxchan->call;
@@ -705,7 +705,7 @@ sub stop_msg
        my $stream = $self->{stream} if exists $self->{stream};
        
        
-       dbg('msg', "stop msg $self->{msgno} -> node $node\n");
+       dbg("stop msg $self->{msgno} -> node $node\n") if isdbg('msg');
        delete $work{$node};
        delete $work{"$node$stream"} if $stream;
        $self->workclean;
@@ -728,7 +728,7 @@ sub next_transno
                $msgno++;
                seek $fh, 0, 0;
                $fh->print("$msgno\n");
-               dbg('msg', "msgno $msgno allocated for $name\n");
+               dbg("msgno $msgno allocated for $name\n") if isdbg('msg');
                $fh->close;
        } else {
                confess "can't open $fn $!";
@@ -744,9 +744,9 @@ sub init
        my $ref;
                
        # load various control files
-       dbg('err', "load badmsg: " . (load_badmsg() or "Ok"));
-       dbg('err', "load forward: " . (load_forward() or "Ok"));
-       dbg('err', "load swop: " . (load_swop() or "Ok"));
+       dbg("load badmsg: " . (load_badmsg() or "Ok"));
+       dbg("load forward: " . (load_forward() or "Ok"));
+       dbg("load swop: " . (load_swop() or "Ok"));
 
        # read in the directory
        opendir($dir, $msgdir) or confess "can't open $msgdir $!";
@@ -759,7 +759,7 @@ sub init
                
                $ref = read_msg_header("$msgdir/$_");
                unless ($ref) {
-                       dbg('err', "Deleting $_");
+                       dbg("Deleting $_");
                        Log('err', "Deleting $_");
                        unlink "$msgdir/$_";
                        next;
@@ -767,7 +767,7 @@ sub init
                
                # delete any messages to 'badmsg.pl' places
                if ($ref->dump_it) {
-                       dbg('msg', "'Bad' TO address $ref->{to}");
+                       dbg("'Bad' TO address $ref->{to}") if isdbg('msg');
                        Log('msg', "'Bad' TO address $ref->{to}");
                        $ref->del_msg;
                        next;
@@ -1059,7 +1059,7 @@ sub import_msgs
        # are there any to do in this directory?
        return unless -d $importfn;
        unless (opendir(DIR, $importfn)) {
-               dbg('msg', "can\'t open $importfn $!");
+               dbg("can\'t open $importfn $!") if isdbg('msg');
                Log('msg', "can\'t open $importfn $!");
                return;
        } 
@@ -1073,7 +1073,7 @@ sub import_msgs
                my $fn = "$importfn/$name";
                next unless -f $fn;
                unless (open(MSG, $fn)) {
-                       dbg('msg', "can\'t open import file $fn $!");
+                       dbg("can\'t open import file $fn $!") if isdbg('msg');
                        Log('msg', "can\'t open import file $fn $!");
                        unlink($fn);
                        next;
@@ -1106,7 +1106,7 @@ sub import_one
        my @f = split /\s+/, $line;
        unless (@f && $f[0] =~ /^(:?S|SP|SB|SEND)$/ ) {
                my $m = "invalid first line in import '$line'";
-               dbg('MSG', $m );
+               dbg($m) if isdbg('msg');
                return (1, $m);
        }
        while (@f) {
index fc08f5423649450372262ac068a072d5d2bebdf9..03887493ffaa5b6b451d327b523250883d8d754b 100644 (file)
@@ -286,7 +286,7 @@ sub normal
        # check for and dump bad protocol messages
        my $n = check($pcno, @field);
        if ($n) {
-               dbg('chan', "PCPROT: bad field $n, dumped (" . parray($checklist[$pcno-10]) . ")");
+               dbg("PCPROT: bad field $n, dumped (" . parray($checklist[$pcno-10]) . ")") if isdbg('chan');
                return;
        }
 
@@ -295,7 +295,7 @@ sub normal
        eval {
                $pcr = Local::pcprot($self, $pcno, @field);
        };
-#      dbg('local', "Local::pcprot error $@") if $@;
+#      dbg("Local::pcprot error $@") if isdbg('local') if $@;
        return if $pcr;
        
  SWITCH: {
@@ -305,7 +305,7 @@ sub normal
                        if ($censorpc) {
                                my @bad;
                                if (@bad = BadWords::check($field[3])) {
-                                       dbg('chan', "PCPROT: Bad words: @bad, dropped" );
+                                       dbg("PCPROT: Bad words: @bad, dropped") if isdbg('chan');
                                        return;
                                }
                        }
@@ -340,13 +340,13 @@ sub normal
                        
                        # if this is a 'nodx' node then ignore it
                        if ($badnode->in($field[7])) {
-                               dbg('chan', "PCPROT: Bad Node, dropped");
+                               dbg("PCPROT: Bad Node, dropped") if isdbg('chan');
                                return;
                        }
                        
                        # if this is a 'bad spotter' user then ignore it
                        if ($badspotter->in($field[6])) {
-                               dbg('chan', "PCPROT: Bad Spotter, dropped");
+                               dbg("PCPROT: Bad Spotter, dropped") if isdbg('chan');
                                return;
                        }
                        
@@ -354,13 +354,13 @@ sub normal
                        my $d = cltounix($field[3], $field[4]);
                        # bang out (and don't pass on) if date is invalid or the spot is too old (or too young)
                        if (!$d || ($pcno == 11 && ($d < $main::systime - $pc11_max_age || $d > $main::systime + 900))) {
-                               dbg('chan', "PCPROT: Spot ignored, invalid date or out of range ($field[3] $field[4])\n");
+                               dbg("PCPROT: Spot ignored, invalid date or out of range ($field[3] $field[4])\n") if isdbg('chan');
                                return;
                        }
 
                        # is it 'baddx'
                        if ($baddx->in($field[2])) {
-                               dbg('chan', "PCPROT: Bad DX spot, ignored");
+                               dbg("PCPROT: Bad DX spot, ignored") if isdbg('chan');
                                return;
                        }
                        
@@ -368,17 +368,17 @@ sub normal
                        $field[5] =~ s/^\s+//;      # take any leading blanks off
                        $field[2] = unpad($field[2]);   # take off leading and trailing blanks from spotted callsign
                        if ($field[2] =~ /BUST\w*$/) {
-                               dbg('chan', "PCPROT: useless 'BUSTED' spot");
+                               dbg("PCPROT: useless 'BUSTED' spot") if isdbg('chan');
                                return;
                        }
                        if (Spot::dup($field[1], $field[2], $d, $field[5])) {
-                               dbg('chan', "PCPROT: Duplicate Spot ignored\n");
+                               dbg("PCPROT: Duplicate Spot ignored\n") if isdbg('chan');
                                return;
                        }
                        if ($censorpc) {
                                my @bad;
                                if (@bad = BadWords::check($field[5])) {
-                                       dbg('chan', "PCPROT: Bad words: @bad, dropped" );
+                                       dbg("PCPROT: Bad words: @bad, dropped") if isdbg('chan');
                                        return;
                                }
                        }
@@ -388,7 +388,7 @@ sub normal
                        if ($self->{inspotsfilter}) {
                                my ($filter, $hops) = $self->{inspotsfilter}->it(@spot);
                                unless ($filter) {
-                                       dbg('chan', "PCPROT: Rejected by filter");
+                                       dbg("PCPROT: Rejected by filter") if isdbg('chan');
                                        return;
                                }
                        }
@@ -455,7 +455,7 @@ sub normal
                        eval {
                                $r = Local::spot($self, @spot);
                        };
-#                      dbg('local', "Local::spot1 error $@") if $@;
+#                      dbg("Local::spot1 error $@") if isdbg('local') if $@;
                        return if $r;
 
                        # DON'T be silly and send on PC26s!
@@ -470,14 +470,14 @@ sub normal
                        # announce duplicate checking
                        $field[3] =~ s/^\s+//;  # remove leading blanks
                        if (AnnTalk::dup($field[1], $field[2], $field[3])) {
-                               dbg('chan', "PCPROT: Duplicate Announce ignored");
+                               dbg("PCPROT: Duplicate Announce ignored") if isdbg('chan');
                                return;
                        }
 
                        if ($censorpc) {
                                my @bad;
                                if (@bad = BadWords::check($field[3])) {
-                                       dbg('chan', "PCPROT: Bad words: @bad, dropped" );
+                                       dbg("PCPROT: Bad words: @bad, dropped") if isdbg('chan');
                                        return;
                                }
                        }
@@ -502,7 +502,7 @@ sub normal
                                        my ($filter, $hops) = $self->{inannfilter}->it(@field[1..6], $self->{call}, 
                                                                                                        $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq);
                                        unless ($filter) {
-                                               dbg('chan', "PCPROT: Rejected by filter");
+                                               dbg("PCPROT: Rejected by filter") if isdbg('chan');
                                                return;
                                        }
                                }
@@ -534,17 +534,17 @@ sub normal
                        my $newline = "PC16^";
                        
                        if ($ncall eq $main::mycall) {
-                               dbg('chan', "PCPROT: trying to alter config on this node from outside!");
+                               dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chan');
                                return;
                        }
                        $dxchan = DXChannel->get($ncall);
                        if ($dxchan && $dxchan ne $self) {
-                               dbg('chan', "PCPROT: PC16 from $self->{call} trying to alter locally connected $ncall, ignored!");
+                               dbg("PCPROT: PC16 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chan');
                                return;
                        }
                        my $parent = Route::Node::get($ncall); 
                        unless ($parent) {
-                               dbg('chan', "PCPROT: Node $ncall not in config");
+                               dbg("PCPROT: Node $ncall not in config") if isdbg('chan');
                                return;
                        }
                        my $i;
@@ -587,17 +587,17 @@ sub normal
                        my $ncall = $field[2];
                        my $ucall = $field[1];
                        if ($ncall eq $main::mycall) {
-                               dbg('chan', "PCPROT: trying to alter config on this node from outside!");
+                               dbg("PCPROT: trying to alter config on this node from outside!") if isdbg('chan');
                                return;
                        }
                        $dxchan = DXChannel->get($ncall);
                        if ($dxchan && $dxchan ne $self) {
-                               dbg('chan', "PCPROT: PC17 from $self->{call} trying to alter locally connected $ncall, ignored!");
+                               dbg("PCPROT: PC17 from $self->{call} trying to alter locally connected $ncall, ignored!") if isdbg('chan');
                                return;
                        }
                        my $parent = Route::Node::get($ncall);
                        unless ($parent) {
-                               dbg('chan', "PCPROT: Route::Node $ncall not in config");
+                               dbg("PCPROT: Route::Node $ncall not in config") if isdbg('chan');
                                return;
                        }
                        my @rout = $parent->del_user($ucall);
@@ -692,21 +692,21 @@ sub normal
                        my @rout;
                        my $parent = Route::Node::get($self->{call});
                        unless ($parent) {
-                               dbg('chan', "PCPROT: Route::Node $call not in config");
+                               dbg("PCPROT: Route::Node $call not in config") if isdbg('chan');
                                return;
                        }
                        my $node = Route::Node::get($call);
                        
                        if ($call ne $main::mycall) { # don't allow malicious buggers to disconnect me!
                                if ($call eq $self->{call}) {
-                                       dbg('chan', "PCPROT: Trying to disconnect myself with PC21");
+                                       dbg("PCPROT: Trying to disconnect myself with PC21") if isdbg('chan');
                                        return;
                                }
 
                                # routing objects
                                push @rout, $node->del($parent) if $node;
                        } else {
-                               dbg('chan', "PCPROT: I WILL _NOT_ be disconnected!");
+                               dbg("PCPROT: I WILL _NOT_ be disconnected!") if isdbg('chan');
                                return;
                        }
                        $self->route_pc21(@rout) if @rout;
@@ -736,11 +736,11 @@ sub normal
                        my ($r) = $field[6] =~ /R=(\d+)/;
                        $r = 0 unless $r;
                        if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 1500 || $field[2] < 0 || $field[2] > 23) {
-                               dbg('chan', "PCPROT: WWV Date ($field[1] $field[2]) out of range");
+                               dbg("PCPROT: WWV Date ($field[1] $field[2]) out of range") if isdbg('chan');
                                return;
                        }
                        if (Geomag::dup($d,$sfi,$k,$i,$field[6])) {
-                               dbg('chan', "PCPROT: Dup WWV Spot ignored\n");
+                               dbg("PCPROT: Dup WWV Spot ignored\n") if isdbg('chan');
                                return;
                        }
                        $field[7] =~ s/-\d+$//o;            # remove spotter's ssid
@@ -751,7 +751,7 @@ sub normal
                        eval {
                                $rep = Local::wwv($self, $field[1], $field[2], $sfi, $k, $i, @field[6..8], $r);
                        };
-#                      dbg('local', "Local::wwv2 error $@") if $@;
+#                      dbg("Local::wwv2 error $@") if isdbg('local') if $@;
                        return if $rep;
 
                        # DON'T be silly and send on PC27s!
@@ -779,7 +779,7 @@ sub normal
                                return;
                        }
                        if ($field[2] eq $main::mycall) {
-                               dbg('chan', "PCPROT: Trying to merge to myself, ignored");
+                               dbg("PCPROT: Trying to merge to myself, ignored") if isdbg('chan');
                                return;
                        }
 
@@ -882,7 +882,7 @@ sub normal
                        if ($field[1] eq $self->{call}) {
                                $self->disconnect(1);
                        } else {
-                               dbg('chan', "PCPROT: came in on wrong channel");
+                               dbg("PCPROT: came in on wrong channel") if isdbg('chan');
                        }
                        return;
                }
@@ -991,12 +991,12 @@ sub normal
                        # do some de-duping
                        my $d = cltounix($call, sprintf("%02d18Z", $field[2]));
                        if (($pcno == 23 && $d < $main::systime - $pc23_max_age) || $d > $main::systime + 1500 || $field[2] < 0 || $field[2] > 23) {
-                               dbg('chan', "PCPROT: WCY Date ($call $field[2]) out of range");
+                               dbg("PCPROT: WCY Date ($call $field[2]) out of range") if isdbg('chan');
                                return;
                        }
                        @field = map { unpad($_) } @field;
                        if (WCY::dup($d,@field[3..7])) {
-                               dbg('chan', "PCPROT: Dup WCY Spot ignored\n");
+                               dbg("PCPROT: Dup WCY Spot ignored\n") if isdbg('chan');
                                return;
                        }
                
@@ -1006,7 +1006,7 @@ sub normal
                        eval {
                                $rep = Local::wwv($self, @field[1..12]);
                        };
-                       # dbg('local', "Local::wcy error $@") if $@;
+                       # dbg("Local::wcy error $@") if isdbg('local') if $@;
                        return if $rep;
 
                        # broadcast to the eager world
@@ -1089,7 +1089,7 @@ sub normal
        #
 
        if (eph_dup($line)) {
-               dbg('chan', "PCPROT: Ephemeral dup, dropped");
+               dbg("PCPROT: Ephemeral dup, dropped") if isdbg('chan');
        } else {
                unless ($self->{isolate}) {
                        broadcast_ak1a($line, $self); # send it to everyone but me
@@ -1406,7 +1406,7 @@ sub send_local_config
        my @localnodes;
        my @remotenodes;
 
-       dbg('trace', 'DXProt::send_local_config');
+       dbg('DXProt::send_local_config') if isdbg('trace');
        
        # send our nodes
        if ($self->{isolate}) {
@@ -1433,7 +1433,7 @@ sub send_local_config
                if ($n) {
                        send_route($self, \&pc16, 1, $n, map {my $r = Route::User::get($_); $r ? ($r) : ()} $n->users);
                } else {
-                       dbg('chan', "sent a null value");
+                       dbg("sent a null value") if isdbg('chan');
                }
        }
 }
@@ -1448,7 +1448,7 @@ sub route
        my ($self, $call, $line) = @_;
 
        if (ref $self && $call eq $self->{call}) {
-               dbg('chan', "PCPROT: Trying to route back to source, dropped");
+               dbg("PCPROT: Trying to route back to source, dropped") if isdbg('chan');
                return;
        }
 
@@ -1459,7 +1459,7 @@ sub route
                $dxchan = $cl->dxchan if $cl;
                if (ref $dxchan) {
                        if (ref $self && $dxchan eq $self) {
-                               dbg('chan', "PCPROT: Trying to route back to source, dropped");
+                               dbg("PCPROT: Trying to route back to source, dropped") if isdbg('chan');
                                return;
                        }
                }
@@ -1470,7 +1470,7 @@ sub route
                        $dxchan->send($routeit);
                }
        } else {
-               dbg('chan', "PCPROT: No route available, dropped");
+               dbg("PCPROT: No route available, dropped") if isdbg('chan');
        }
 }
 
@@ -1727,7 +1727,7 @@ sub send_route
                                ($filter, $hops) = $self->{routefilter}->it($self->{call}, $self->{dxcc}, $self->{itu}, $self->{cq}, $r->call, $r->dxcc, $r->itu, $r->cq);
                                push @rin, $r if $filter;
                        } else {
-                               dbg('chan', "was sent a null value");
+                               dbg("was sent a null value") if isdbg('chan');
                        }
                }
        }
index ca73a02ed2ffde0668dd9b4ce7e047a4ce3d3742..23996b0700d99ce3e18f719081a29c32bb037edf 100644 (file)
@@ -243,8 +243,8 @@ sub decode
        my $ref;
        eval '$ref = ' . $s;
        if ($@) {
-               dbg('err', $@) if $@;
-               Log('err', $@) if $@;
+               dbg($@);
+               Log('err', $@);
                $ref = undef;
        }
        return $ref;
index be7d0e84c0ada79e8b349e83c445e59b01b4165c..7b33b6e2780d43e19d663d63f0fe4bdf59a0b14f 100644 (file)
@@ -50,7 +50,7 @@ sub send_raw
     my $sock = $conn->{sock};
     return unless defined($sock);
        push (@{$conn->{outqueue}}, $msg);
-       dbg('connect', "connect $conn->{cnum}: $msg") unless $conn->{state} eq 'C';
+       dbg("connect $conn->{cnum}: $msg") if $conn->{state} ne 'C' && isdbg('connect');
     Msg::set_event_handler ($sock, "write" => sub {$conn->_send(0)});
 }
 
@@ -65,7 +65,7 @@ sub dequeue
        if ($conn->{state} eq 'WC') {
                if (exists $conn->{cmd}) {
                        if (@{$conn->{cmd}}) {
-                               dbg('connect', "connect $conn->{cnum}: $conn->{msg}");
+                               dbg("connect $conn->{cnum}: $conn->{msg}") if isdbg('connect');
                                $conn->_docmd($conn->{msg});
                        } 
                }
@@ -80,7 +80,7 @@ sub dequeue
                        $conn->{msg} = pop @lines;
                }
                while (defined ($msg = shift @lines)) {
-                       dbg('connect', "connect $conn->{cnum}: $msg") unless $conn->{state} eq 'C';
+                       dbg("connect $conn->{cnum}: $msg") if $conn->{state} ne 'C' && isdbg('connect');
                
                        $msg =~ s/\xff\xfa.*\xff\xf0|\xff[\xf0-\xfe].//g; # remove telnet options
                        $msg =~ s/[\x00-\x08\x0a-\x19\x1b-\x1f\x80-\x9f]/./g;         # immutable CSI sequence + control characters
@@ -131,13 +131,13 @@ sub new_client {
                $conn->{blocking} = 0;
                eval {$conn->{peerhost} = $sock->peerhost};
                if ($@) {
-                       dbg('conn', $@);
+                       dbg($@) if isdbg('connll');
                        $conn->disconnect;
                } else {
                        eval {$conn->{peerport} = $sock->peerport};
                        $conn->{peerport} = 0 if $@;
                        my ($rproc, $eproc) = &{$server_conn->{rproc}} ($conn, $conn->{peerhost}, $conn->{peerport});
-                       dbg('connll', "accept $conn->{cnum} from $conn->{peerhost} $conn->{peerport}");
+                       dbg("accept $conn->{cnum} from $conn->{peerhost} $conn->{peerport}") if isdbg('connll');
                        if ($eproc) {
                                $conn->{eproc} = $eproc;
                                Msg::set_event_handler ($sock, "error" => $eproc);
@@ -160,7 +160,7 @@ sub new_client {
                        }
                }
        } else {
-               dbg('err', "ExtMsg: error on accept ($!)");
+               dbg("ExtMsg: error on accept ($!)") if isdbg('err');
        }
 }
 
@@ -218,16 +218,16 @@ sub _doconnect
        my $r;
 
        $sort = lc $sort;
-       dbg('connect', "CONNECT $conn->{cnum} sort: $sort command: $line");
+       dbg("CONNECT $conn->{cnum} sort: $sort command: $line") if isdbg('connect');
        if ($sort eq 'telnet') {
                # this is a straight network connect
                my ($host, $port) = split /\s+/, $line;
                $port = 23 if !$port;
                $r = $conn->connect($host, $port);
                if ($r) {
-                       dbg('connect', "Connected $conn->{cnum} to $host $port");
+                       dbg("Connected $conn->{cnum} to $host $port") if isdbg('connect');
                } else {
-                       dbg('connect', "***Connect $conn->{cnum} Failed to $host $port $!");
+                       dbg("***Connect $conn->{cnum} Failed to $host $port $!") if isdbg('connect');
                }
        } elsif ($sort eq 'agw') {
                # turn it into an AGW object
@@ -252,7 +252,7 @@ sub _doconnect
                                                my $callback = sub {$conn->_rcv};
                                                Msg::set_event_handler ($a, read => $callback);
                                        }
-                                       dbg('connect', "connect $conn->{cnum}: started pid: $conn->{pid} as $line");
+                                       dbg("connect $conn->{cnum}: started pid: $conn->{pid} as $line") if isdbg('connect');
                                } else {
                                        $^W = 0;
                                        dbgclose();
@@ -268,17 +268,17 @@ sub _doconnect
                                                $SIG{HUP} = $SIG{CHLD} = $SIG{TERM} = $SIG{INT} = 'DEFAULT';
                                                alarm(0);
                                        }
-                                       exec "$line" or dbg('err', "exec '$line' failed $!");
+                                       exec "$line" or dbg("exec '$line' failed $!");
                                } 
                        } else {
-                               dbg('err', "cannot fork");      
+                               dbg("cannot fork");
                                $r = undef;
                        }
                } else {
-                       dbg('err', "no socket pair $!");
+                       dbg("no socket pair $!");
                }
        } else {
-               dbg('err', "invalid type of connection ($sort)");
+               dbg("invalid type of connection ($sort)");
        }
        $conn->disconnect unless $r;
        return $r;
@@ -288,7 +288,7 @@ sub _doabort
 {
        my $conn = shift;
        my $string = shift;
-       dbg('connect', "connect $conn->{cnum}: abort $string");
+       dbg("connect $conn->{cnum}: abort $string") if isdbg('connect');
        $conn->{abort} = $string;
 }
 
@@ -296,7 +296,7 @@ sub _dotimeout
 {
        my $conn = shift;
        my $val = shift;
-       dbg('connect', "connect $conn->{cnum}: timeout set to $val");
+       dbg("connect $conn->{cnum}: timeout set to $val") if isdbg('connect');
        $conn->{timeout}->del if $conn->{timeout};
        $conn->{timeval} = $val;
        $conn->{timeout} = Timer->new($val, sub{ &_timedout($conn) });
@@ -306,7 +306,7 @@ sub _dolineend
 {
        my $conn = shift;
        my $val = shift;
-       dbg('connect', "connect $conn->{cnum}: lineend set to $val ");
+       dbg("connect $conn->{cnum}: lineend set to $val ") if isdbg('connect');
        $val =~ s/\\r/\r/g;
        $val =~ s/\\n/\n/g;
        $conn->{lineend} = $val;
@@ -321,16 +321,16 @@ sub _dochat
        if ($line) {
                my ($expect, $send) = $cmd =~ /^\s*\'(.*)\'\s+\'(.*)\'/;
                if ($expect) {
-                       dbg('connect', "connect $conn->{cnum}: expecting: \"$expect\" received: \"$line\"");
+                       dbg("connect $conn->{cnum}: expecting: \"$expect\" received: \"$line\"") if isdbg('connect');
                        if ($conn->{abort} && $line =~ /\Q$conn->{abort}/i) {
-                               dbg('connect', "connect $conn->{cnum}: aborted on /$conn->{abort}/");
+                               dbg("connect $conn->{cnum}: aborted on /$conn->{abort}/") if isdbg('connect');
                                $conn->disconnect;
                                delete $conn->{cmd};
                                return;
                        }
                        if ($line =~ /\Q$expect/i) {
                                if (length $send) {
-                                       dbg('connect', "connect $conn->{cnum}: got: \"$expect\" sending: \"$send\"");
+                                       dbg("connect $conn->{cnum}: got: \"$expect\" sending: \"$send\"") if isdbg('connect');
                                        $conn->send_later("D$conn->{call}|$send");
                                }
                                delete $conn->{msg}; # get rid any input if a match
@@ -345,7 +345,7 @@ sub _dochat
 sub _timedout
 {
        my $conn = shift;
-       dbg('connect', "connect $conn->{cnum}: timed out after $conn->{timeval} seconds");
+       dbg("connect $conn->{cnum}: timed out after $conn->{timeval} seconds") if isdbg('connect');
        $conn->disconnect;
 }
 
@@ -375,7 +375,7 @@ sub _send_file
                        while (<$f>) {
                                chomp;
                                my $l = $_;
-                               dbg('connll', "connect $conn->{cnum}: $l");
+                               dbg("connect $conn->{cnum}: $l") if isdbg('connll');
                                $conn->send_raw($l . $conn->{lineend});
                        }
                        $f->close;
index a37ea0d2d647cc95a45cdb6cdd969f8f25102e3b..5f6b9bf17af397b23cbe6fd98ae2cc3f438df5fd 100644 (file)
@@ -89,7 +89,7 @@ sub compile
                if ($@) {
                        my $sort = $ref->{sort};
                        my $name = $ref->{name};
-                       dbg('err', "Error compiling $ar $sort $name: $@");
+                       dbg("Error compiling $ar $sort $name: $@") if isdbg('err');
                        Log('err', "Error compiling $ar $sort $name: $@");
                }
                $rr = $@;
@@ -107,7 +107,7 @@ sub read_in
                $in = undef; 
                my $s = readfilestr($fn);
                my $newin = eval $s;
-               dbg('conn', "$@") if $@;
+               dbg($@) if $@;
                if ($in) {
                        $newin = new('Filter::Old', $sort, $call, $flag);
                        $newin->{filter} = $in;
@@ -223,7 +223,7 @@ sub it
                my $true = $r ? "OK" : "REJ";
                my $sort = $self->{sort};
                $hops ||= "none";
-               dbg('filter', "Filter: $type/$sort with $asc on '$args': $true hops: $hops");
+               dbg("Filter: $type/$sort with $asc on '$args': $true hops: $hops") if isdbg('filter');
        }
        return ($r, $hops);
 }
index 8be2fc1bf071d39dd464907de8397da7fdd27891..94f19e6fbadcc3b0df9d0ca172585ac12bf5ec30 100644 (file)
@@ -80,7 +80,7 @@ sub new
 
        $noconns++;
        
-       dbg('connll', "Connection created ($noconns)");
+       dbg("Connection created ($noconns)") if isdbg('connll');
        return bless $conn, $class;
 }
 
@@ -122,11 +122,11 @@ sub conns
        if (ref $pkg) {
                $call = $pkg->{call} unless $call;
                return undef unless $call;
-               dbg('connll', "changing $pkg->{call} to $call") if exists $pkg->{call} && $call ne $pkg->{call};
+               dbg("changing $pkg->{call} to $call") if isdbg('connll') && exists $pkg->{call} && $call ne $pkg->{call};
                delete $conns{$pkg->{call}} if exists $pkg->{call} && exists $conns{$pkg->{call}} && $pkg->{call} ne $call; 
                $pkg->{call} = $call;
                $ref = $conns{$call} = $pkg;
-               dbg('connll', "Connection $pkg->{cnum} $call stored");
+               dbg("Connection $pkg->{cnum} $call stored") if isdbg('connll');
        } else {
                $ref = $conns{$call};
        }
@@ -199,7 +199,7 @@ sub disconnect {
                delete $conns{$call} if $ref && $ref == $conn;
        }
        $call ||= 'unallocated';
-       dbg('connll', "Connection $conn->{cnum} $call disconnected");
+       dbg("Connection $conn->{cnum} $call disconnected") if isdbg('connll');
        
        unless ($main::is_win) {
                kill 'TERM', $conn->{pid} if exists $conn->{pid};
@@ -427,7 +427,7 @@ sub new_client {
                        $conn->disconnect();
                }
        } else {
-               dbg('err', "Msg: error on accept ($!)");
+               dbg("Msg: error on accept ($!)") if isdbg('err');
        }
 }
 
@@ -536,7 +536,7 @@ sub DESTROY
        my $call = $conn->{call} || 'unallocated';
        my $host = $conn->{peerhost} || '';
        my $port = $conn->{peerport} || '';
-       dbg('connll', "Connection $conn->{cnum} $call [$host $port] being destroyed");
+       dbg("Connection $conn->{cnum} $call [$host $port] being destroyed") if isdbg('connll');
        $noconns--;
 }
 
index d76cad19436e944e6ba815092d37f86a6069000f..61d07249917a889028eba36f8f9c694e8ad9a0ab 100644 (file)
@@ -49,7 +49,7 @@ sub new
        $pkg = ref $pkg if ref $pkg;
 
        my $self = bless {call => $call}, $pkg;
-       dbg('routelow', "create $pkg with $call");
+       dbg("create $pkg with $call") if isdbg('routelow');
 
        # add in all the dxcc, itu, zone info
        my @dxcc = Prefix::extract($call);
@@ -89,7 +89,7 @@ sub _addlist
                my $call = _getcall($c);
                unless (grep {$_ eq $call} @{$self->{$field}}) {
                        push @{$self->{$field}}, $call;
-                       dbg('routelow', ref($self) . " adding $call to " . $self->{call} . "->\{$field\}");
+                       dbg(ref($self) . " adding $call to " . $self->{call} . "->\{$field\}") if isdbg('routelow');
                }
        }
        return $self->{$field};
@@ -103,7 +103,7 @@ sub _dellist
                my $call = _getcall($c);
                if (grep {$_ eq $call} @{$self->{$field}}) {
                        $self->{$field} = [ grep {$_ ne $call} @{$self->{$field}} ];
-                       dbg('routelow', ref($self) . " deleting $call from " . $self->{call} . "->\{$field\}");
+                       dbg(ref($self) . " deleting $call from " . $self->{call} . "->\{$field\}") if isdbg('routelow');
                }
        }
        return $self->{$field};
@@ -217,7 +217,7 @@ sub config
 
                if ($nref) {
                        my $c = $nref->user_call;
-#                      dbg('routec', "recursing from $call -> $c");
+#                      dbg("recursing from $call -> $c") if isdbg('routec');
                        push @out, $nref->config($nodes_only, $level+1, $seen, @_);
                } else {
                        push @out, ' ' x (($level+1)*2)  . "$ncall?" if @_ == 0 || (@_ && grep $ncall =~ m|$_|, @_); 
@@ -253,7 +253,7 @@ sub alldxchan
 {
        my $self = shift;
        my @dxchan;
-#      dbg('routech', "Trying node $self->{call}");
+#      dbg("Trying node $self->{call}") if isdbg('routech');
        my $dxchan = DXChannel->get($self->{call});
        push @dxchan, $dxchan if $dxchan;
        
@@ -261,7 +261,7 @@ sub alldxchan
        # for all the candidates.
        unless (@dxchan) {
                foreach my $p (@{$self->{parent}}) {
-#                      dbg('routech', "Trying parent $p");
+#                      dbg("Trying parent $p") if isdbg('routech');
                        next if $p eq $main::mycall; # the root
                        my $dxchan = DXChannel->get($p);
                        if ($dxchan) {
@@ -269,7 +269,7 @@ sub alldxchan
                        } else {
                                next if grep $p eq $_, @_;
                                my $ref = Route::Node::get($p);
-#                              dbg('routech', "Next node $p " . ($ref ? 'Found' : 'NOT Found') );
+#                              dbg("Next node $p " . ($ref ? 'Found' : 'NOT Found') if isdbg('routech') );
                                push @dxchan, $ref->alldxchan($self->{call}, @_) if $ref;
                        }
                }
@@ -307,7 +307,7 @@ sub DESTROY
        my $self = shift;
        my $pkg = ref $self;
        
-       dbg('routelow', "$pkg $self->{call} destroyed");
+       dbg("$pkg $self->{call} destroyed") if isdbg('routelow');
 }
 
 no strict;
index eb2f536bd4e96a55d3a1058b3af2419051094931..6b4f4332de9a8ff163054d37b4733cb7d23879f6 100644 (file)
@@ -206,7 +206,7 @@ sub get
        my $call = shift;
        $call = shift if ref $call;
        my $ref = $list{uc $call};
-       dbg('routerr', "Failed to get Node $call" ) unless $ref;
+       dbg("Failed to get Node $call" ) if !$ref && isdbg('routerr');
        return $ref;
 }
 
@@ -259,7 +259,7 @@ sub DESTROY
        my $pkg = ref $self;
        my $call = $self->{call} || "Unknown";
        
-       dbg('route', "destroying $pkg with $call");
+       dbg("destroying $pkg with $call") if isdbg('routelow');
 }
 
 #
index 2bbfe5b751762c812ae7aa6bb1eabdd429eb8cee..d492c27bf7769050d20878c7279f9ef4f7d90512 100644 (file)
@@ -67,7 +67,7 @@ sub get
        my $call = shift;
        $call = shift if ref $call;
        my $ref = $list{uc $call};
-       dbg('routerr', "Failed to get User $call" ) unless $ref;
+       dbg("Failed to get User $call" ) if !$ref && isdbg('routerr');
        return $ref;
 }
 
index 8b66b0f6c762f78c398c230a64856a7ae89a621a..8e83667898793142b80ae1ec3cc430f97f53f14a 100644 (file)
@@ -183,7 +183,7 @@ sub search
        $expr =~ s/\$f(\d)/\$ref->[$1]/g; # swap the letter n for the correct field name
        #  $expr =~ s/\$f(\d)/\$spots[$1]/g;               # swap the letter n for the correct field name
   
-       dbg("search", "hint='$hint', expr='$expr', spotno=$from-$to, day=$dayfrom-$dayto\n");
+       dbg("hint='$hint', expr='$expr', spotno=$from-$to, day=$dayfrom-$dayto\n") if isdbg('search');
   
        # build up eval to execute
        $eval = qq(
index 281421f08d72394b13c54912d97fbb476d3ae0ba..683497d2d328f889f6d1ac6f1aaf9538587b3a4a 100644 (file)
@@ -25,7 +25,7 @@ sub new
        $self->{interval} = $time if $recur;
        push @timerchain, $self;
        $notimers++;
-       dbg('connll', "Timer created ($notimers)");
+       dbg("Timer created ($notimers)") if isdbg('connll');
        return $self;
 }
 
@@ -52,7 +52,7 @@ sub handler
 
 sub DESTROY
 {
-       dbg('connll', "timer destroyed ($Timer::notimers)");
+       dbg("timer destroyed ($Timer::notimers)") if isdbg('connll');
        $Timer::notimers--;
 }
 1;
index 904797adc4a66d4f93fad9f1b13cb1584eeccefc..9848e76f10993748587a5d10fa0b83395f963be9 100755 (executable)
@@ -114,7 +114,7 @@ sub already_conn
        my ($conn, $call, $mess) = @_;
 
        $conn->disable_read(1);
-       dbg('chan', "-> D $call $mess\n"); 
+       dbg("-> D $call $mess\n") if isdbg('chan'); 
        $conn->send_now("D$call|$mess");
        sleep(2);
        $conn->disconnect;
@@ -205,7 +205,7 @@ sub cease
        eval {
                Local::finish();   # end local processing
        };
-       dbg('local', "Local::finish error $@") if $@;
+       dbg("Local::finish error $@") if $@;
 
        # disconnect nodes
        foreach $dxchan (DXChannel->get_all_nodes) {
@@ -234,7 +234,7 @@ sub cease
                $l->close_server;
        }
 
-       dbg('chan', "DXSpider version $version, build $build ended");
+       dbg("DXSpider version $version, build $build ended") if isdbg('chan');
        Log('cluster', "DXSpider V$version, build $build ended");
        dbgclose();
        Logclose();
@@ -248,11 +248,11 @@ sub reap
 {
        my $cpid;
        while (($cpid = waitpid(-1, WNOHANG)) > 0) {
-               dbg('reap', "cpid: $cpid");
+               dbg("cpid: $cpid") if isdbg('reap');
 #              Msg->pid_gone($cpid);
                $zombies-- if $zombies > 0;
        }
-       dbg('reap', "cpid: $cpid");
+       dbg("cpid: $cpid") if isdbg('reap');
 }
 
 # this is where the input queue is dealt with and things are dispatched off to other parts of
@@ -269,7 +269,7 @@ sub process_inqueue
        return unless defined $sort;
        
        # do the really sexy console interface bit! (Who is going to do the TK interface then?)
-       dbg('chan', "<- $sort $call $line\n") unless $sort eq 'D';
+       dbg("<- $sort $call $line\n") if $sort ne 'D' && isdbg('chan');
 
        # handle A records
        my $user = $dxchan->user;
@@ -349,36 +349,37 @@ $build = "$build.$subbuild" if $subbuild;
 Log('cluster', "DXSpider V$version, build $build started");
 
 # banner
-dbg('err', "DXSpider Version $version, build $build started", "Copyright (c) 1998-2001 Dirk Koopman G1TLH");
+dbg("Copyright (c) 1998-2001 Dirk Koopman G1TLH");
+dbg("DXSpider Version $version, build $build started");
 
 # load Prefixes
-dbg('err', "loading prefixes ...");
+dbg("loading prefixes ...");
 Prefix::load();
 
 # load band data
-dbg('err', "loading band data ...");
+dbg("loading band data ...");
 Bands::load();
 
 # initialise User file system
-dbg('err', "loading user file system ..."); 
+dbg("loading user file system ..."); 
 DXUser->init($userfn, 1);
 
 # start listening for incoming messages/connects
-dbg('err', "starting listeners ...");
+dbg("starting listeners ...");
 my $conn = IntMsg->new_server($clusteraddr, $clusterport, \&login);
 $conn->conns("Server $clusteraddr/$clusterport");
 push @listeners, $conn;
-dbg('err', "Internal port: $clusteraddr $clusterport");
+dbg("Internal port: $clusteraddr $clusterport");
 foreach my $l (@main::listen) {
        $conn = ExtMsg->new_server($l->[0], $l->[1], \&login);
        $conn->conns("Server $l->[0]/$l->[1]");
        push @listeners, $conn;
-       dbg('err', "External Port: $l->[0] $l->[1]");
+       dbg("External Port: $l->[0] $l->[1]");
 }
 AGWrestart();
 
 # load bad words
-dbg('err', "load badwords: " . (BadWords::load or "Ok"));
+dbg("load badwords: " . (BadWords::load or "Ok"));
 
 # prime some signals
 unless ($DB::VERSION) {
@@ -389,15 +390,15 @@ unless ($is_win) {
        $SIG{HUP} = 'IGNORE';
        $SIG{CHLD} = sub { $zombies++ };
        
-       $SIG{PIPE} = sub {      dbg('err', "Broken PIPE signal received"); };
-       $SIG{IO} = sub {        dbg('err', "SIGIO received"); };
+       $SIG{PIPE} = sub {      dbg("Broken PIPE signal received"); };
+       $SIG{IO} = sub {        dbg("SIGIO received"); };
        $SIG{WINCH} = $SIG{STOP} = $SIG{CONT} = 'IGNORE';
        $SIG{KILL} = 'DEFAULT';     # as if it matters....
 
        # catch the rest with a hopeful message
        for (keys %SIG) {
                if (!$SIG{$_}) {
-                       #               dbg('chan', "Catching SIG $_");
+                       #               dbg("Catching SIG $_") if isdbg('chan');
                        $SIG{$_} = sub { my $sig = shift;       DXDebug::confess("Caught signal $sig");  }; 
                }
        }
@@ -420,7 +421,7 @@ WCY->init();
 Spot->init();
 
 # initialise the protocol engine
-dbg('err', "reading in duplicate spot and WWV info ...");
+dbg("reading in duplicate spot and WWV info ...");
 DXProt->init();
 
 # put in a DXCluster node for us here so we can add users and take them away
@@ -433,30 +434,30 @@ unless (Filter::read_in('route', 'node_default', 0)) {
 }
 
 # read in any existing message headers and clean out old crap
-dbg('err', "reading existing message headers ...");
+dbg("reading existing message headers ...");
 DXMsg->init();
 DXMsg::clean_old();
 
 # read in any cron jobs
-dbg('err', "reading cron jobs ...");
+dbg("reading cron jobs ...");
 DXCron->init();
 
 # read in database descriptors
-dbg('err', "reading database descriptors ...");
+dbg("reading database descriptors ...");
 DXDb::load();
 
 # starting local stuff
-dbg('err', "doing local initialisation ...");
+dbg("doing local initialisation ...");
 eval {
        Local::init();
 };
-dbg('local', "Local::init error $@") if $@;
+dbg("Local::init error $@") if $@;
 
 # print various flags
-#dbg('err', "seful info - \$^D: $^D \$^W: $^W \$^S: $^S \$^P: $^P");
+#dbg("seful info - \$^D: $^D \$^W: $^W \$^S: $^S \$^P: $^P");
 
 # this, such as it is, is the main loop!
-dbg('err', "orft we jolly well go ...");
+dbg("orft we jolly well go ...");
 
 #open(DB::OUT, "|tee /tmp/aa");
 
@@ -485,7 +486,7 @@ for (;;) {
                eval { 
                        Local::process();       # do any localised processing
                };
-               dbg('local', "Local::process error $@") if $@;
+               dbg("Local::process error $@") if $@;
        }
        if ($decease) {
                last if --$decease <= 0;
index fc6110a86576ef4846f4662d5c7fedcba72c3569..6ccee4b9f4cd4e28583ab1b3d65e6708f5a87d75 100755 (executable)
@@ -87,7 +87,7 @@ for (@in) {
 sub doconnect
 {
        my ($sort, $line) = @_;
-       dbg('connect', "CONNECT sort: $sort command: $line");
+       dbg("CONNECT sort: $sort command: $line") if isdbg('connect');
        if ($sort eq 'net') {
                # this is a straight network connect
                my ($host) = $line =~ /host\s+(\w+)/o;
@@ -100,7 +100,7 @@ sub doconnect
        } elsif ($sort eq 'ax25') {
                my @args = split /\s+/, $line;
                $pid = open2(\*R, \*W, "$line") or die "can't do $line $!";
-               dbg('connect', "got pid $pid");
+               dbg("got pid $pid") if isdbg('connect');
                W->autoflush(1);
        } else {
                die "can't get here";
@@ -111,21 +111,21 @@ sub doconnect
 sub doabort
 {
        my $string = shift;
-       dbg('connect', "abort $string");
+       dbg("abort $string") if isdbg('connect');
        $abort = $string;
 }
 
 sub dotimeout
 {
        my $val = shift;
-       dbg('connect', "timeout set to $val");
+       dbg("timeout set to $val") if isdbg('connect');
        alarm($timeout = $val);
 }
 
 sub dochat
 {
        my ($expect, $send) = @_;
-       dbg('connect', "CHAT \"$expect\" -> \"$send\"");
+       dbg("CHAT \"$expect\" -> \"$send\"") if isdbg('connect');
     my $line;
 
        alarm($timeout);
@@ -139,9 +139,9 @@ sub dochat
                        $line = <R>;
                        $line =~ s/\r//og;
                }
-               dbg('connect', "received \"$line\"");
+               dbg("received \"$line\"") if isdbg('connect');
                if ($abort && $line =~ /$abort/i) {
-                       dbg('connect', "aborted on /$abort/");
+                       dbg("aborted on /$abort/") if isdbg('connect');
                        exit(11);
                }
        }
@@ -152,18 +152,18 @@ sub dochat
                        local $\ = "\r";
                        W->print("$send\r");
                }
-               dbg('connect', "sent \"$send\"");
+               dbg("sent \"$send\"") if isdbg('connect');
        }
 }
 
 sub doclient
 {
        my ($cl, $args) = @_;
-       dbg('connect', "client: $cl args: $args");
+       dbg("client: $cl args: $args") if isdbg('connect');
     my @args = split /\s+/, $args;
 
 #      if (!defined ($pid = fork())) {
-#              dbg('connect', "can't fork");
+#              dbg("can't fork") if isdbg('connect');
 #              exit(13);
 #      }
 #      if ($pid) {
@@ -182,7 +182,7 @@ sub doclient
                        open STDOUT, ">&W";
                        exec $cl, @args;
                } else {
-                       dbg('connect', "client can't get here");
+                       dbg("client can't get here") if isdbg('connect');
                        exit(13);
                }
 #    }
@@ -190,13 +190,13 @@ sub doclient
 
 sub timeout
 {
-       dbg('connect', "timed out after $timeout seconds");
+       dbg("timed out after $timeout seconds") if isdbg('connect');
        exit(10);
 }
 
 sub term
 {
-       dbg('connect', "caught INT or TERM signal");
+       dbg("caught INT or TERM signal") if isdbg('connect');
        kill $pid if $pid;
        sleep(2);
        exit(12);
@@ -205,5 +205,5 @@ sub term
 sub reap
 {
     my $wpid = wait;
-       dbg('connect', "pid $wpid has died");
+       dbg("pid $wpid has died") if isdbg('connect');
 }