From 101516b420ac77cd9eb8294651104e43f3461c06 Mon Sep 17 00:00:00 2001 From: minima Date: Thu, 14 Jun 2001 15:44:16 +0000 Subject: [PATCH] changed debug api interface to use less CPU --- Changes | 2 + cmd/export.pl | 2 +- cmd/show/qrz.pl | 2 +- perl/AGWMsg.pm | 46 +++++++++++----------- perl/DXChannel.pm | 14 +++---- perl/DXCluster.pm | 12 +++--- perl/DXCommandmode.pm | 24 +++++------ perl/DXCron.pm | 20 +++++----- perl/DXDebug.pm | 39 +++++++++--------- perl/DXHash.pm | 2 +- perl/DXLog.pm | 2 +- perl/DXMsg.pm | 92 +++++++++++++++++++++---------------------- perl/DXProt.pm | 78 ++++++++++++++++++------------------ perl/DXUser.pm | 4 +- perl/ExtMsg.pm | 44 ++++++++++----------- perl/Filter.pm | 6 +-- perl/Msg.pm | 12 +++--- perl/Route.pm | 16 ++++---- perl/Route/Node.pm | 4 +- perl/Route/User.pm | 2 +- perl/Spot.pm | 2 +- perl/Timer.pm | 4 +- perl/cluster.pl | 53 +++++++++++++------------ perl/connect.pl | 28 ++++++------- 24 files changed, 255 insertions(+), 255 deletions(-) diff --git a/Changes b/Changes index a62ab090..798a2909 100644 --- 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 diff --git a/cmd/export.pl b/cmd/export.pl index 723cdcb6..4616564f 100644 --- a/cmd/export.pl +++ b/cmd/export.pl @@ -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); } diff --git a/cmd/show/qrz.pl b/cmd/show/qrz.pl index 6779db42..c20be45d 100644 --- a/cmd/show/qrz.pl +++ b/cmd/show/qrz.pl @@ -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') { diff --git a/perl/AGWMsg.pm b/perl/AGWMsg.pm index a3253a5e..2e74da7b 100644 --- a/perl/AGWMsg.pm +++ b/perl/AGWMsg.pm @@ -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'); } } diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index e7022222..f1e711e0 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -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(); } diff --git a/perl/DXCluster.pm b/perl/DXCluster.pm index 1b810654..36d1d20f 100644 --- a/perl/DXCluster.pm +++ b/perl/DXCluster.pm @@ -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--; diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 9dc967b6..32b1f86c 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -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'); } } diff --git a/perl/DXCron.pm b/perl/DXCron.pm index 39776dcc..589dd246 100644 --- a/perl/DXCron.pm +++ b/perl/DXCron.pm @@ -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; diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm index 2cbdc295..4b8d4f25 100644 --- a/perl/DXDebug.pm +++ b/perl/DXDebug.pm @@ -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 diff --git a/perl/DXHash.pm b/perl/DXHash.pm index c809dfd3..870ac9cc 100644 --- a/perl/DXHash.pm +++ b/perl/DXHash.pm @@ -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; } diff --git a/perl/DXLog.pm b/perl/DXLog.pm index 03dc4284..9f15c225 100644 --- a/perl/DXLog.pm +++ b/perl/DXLog.pm @@ -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}; } diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 3ca75689..0d57ca7d 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -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) { diff --git a/perl/DXProt.pm b/perl/DXProt.pm index fc08f542..03887493 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -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'); } } } diff --git a/perl/DXUser.pm b/perl/DXUser.pm index ca73a02e..23996b07 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -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; diff --git a/perl/ExtMsg.pm b/perl/ExtMsg.pm index be7d0e84..7b33b6e2 100644 --- a/perl/ExtMsg.pm +++ b/perl/ExtMsg.pm @@ -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; diff --git a/perl/Filter.pm b/perl/Filter.pm index a37ea0d2..5f6b9bf1 100644 --- a/perl/Filter.pm +++ b/perl/Filter.pm @@ -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); } diff --git a/perl/Msg.pm b/perl/Msg.pm index 8be2fc1b..94f19e6f 100644 --- a/perl/Msg.pm +++ b/perl/Msg.pm @@ -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--; } diff --git a/perl/Route.pm b/perl/Route.pm index d76cad19..61d07249 100644 --- a/perl/Route.pm +++ b/perl/Route.pm @@ -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; diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index eb2f536b..6b4f4332 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -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'); } # diff --git a/perl/Route/User.pm b/perl/Route/User.pm index 2bbfe5b7..d492c27b 100644 --- a/perl/Route/User.pm +++ b/perl/Route/User.pm @@ -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; } diff --git a/perl/Spot.pm b/perl/Spot.pm index 8b66b0f6..8e836678 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -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( diff --git a/perl/Timer.pm b/perl/Timer.pm index 281421f0..683497d2 100644 --- a/perl/Timer.pm +++ b/perl/Timer.pm @@ -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; diff --git a/perl/cluster.pl b/perl/cluster.pl index 904797ad..9848e76f 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -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; diff --git a/perl/connect.pl b/perl/connect.pl index fc6110a8..6ccee4b9 100755 --- a/perl/connect.pl +++ b/perl/connect.pl @@ -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 = ; $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'); } -- 2.34.1