require Exporter;
@ISA = qw(Exporter);
-@EXPORT = qw(dbginit dbg dbgadd dbgsub dbglist isdbg);
+@EXPORT = qw(dbg dbgadd dbgsub dbglist isdbg);
+@EXPORT_OK = qw(dbg dbgadd dbgsub dbglist isdbg);
use strict;
-use vars qw(%dbglevel $dbgfh);
+use vars qw(%dbglevel $fp);
use FileHandle;
use DXUtil;
+use DXLog ();
use Carp;
%dbglevel = ();
-$dbgfh = "";
+$fp = DXLog::new('debug', 'dat', 'd');
no strict 'refs';
-sub dbginit
-{
- my $fhname = shift;
- $dbgfh = new FileHandle;
- $dbgfh->open(">>$fhname") or die "can't open debug file '$fhname' $!";
- $dbgfh->autoflush(1);
-}
-
sub dbg
{
- my $l = shift;
- if ($dbglevel{$l}) {
- print @_;
- print $dbgfh atime, @_ if $dbgfh;
- }
+ my $l = shift;
+ if ($dbglevel{$l}) {
+ for (@_) {
+ s/\n$//og;
+ }
+ my $str = atime . "@_" ;
+ print "$str\n";
+ $fp->writenow($str);
+ }
}
sub dbgadd
{
- my $entry;
-
- foreach $entry (@_) {
- $dbglevel{$entry} = 1;
- }
+ my $entry;
+
+ foreach $entry (@_) {
+ $dbglevel{$entry} = 1;
+ }
}
sub dbgsub
{
- my $entry;
-
- foreach $entry (@_) {
- delete $dbglevel{entry};
- }
+ my $entry;
+
+ foreach $entry (@_) {
+ delete $dbglevel{entry};
+ }
}
sub dbglist
{
- return keys (%dbglevel);
+ return keys (%dbglevel);
}
sub isdbg
{
- return $dbglevel{shift};
+ return $dbglevel{shift};
}
1;
__END__
package DXLog;
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(Log);
+
use FileHandle;
use DXVars;
-use DXDebug;
+use DXDebug ();
use DXUtil;
use Julian;
use Carp;
use strict;
+use vars qw($log);
+
+$log = new('log', 'dat', 'm');
+
# create a log object that contains all the useful info needed
# prefix is the main directory off of the data directory
# sort is 'm' for monthly, 'd' for daily
$self->{year} = $year;
$self->{thing} = $thing;
- dbg("dxlog", "opening $self->{fn}\n");
+ DXDebug::dbg("dxlog", "opening $self->{fn}\n");
return $self->{fh};
}
return $self->open($self->{year}, $self->{thing}, @_);
}
+# convert a date into the correct format from a unix date depending on its sort
+sub unixtoj
+{
+ my $self = shift;
+
+ if ($self->{sort} eq 'm') {
+ return Julian::unixtojm(shift);
+ } elsif ($self->{sort} eq 'd') {
+ return Julian::unixtoj(shift);
+ }
+ confess "shouldn't get here";
+}
+
# write (actually append) to a file, opening new files as required
sub write
{
my ($self, $year, $thing, $line) = @_;
- $self->open($year, $thing, ">>") if (!$self->{fh} ||
- $self->{mode} ne ">>" ||
- $year != $self->{year} ||
- $thing != $self->{thing})
- or confess "can't open $self->{fn} $!";
-
- $self->{fh}->print("$line\n");
- return $self;
+ if (!$self->{fh} ||
+ $self->{mode} ne ">>" ||
+ $year != $self->{year} ||
+ $thing != $self->{thing}) {
+ $self->open($year, $thing, ">>") or confess "can't open $self->{fn} $!";
+ }
+
+ return $self->{fh}->print("$line\n");
}
# write (actually append) using the current date to a file, opening new files as required
sub writenow
{
my ($self, $line) = @_;
- my @date = unixtoj(time) if $self->{sort} = 'd';
- @date = unixtojm(time) if $self->{sort} = 'm';
-
+ my @date = $self->unixtoj(time);
+ return $self->write(@date, $line);
+}
+
+# write (actually append) using a unix time to a file, opening new files as required
+sub writeunix
+{
+ my ($self, $t, $line) = @_;
+ my @date = $self->unixtoj($t);
return $self->write(@date, $line);
}
delete $self->{mode};
}
+# log something in the system log
+# this routine is exported to any module that declares DXLog
+# it takes all its args and joins them together with the unixtime writes them out as one line
+# The user is responsible for making sense of this!
+sub Log
+{
+ $log->writeunix($main::systime, join('^', $main::systime, @_) );
+}
+
sub DESTROY # catch undefs and do what is required further do the tree
{
my $self = shift;
- dbg("dxlog", "closing $self->{fn}\n");
+ DXDebug::dbg("dxlog", "closing $self->{fn}\n");
undef $self->{fh} if defined $self->{fh};
}
1;
# the port number of the cluster (just leave this, unless it REALLY matters to you)
$clusterport = 27754;
-# cluster debug file
-$debugfn = "/tmp/debug_cluster";
-
# your favorite way to say 'Yes'
$yes = 'Yes';
+++ /dev/null
-#
-#
-# main fairly static data area for the cluster
-#
-#
use DXVars;
use DXUtil;
+use DXLog;
+use Julian;
use FileHandle;
use Carp;
use strict;
-use vars qw($date $sfi $k $a $forecast @allowed @denied);
+use vars qw($date $sfi $k $a $forecast @allowed @denied $fp $node $from);
+$fp = 0; # the DXLog fcb
$date = 0; # the unix time of the WWV (notional)
$sfi = 0; # the current SFI value
$k = 0; # the current K value
$a = 0; # the current A value
$forecast = ""; # the current geomagnetic forecast
+$node = ""; # originating node
+$from = ""; # who this came from
@allowed = (); # if present only these callsigns are regarded as valid WWV updators
@denied = (); # if present ignore any wwv from these callsigns
my $dirprefix = "$main::data/wwv";
sub init
{
- mkdir $dirprefix, 0777 if !-e $dirprefix;
- do "$param" if -e "$param";
- confess $@ if $@;
+ $fp = DXLog::new('wwv', 'dat', 'm');
+ mkdir $dirprefix, 0777 if !-e $dirprefix; # now unnecessary DXLog will create it
+ do "$param" if -e "$param";
+ confess $@ if $@;
}
# write the current data away
print $fh "\$sfi = $sfi;\n";
print $fh "\$a = $a;\n";
print $fh "\$k = $k;\n";
- print $fh "\$forecast = '$forecast';\n";
+ print $fh "\$from = '$from';\n";
+ print $fh "\$node = '$node';\n";
print $fh "\@denied = qw(", join(' ', @denied), ");\n" if @denied > 0;
print $fh "\@allowed = qw(", join(' ', @allowed), ");\n" if @allowed > 0;
close $fh;
+
+ # log it
+ $fp->writeunix($date, "$from^$date^$sfi^$a^$k^$forecast^$node\n");
}
# update WWV info in one go (usually from a PC23)
sub update
{
- my ($mydate, $mytime, $mysfi, $mya, $myk, $myforecast, $from, $node) = @_;
+ my ($mydate, $mytime, $mysfi, $mya, $myk, $myforecast, $myfrom, $mynode) = @_;
if ((@allowed && grep {$_ eq $from} @allowed) ||
(@denied && !grep {$_ eq $from} @denied) ||
(@allowed == 0 && @denied == 0)) {
$k = 0 + $myk;
$a = 0 + $mya;
$forecast = $myforecast;
+ $date = $trydate;
+ $from = $myfrom;
+ $node = $mynode;
+
store();
}
}
# compare dates to see whether need to open another save file (remember, redefining $fp
# automagically closes the output file (if any)).
- my @date = Julian::unixtoj($spot[2]);
- $fp->write(@date, $buf);
+ $fp->writeunix($spot[2], $buf);
return $buf;
}
unshift @INC, "$root/perl"; # this IS the right way round!
unshift @INC, "$root/local";
+
+# require Exporter;
+# $Exporter::Verbose = 1;
}
use Msg;
use DXVars;
+use DXDebug;
+use DXLog;
use DXUtil;
use DXChannel;
use DXUser;
use DXProt;
use DXMsg;
use DXCluster;
-use DXDebug;
use DXCron;
use DXConnect;
use Prefix;
#############################################################
# open the debug file, set various FHs to be unbuffered
-dbginit($debugfn);
foreach (@debug) {
dbgadd($_);
}
projects / spider.git / commitdiff