From 0bd9d2811cc42417676a1b11b121681c2377d70a Mon Sep 17 00:00:00 2001 From: djk Date: Fri, 9 Jun 2000 17:29:34 +0000 Subject: [PATCH] get all the debugging finally into the debug files when things go wrong added 'err' as a catchall dbg category changed all the print stdout statements to dbg('err', ...) --- cmd/dx.pl | 2 +- perl/BBS.pm | 2 +- perl/Bands.pm | 1 - perl/CmdAlias.pm | 1 - perl/DXChannel.pm | 1 - perl/DXCluster.pm | 3 --- perl/DXCommandmode.pm | 8 ++++--- perl/DXConnect.pm | 1 - perl/DXCron.pm | 1 - perl/DXDb.pm | 3 +-- perl/DXDebug.pm | 50 +++++++++++++++++++++++++++++++++++++------ perl/DXLog.pm | 2 +- perl/DXLogPrint.pm | 3 +-- perl/DXM.pm | 2 +- perl/DXMsg.pm | 19 ++++++++-------- perl/DXProt.pm | 2 -- perl/DXProtout.pm | 2 +- perl/DXUser.pm | 2 +- perl/DXUtil.pm | 2 +- perl/Filter.pm | 1 - perl/Geomag.pm | 2 +- perl/Julian.pm | 2 -- perl/Msg.pm | 7 ++---- perl/Prefix.pm | 3 +-- perl/Spot.pm | 1 - perl/client.pl | 1 - perl/cluster.pl | 28 +++++++++++------------- perl/console.pl | 2 -- 28 files changed, 84 insertions(+), 70 deletions(-) diff --git a/cmd/dx.pl b/cmd/dx.pl index c946d761..7684542e 100644 --- a/cmd/dx.pl +++ b/cmd/dx.pl @@ -43,7 +43,7 @@ if ($f[0] =~ /[A-Za-z]/) { } # make line the rest of the line -$line = $f[2]; +$line = $f[2] || " "; @f = split /\s+/, $line; # bash down the list of bands until a valid one is reached diff --git a/perl/BBS.pm b/perl/BBS.pm index e2920a47..68bf4314 100644 --- a/perl/BBS.pm +++ b/perl/BBS.pm @@ -15,7 +15,7 @@ use strict; use DXUser; use DXChannel; use DB_File; -use Carp; +use DXDebug; @ISA = qw(DXChannel); diff --git a/perl/Bands.pm b/perl/Bands.pm index 7e67a60e..16a992ed 100644 --- a/perl/Bands.pm +++ b/perl/Bands.pm @@ -11,7 +11,6 @@ package Bands; use DXUtil; use DXDebug; use DXVars; -use Carp; use strict; use vars qw(%bands %regions %aliases $bandsfn %valid); diff --git a/perl/CmdAlias.pm b/perl/CmdAlias.pm index 2a5e26cf..39136bd1 100644 --- a/perl/CmdAlias.pm +++ b/perl/CmdAlias.pm @@ -21,7 +21,6 @@ package CmdAlias; use DXVars; use DXDebug; -use Carp; use strict; diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 4ded6267..e60705b1 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -30,7 +30,6 @@ use DXM; use DXUtil; use DXDebug; use Filter; -use Carp; use strict; use vars qw(%channels %valid); diff --git a/perl/DXCluster.pm b/perl/DXCluster.pm index 205c30fb..5d35e4a3 100644 --- a/perl/DXCluster.pm +++ b/perl/DXCluster.pm @@ -14,11 +14,8 @@ package DXCluster; -use Exporter; -@ISA = qw(Exporter); use DXDebug; use DXUtil; -use Carp; use strict; use vars qw(%cluster %valid); diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 39153ea4..4a1acbba 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -24,7 +24,6 @@ use DXLogPrint; use DXBearing; use CmdAlias; use Filter; -use Carp; use Minimuf; use DXDb; use Sun; @@ -246,7 +245,7 @@ sub run_cmd unless (exists $Cache{$package}->{'sub'}) { $c = eval $Cache{$package}->{'eval'}; if ($@) { - return ("Syserr: Syntax error in $package", $@); + return DXDebug::shortmess($@); } $Cache{$package}->{'sub'} = $c; } @@ -255,7 +254,10 @@ sub run_cmd @ans = &{$c}($self, $args); }; - return ($@) if $@; + if ($@) { + cluck($@); + return (DXDebug::shortmess($@)); + }; } } else { dbg('command', "cmd: $cmd not found"); diff --git a/perl/DXConnect.pm b/perl/DXConnect.pm index 30cd77f3..a98c0c82 100644 --- a/perl/DXConnect.pm +++ b/perl/DXConnect.pm @@ -13,7 +13,6 @@ package DXConnect; use DXUtil; use DXM; use DXDebug; -use Carp; use strict; diff --git a/perl/DXCron.pm b/perl/DXCron.pm index d2e434bc..eefa2581 100644 --- a/perl/DXCron.pm +++ b/perl/DXCron.pm @@ -13,7 +13,6 @@ use DXUtil; use DXM; use DXDebug; use IO::File; -use Carp; use strict; diff --git a/perl/DXDb.pm b/perl/DXDb.pm index 25e7c082..a7f31acc 100644 --- a/perl/DXDb.pm +++ b/perl/DXDb.pm @@ -12,8 +12,7 @@ use DXVars; use DXLog; use DXUtil; use DB_File; - -use Carp; +use DXDebug; use vars qw($opentime $dbbase %avail %valid $lastprocesstime $nextstream %stream); diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm index 80ef17ef..b42db66d 100644 --- a/perl/DXDebug.pm +++ b/perl/DXDebug.pm @@ -11,8 +11,7 @@ package DXDebug; require Exporter; @ISA = qw(Exporter); -@EXPORT = qw(dbginit dbg dbgadd dbgsub dbglist isdbg dbgclose); -@EXPORT_OK = qw(dbginit dbg dbgadd dbgsub dbglist isdbg dbgclose); +@EXPORT = qw(dbginit dbg dbgadd dbgsub dbglist isdbg dbgclose confess croak cluck cluck); use strict; use vars qw(%dbglevel $fp); @@ -24,11 +23,31 @@ use Carp; %dbglevel = (); $fp = DXLog::new('debug', 'dat', 'd'); +# Avoid generating "subroutine redefined" warnings with the following +# hack (from CGI::Carp): +if (!defined $DB::VERSION) { + local $^W=0; + eval qq( sub confess { + \$SIG{__DIE__} = 'DEFAULT'; + DXDebug::_store(Carp::longmess(\@_)); + exit(-1); + } + sub confess { + \$SIG{__DIE__} = 'DEFAULT'; + DXDebug::_store(Carp::shortmess(\@_)); + exit(-1); + } + sub carp { DXDebug::_store(Carp::shortmess(\@_)); } + sub cluck { DXDebug::_store(Carp::longmess(\@_)); } + ); + + CORE::die(Carp::shortmess($@)) if $@; +} + + sub _store { my $t = time; - $fp->writeunix($t, "$t^$@") if $@; - $fp->writeunix($t, "$t^$!") if $!; for (@_) { $fp->writeunix($t, "$t^$_"); print STDERR $_; @@ -39,7 +58,8 @@ sub dbginit { # add sig{__DIE__} handling if (!defined $DB::VERSION) { - $SIG{__WARN__} = $SIG{__DIE__} = \&_store; + $SIG{__WARN__} = sub { _store(Carp::shortmess(@_)); }; + $SIG{__DIE__} = sub { _store(Carp::shortmess(@_)); }; } } @@ -52,7 +72,7 @@ sub dbgclose sub dbg { my $l = shift; - if ($dbglevel{$l}) { + if ($dbglevel{$l} || $l eq 'err') { my @in = @_; my $t = time; for (@in) { @@ -92,5 +112,23 @@ sub isdbg my $s = shift; return $dbglevel{$s}; } + +sub shortmess +{ + return Carp::shortmess(@_); +} + +sub longmess +{ + return Carp::longmess(@_); +} + 1; __END__ + + + + + + + diff --git a/perl/DXLog.pm b/perl/DXLog.pm index 17559b36..03dc4284 100644 --- a/perl/DXLog.pm +++ b/perl/DXLog.pm @@ -31,9 +31,9 @@ require Exporter; use IO::File; use DXVars; -# use DXDebug (); use DXUtil; use Julian; + use Carp; use strict; diff --git a/perl/DXLogPrint.pm b/perl/DXLogPrint.pm index b287413d..60f8b685 100644 --- a/perl/DXLogPrint.pm +++ b/perl/DXLogPrint.pm @@ -10,11 +10,10 @@ package DXLog; use IO::File; use DXVars; -use DXDebug (); +#use DXDebug (); use DXUtil; use DXLog; use Julian; -use Carp; use strict; diff --git a/perl/DXM.pm b/perl/DXM.pm index 30a0cc1e..ee2f4539 100644 --- a/perl/DXM.pm +++ b/perl/DXM.pm @@ -17,7 +17,7 @@ package DXM; use DXVars; -use Carp; +use DXDebug; my $localfn = "$main::root/local/Messages"; my $fn = "$main::root/perl/Messages"; diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index 9e4893b2..0bfdfefb 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -28,7 +28,6 @@ use DXDebug; use DXLog; use IO::File; use Fcntl; -use Carp; use strict; use vars qw(%work @msg $msgdir %valid %busy $maxage $last_clean @@ -504,9 +503,9 @@ sub read_msg_header my @f; my $size; - $file = new IO::File; - if (!open($file, $fn)) { - print "Error reading $fn $!\n"; + $file = new IO::File "$fn"; + if (!$file) { + dbg('err', "Error reading $fn $!"); return undef; } $size = -s $fn; @@ -514,7 +513,7 @@ sub read_msg_header chomp $line; $size -= length $line; if (! $line =~ /^===/o) { - print "corrupt first line in $fn ($line)\n"; + dbg('err', "corrupt first line in $fn ($line)"); return undef; } $line =~ s/^=== //o; @@ -525,7 +524,7 @@ sub read_msg_header chomp $line; $size -= length $line; if (! $line =~ /^===/o) { - print "corrupt second line in $fn ($line)\n"; + dbg('err', "corrupt second line in $fn ($line)"); return undef; } $line =~ s/^=== //o; @@ -551,7 +550,7 @@ sub read_msg_body $file = new IO::File; if (!open($file, $fn)) { - print "Error reading $fn $!\n"; + dbg('err' ,"Error reading $fn $!"); return undef; } @out = map {chomp; $_} <$file>; @@ -740,9 +739,9 @@ sub init my $ref; # load various control files - print "load badmsg: ", (load_badmsg() or "Ok"), "\n"; - print "load forward: ", (load_forward() or "Ok"), "\n"; - print "load swop: ", (load_swop() or "Ok"), "\n"; + dbg('err', "load badmsg: " . (load_badmsg() or "Ok")); + dbg('err', "load forward: " . (load_forward() or "Ok")); + dbg('err', "load swop: " . (load_swop() or "Ok")); # read in the directory opendir($dir, $msgdir) or confess "can't open $msgdir $!"; diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 3d3894d1..256eb9c7 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -27,8 +27,6 @@ use Local; use DXDb; use Time::HiRes qw(gettimeofday tv_interval); -use Carp; - use strict; use vars qw($me $pc11_max_age $pc23_max_age $pc11_dup_age $pc23_dup_age %spotdup %wwvdup $last_hour %pings %rcmds $pc11duptext diff --git a/perl/DXProtout.pm b/perl/DXProtout.pm index ee761cdc..da2d5fff 100644 --- a/perl/DXProtout.pm +++ b/perl/DXProtout.pm @@ -15,7 +15,7 @@ package DXProt; use DXUtil; use DXM; -use Carp; +use DXDebug; use strict; diff --git a/perl/DXUser.pm b/perl/DXUser.pm index 63dad4f3..2357ec05 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -15,7 +15,7 @@ use DXLog; use DB_File; use Data::Dumper; use Fcntl; -use Carp; +use DXDebug; use strict; use vars qw(%u $dbm $filename %valid); diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index de9ea018..0911d6ff 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -12,7 +12,7 @@ use Date::Parse; use IO::File; use Data::Dumper; -use Carp; +use DXDebug; require Exporter; @ISA = qw(Exporter); diff --git a/perl/Filter.pm b/perl/Filter.pm index aefa9224..a53ae034 100644 --- a/perl/Filter.pm +++ b/perl/Filter.pm @@ -48,7 +48,6 @@ package Filter; use DXVars; use DXUtil; use DXDebug; -use Carp; use strict; diff --git a/perl/Geomag.pm b/perl/Geomag.pm index 1a1a8a40..ca16e363 100644 --- a/perl/Geomag.pm +++ b/perl/Geomag.pm @@ -15,7 +15,7 @@ use DXUtil; use DXLog; use Julian; use IO::File; -use Carp; +use DXDebug; use strict; use vars qw($date $sfi $k $a $r $forecast @allowed @denied $fp $node $from); diff --git a/perl/Julian.pm b/perl/Julian.pm index 07bf3849..861f84d4 100644 --- a/perl/Julian.pm +++ b/perl/Julian.pm @@ -8,8 +8,6 @@ package Julian; -use Carp; - use strict; my @days = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); diff --git a/perl/Msg.pm b/perl/Msg.pm index b3816df3..f5704a81 100644 --- a/perl/Msg.pm +++ b/perl/Msg.pm @@ -10,15 +10,12 @@ package Msg; -require Exporter; -@ISA = qw(Exporter); - use strict; use IO::Select; use IO::Socket; -use Carp; +#use DXDebug; -use vars qw (%rd_callbacks %wt_callbacks $rd_handles $wt_handles); +use vars qw(%rd_callbacks %wt_callbacks $rd_handles $wt_handles); %rd_callbacks = (); %wt_callbacks = (); diff --git a/perl/Prefix.pm b/perl/Prefix.pm index b71f754e..41a95db8 100644 --- a/perl/Prefix.pm +++ b/perl/Prefix.pm @@ -9,11 +9,10 @@ package Prefix; use IO::File; -use Carp; use DXVars; use DB_File; use Data::Dumper; -use Carp; +use DXDebug; use strict; use vars qw($db %prefix_loc %pre); diff --git a/perl/Spot.pm b/perl/Spot.pm index d663c9bd..362e7d5e 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -15,7 +15,6 @@ use DXUtil; use DXLog; use Julian; use Prefix; -use Carp; use strict; use vars qw($fp $maxspots $defaultspots $maxdays $dirprefix); diff --git a/perl/client.pl b/perl/client.pl index 1935b892..6327ee5f 100755 --- a/perl/client.pl +++ b/perl/client.pl @@ -46,7 +46,6 @@ use Net::Telnet qw(TELOPT_ECHO); use IO::File; use IO::Socket; use IPC::Open2; -use Carp qw{cluck}; # cease communications sub cease diff --git a/perl/cluster.pl b/perl/cluster.pl index 3990410d..7b5bf6f4 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -64,8 +64,6 @@ use Data::Dumper; use Fcntl ':flock'; -use Carp qw(cluck); - package main; @inqueue = (); # the main input queue, an array of hashes @@ -301,22 +299,22 @@ STDOUT->autoflush(1); Log('cluster', "DXSpider V$version started"); # banner -print "DXSpider DX Cluster Version $version\nCopyright (c) 1998-1999 Dirk Koopman G1TLH\n"; +dbg('err', "DXSpider DX Cluster Version $version\nCopyright (c) 1998-1999 Dirk Koopman G1TLH"); # load Prefixes -print "loading prefixes ...\n"; +dbg('err', "loading prefixes ..."); Prefix::load(); # load band data -print "loading band data ...\n"; +dbg('err', "loading band data ..."); Bands::load(); # initialise User file system -print "loading user file system ...\n"; +dbg('err', "loading user file system ..."); DXUser->init($userfn, 1); # start listening for incoming messages/connects -print "starting listener ...\n"; +dbg('err', "starting listener ..."); Msg->new_server("$clusteraddr", $clusterport, \&login); # prime some signals @@ -338,7 +336,7 @@ Geomag->init(); Spot->init(); # initialise the protocol engine -print "reading in duplicate spot and WWV info ...\n"; +dbg('err', "reading in duplicate spot and WWV info ..."); DXProt->init(); @@ -346,31 +344,31 @@ DXProt->init(); DXNode->new(0, $mycall, 0, 1, $DXProt::myprot_version); # read in any existing message headers and clean out old crap -print "reading existing message headers ...\n"; +dbg('err', "reading existing message headers ..."); DXMsg->init(); DXMsg::clean_old(); # read in any cron jobs -print "reading cron jobs ...\n"; +dbg('err', "reading cron jobs ..."); DXCron->init(); # read in database descriptors -print "reading database descriptors ...\n"; +dbg('err', "reading database descriptors ..."); DXDb::load(); # starting local stuff -print "doing local initialisation ...\n"; +dbg('err', "doing local initialisation ..."); eval { Local::init(); }; dbg('local', "Local::init error $@") if $@; # print various flags -#print "useful info - \$^D: $^D \$^W: $^W \$^S: $^S \$^P: $^P\n"; +#dbg('err', "seful info - \$^D: $^D \$^W: $^W \$^S: $^S \$^P: $^P"); # this, such as it is, is the main loop! -print "orft we jolly well go ...\n"; -dbg('chan', "DXSpider version $version started..."); +dbg('err', "orft we jolly well go ..."); +Log('err', "DXSpider version $version started..."); #open(DB::OUT, "|tee /tmp/aa"); diff --git a/perl/console.pl b/perl/console.pl index d5224cf9..5fd965ee 100755 --- a/perl/console.pl +++ b/perl/console.pl @@ -32,8 +32,6 @@ use DXUtil; use IO::File; use Curses; -use Carp qw{cluck}; - use Console; # -- 2.34.1