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; require Exporter;
@ISA = qw(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 strict;
use vars qw(%dbglevel $dbgfh); use vars qw(%dbglevel $fp);
use FileHandle; use FileHandle;
use DXUtil; use DXUtil;
use DXLog ();
use Carp; use Carp;
%dbglevel = (); %dbglevel = ();
$dbgfh = ""; $fp = DXLog::new('debug', 'dat', 'd');
no strict 'refs'; 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 sub dbg
{ {
my $l = shift; my $l = shift;
if ($dbglevel{$l}) { if ($dbglevel{$l}) {
print @_; for (@_) {
print $dbgfh atime, @_ if $dbgfh; s/\n$//og;
} }
my $str = atime . "@_" ;
print "$str\n";
$fp->writenow($str);
}
} }
sub dbgadd sub dbgadd
{ {
my $entry; my $entry;
foreach $entry (@_) { foreach $entry (@_) {
$dbglevel{$entry} = 1; $dbglevel{$entry} = 1;
} }
} }
sub dbgsub sub dbgsub
{ {
my $entry; my $entry;
foreach $entry (@_) { foreach $entry (@_) {
delete $dbglevel{entry}; delete $dbglevel{entry};
} }
} }
sub dbglist sub dbglist
{ {
return keys (%dbglevel); return keys (%dbglevel);
} }
sub isdbg sub isdbg
{ {
return $dbglevel{shift}; return $dbglevel{shift};
} }
1; 1;
__END__ __END__

View File

@ -25,15 +25,23 @@
package DXLog; package DXLog;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(Log);
use FileHandle; use FileHandle;
use DXVars; use DXVars;
use DXDebug; use DXDebug ();
use DXUtil; use DXUtil;
use Julian; use Julian;
use Carp; use Carp;
use strict; use strict;
use vars qw($log);
$log = new('log', 'dat', 'm');
# create a log object that contains all the useful info needed # create a log object that contains all the useful info needed
# prefix is the main directory off of the data directory # prefix is the main directory off of the data directory
# sort is 'm' for monthly, 'd' for daily # sort is 'm' for monthly, 'd' for daily
@ -76,7 +84,7 @@ sub open
$self->{year} = $year; $self->{year} = $year;
$self->{thing} = $thing; $self->{thing} = $thing;
dbg("dxlog", "opening $self->{fn}\n"); DXDebug::dbg("dxlog", "opening $self->{fn}\n");
return $self->{fh}; return $self->{fh};
} }
@ -105,27 +113,46 @@ sub opennext
return $self->open($self->{year}, $self->{thing}, @_); 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 # write (actually append) to a file, opening new files as required
sub write sub write
{ {
my ($self, $year, $thing, $line) = @_; my ($self, $year, $thing, $line) = @_;
$self->open($year, $thing, ">>") if (!$self->{fh} || if (!$self->{fh} ||
$self->{mode} ne ">>" || $self->{mode} ne ">>" ||
$year != $self->{year} || $year != $self->{year} ||
$thing != $self->{thing}) $thing != $self->{thing}) {
or confess "can't open $self->{fn} $!"; $self->open($year, $thing, ">>") or confess "can't open $self->{fn} $!";
}
$self->{fh}->print("$line\n"); return $self->{fh}->print("$line\n");
return $self;
} }
# write (actually append) using the current date to a file, opening new files as required # write (actually append) using the current date to a file, opening new files as required
sub writenow sub writenow
{ {
my ($self, $line) = @_; my ($self, $line) = @_;
my @date = unixtoj(time) if $self->{sort} = 'd'; my @date = $self->unixtoj(time);
@date = unixtojm(time) if $self->{sort} = 'm'; 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); return $self->write(@date, $line);
} }
@ -138,10 +165,19 @@ sub close
delete $self->{mode}; 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 sub DESTROY # catch undefs and do what is required further do the tree
{ {
my $self = shift; my $self = shift;
dbg("dxlog", "closing $self->{fn}\n"); DXDebug::dbg("dxlog", "closing $self->{fn}\n");
undef $self->{fh} if defined $self->{fh}; undef $self->{fh} if defined $self->{fh};
} }
1; 1;

View File

@ -59,9 +59,6 @@ $clusteraddr = "localhost";
# the port number of the cluster (just leave this, unless it REALLY matters to you) # the port number of the cluster (just leave this, unless it REALLY matters to you)
$clusterport = 27754; $clusterport = 27754;
# cluster debug file
$debugfn = "/tmp/debug_cluster";
# your favorite way to say 'Yes' # your favorite way to say 'Yes'
$yes = '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 DXVars;
use DXUtil; use DXUtil;
use DXLog;
use Julian;
use FileHandle; use FileHandle;
use Carp; use Carp;
use strict; 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) $date = 0; # the unix time of the WWV (notional)
$sfi = 0; # the current SFI value $sfi = 0; # the current SFI value
$k = 0; # the current K value $k = 0; # the current K value
$a = 0; # the current A value $a = 0; # the current A value
$forecast = ""; # the current geomagnetic forecast $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 @allowed = (); # if present only these callsigns are regarded as valid WWV updators
@denied = (); # if present ignore any wwv from these callsigns @denied = (); # if present ignore any wwv from these callsigns
my $dirprefix = "$main::data/wwv"; my $dirprefix = "$main::data/wwv";
@ -29,9 +34,10 @@ my $param = "$dirprefix/param";
sub init sub init
{ {
mkdir $dirprefix, 0777 if !-e $dirprefix; $fp = DXLog::new('wwv', 'dat', 'm');
do "$param" if -e "$param"; mkdir $dirprefix, 0777 if !-e $dirprefix; # now unnecessary DXLog will create it
confess $@ if $@; do "$param" if -e "$param";
confess $@ if $@;
} }
# write the current data away # write the current data away
@ -44,16 +50,20 @@ sub store
print $fh "\$sfi = $sfi;\n"; print $fh "\$sfi = $sfi;\n";
print $fh "\$a = $a;\n"; print $fh "\$a = $a;\n";
print $fh "\$k = $k;\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 "\@denied = qw(", join(' ', @denied), ");\n" if @denied > 0;
print $fh "\@allowed = qw(", join(' ', @allowed), ");\n" if @allowed > 0; print $fh "\@allowed = qw(", join(' ', @allowed), ");\n" if @allowed > 0;
close $fh; 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) # update WWV info in one go (usually from a PC23)
sub update 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) || if ((@allowed && grep {$_ eq $from} @allowed) ||
(@denied && !grep {$_ eq $from} @denied) || (@denied && !grep {$_ eq $from} @denied) ||
(@allowed == 0 && @denied == 0)) { (@allowed == 0 && @denied == 0)) {
@ -64,6 +74,10 @@ sub update
$k = 0 + $myk; $k = 0 + $myk;
$a = 0 + $mya; $a = 0 + $mya;
$forecast = $myforecast; $forecast = $myforecast;
$date = $trydate;
$from = $myfrom;
$node = $mynode;
store(); 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 # compare dates to see whether need to open another save file (remember, redefining $fp
# automagically closes the output file (if any)). # automagically closes the output file (if any)).
my @date = Julian::unixtoj($spot[2]); $fp->writeunix($spot[2], $buf);
$fp->write(@date, $buf);
return $buf; return $buf;
} }

View File

@ -18,10 +18,15 @@ BEGIN {
unshift @INC, "$root/perl"; # this IS the right way round! unshift @INC, "$root/perl"; # this IS the right way round!
unshift @INC, "$root/local"; unshift @INC, "$root/local";
# require Exporter;
# $Exporter::Verbose = 1;
} }
use Msg; use Msg;
use DXVars; use DXVars;
use DXDebug;
use DXLog;
use DXUtil; use DXUtil;
use DXChannel; use DXChannel;
use DXUser; use DXUser;
@ -30,7 +35,6 @@ use DXCommandmode;
use DXProt; use DXProt;
use DXMsg; use DXMsg;
use DXCluster; use DXCluster;
use DXDebug;
use DXCron; use DXCron;
use DXConnect; use DXConnect;
use Prefix; use Prefix;
@ -167,7 +171,6 @@ sub process_inqueue
############################################################# #############################################################
# open the debug file, set various FHs to be unbuffered # open the debug file, set various FHs to be unbuffered
dbginit($debugfn);
foreach (@debug) { foreach (@debug) {
dbgadd($_); dbgadd($_);
} }