added new debugging to daily file logging

added Filter and MiscLog.pm RFU
added logging for WWV
This commit is contained in:
djk 1998-11-13 12:28:46 +00:00
parent ce0803e211
commit 50bafbfa09
9 changed files with 101 additions and 59 deletions

View File

@ -11,63 +11,61 @@ package DXDebug;
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__

View File

@ -25,15 +25,23 @@
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
@ -76,7 +84,7 @@ sub open
$self->{year} = $year;
$self->{thing} = $thing;
dbg("dxlog", "opening $self->{fn}\n");
DXDebug::dbg("dxlog", "opening $self->{fn}\n");
return $self->{fh};
}
@ -105,27 +113,46 @@ sub opennext
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} $!";
if (!$self->{fh} ||
$self->{mode} ne ">>" ||
$year != $self->{year} ||
$thing != $self->{thing}) {
$self->open($year, $thing, ">>") or confess "can't open $self->{fn} $!";
}
$self->{fh}->print("$line\n");
return $self;
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);
}
@ -138,10 +165,19 @@ sub close
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;

View File

@ -59,9 +59,6 @@ $clusteraddr = "localhost";
# 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';

View File

@ -1,5 +0,0 @@
#
#
# main fairly static data area for the cluster
#
#

0
perl/Filter.pm Normal file
View File

View File

@ -11,17 +11,22 @@ package Geomag;
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";
@ -29,9 +34,10 @@ my $param = "$dirprefix/param";
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
@ -44,16 +50,20 @@ sub store
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)) {
@ -64,6 +74,10 @@ sub update
$k = 0 + $myk;
$a = 0 + $mya;
$forecast = $myforecast;
$date = $trydate;
$from = $myfrom;
$node = $mynode;
store();
}
}

0
perl/MiscLog.pm Normal file
View File

View File

@ -57,8 +57,7 @@ sub add
# 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;
}

View File

@ -18,10 +18,15 @@ BEGIN {
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;
@ -30,7 +35,6 @@ use DXCommandmode;
use DXProt;
use DXMsg;
use DXCluster;
use DXDebug;
use DXCron;
use DXConnect;
use Prefix;
@ -167,7 +171,6 @@ sub process_inqueue
#############################################################
# open the debug file, set various FHs to be unbuffered
dbginit($debugfn);
foreach (@debug) {
dbgadd($_);
}