}
# 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
use DXUser;
use DXChannel;
use DB_File;
-use Carp;
+use DXDebug;
@ISA = qw(DXChannel);
use DXUtil;
use DXDebug;
use DXVars;
-use Carp;
use strict;
use vars qw(%bands %regions %aliases $bandsfn %valid);
use DXVars;
use DXDebug;
-use Carp;
use strict;
use DXUtil;
use DXDebug;
use Filter;
-use Carp;
use strict;
use vars qw(%channels %valid);
package DXCluster;
-use Exporter;
-@ISA = qw(Exporter);
use DXDebug;
use DXUtil;
-use Carp;
use strict;
use vars qw(%cluster %valid);
use DXBearing;
use CmdAlias;
use Filter;
-use Carp;
use Minimuf;
use DXDb;
use Sun;
unless (exists $Cache{$package}->{'sub'}) {
$c = eval $Cache{$package}->{'eval'};
if ($@) {
- return ("Syserr: Syntax error in $package", $@);
+ return DXDebug::shortmess($@);
}
$Cache{$package}->{'sub'} = $c;
}
@ans = &{$c}($self, $args);
};
- return ($@) if $@;
+ if ($@) {
+ cluck($@);
+ return (DXDebug::shortmess($@));
+ };
}
} else {
dbg('command', "cmd: $cmd not found");
use DXUtil;
use DXM;
use DXDebug;
-use Carp;
use strict;
use DXM;
use DXDebug;
use IO::File;
-use Carp;
use strict;
use DXLog;
use DXUtil;
use DB_File;
-
-use Carp;
+use DXDebug;
use vars qw($opentime $dbbase %avail %valid $lastprocesstime $nextstream %stream);
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);
%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 $_;
{
# 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(@_)); };
}
}
sub dbg
{
my $l = shift;
- if ($dbglevel{$l}) {
+ if ($dbglevel{$l} || $l eq 'err') {
my @in = @_;
my $t = time;
for (@in) {
my $s = shift;
return $dbglevel{$s};
}
+
+sub shortmess
+{
+ return Carp::shortmess(@_);
+}
+
+sub longmess
+{
+ return Carp::longmess(@_);
+}
+
1;
__END__
+
+
+
+
+
+
+
use IO::File;
use DXVars;
-# use DXDebug ();
use DXUtil;
use Julian;
+
use Carp;
use strict;
use IO::File;
use DXVars;
-use DXDebug ();
+#use DXDebug ();
use DXUtil;
use DXLog;
use Julian;
-use Carp;
use strict;
package DXM;
use DXVars;
-use Carp;
+use DXDebug;
my $localfn = "$main::root/local/Messages";
my $fn = "$main::root/perl/Messages";
use DXLog;
use IO::File;
use Fcntl;
-use Carp;
use strict;
use vars qw(%work @msg $msgdir %valid %busy $maxage $last_clean
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;
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;
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;
$file = new IO::File;
if (!open($file, $fn)) {
- print "Error reading $fn $!\n";
+ dbg('err' ,"Error reading $fn $!");
return undef;
}
@out = map {chomp; $_} <$file>;
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 $!";
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
use DXUtil;
use DXM;
-use Carp;
+use DXDebug;
use strict;
use DB_File;
use Data::Dumper;
use Fcntl;
-use Carp;
+use DXDebug;
use strict;
use vars qw(%u $dbm $filename %valid);
use IO::File;
use Data::Dumper;
-use Carp;
+use DXDebug;
require Exporter;
@ISA = qw(Exporter);
use DXVars;
use DXUtil;
use DXDebug;
-use Carp;
use strict;
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);
package Julian;
-use Carp;
-
use strict;
my @days = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
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 = ();
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);
use DXLog;
use Julian;
use Prefix;
-use Carp;
use strict;
use vars qw($fp $maxspots $defaultspots $maxdays $dirprefix);
use IO::File;
use IO::Socket;
use IPC::Open2;
-use Carp qw{cluck};
# cease communications
sub cease
use Fcntl ':flock';
-use Carp qw(cluck);
-
package main;
@inqueue = (); # the main input queue, an array of hashes
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
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();
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");
use IO::File;
use Curses;
-use Carp qw{cluck};
-
use Console;
#
projects / spider.git / commitdiff