From 50bafbfa099ff0847beeb30e41bc62a361ef0536 Mon Sep 17 00:00:00 2001 From: djk Date: Fri, 13 Nov 1998 12:28:46 +0000 Subject: [PATCH] added new debugging to daily file logging added Filter and MiscLog.pm RFU added logging for WWV --- perl/DXDebug.pm | 54 ++++++++++++++++++++--------------------- perl/DXLog.pm | 64 ++++++++++++++++++++++++++++++++++++++----------- perl/DXVars.pm | 3 --- perl/DXdata.pm | 5 ---- perl/Filter.pm | 0 perl/Geomag.pm | 26 +++++++++++++++----- perl/MiscLog.pm | 0 perl/Spot.pm | 3 +-- perl/cluster.pl | 7 ++++-- 9 files changed, 102 insertions(+), 60 deletions(-) delete mode 100644 perl/DXdata.pm create mode 100644 perl/Filter.pm create mode 100644 perl/MiscLog.pm diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm index 084401ed..611df547 100644 --- a/perl/DXDebug.pm +++ b/perl/DXDebug.pm @@ -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__ diff --git a/perl/DXLog.pm b/perl/DXLog.pm index f73c3195..5b5914b4 100644 --- a/perl/DXLog.pm +++ b/perl/DXLog.pm @@ -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} $!"; - - $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); } @@ -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; diff --git a/perl/DXVars.pm b/perl/DXVars.pm index 145631fd..b35689bc 100644 --- a/perl/DXVars.pm +++ b/perl/DXVars.pm @@ -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'; diff --git a/perl/DXdata.pm b/perl/DXdata.pm deleted file mode 100644 index e121fa09..00000000 --- a/perl/DXdata.pm +++ /dev/null @@ -1,5 +0,0 @@ -# -# -# main fairly static data area for the cluster -# -# diff --git a/perl/Filter.pm b/perl/Filter.pm new file mode 100644 index 00000000..e69de29b diff --git a/perl/Geomag.pm b/perl/Geomag.pm index 1f77f567..f06cbbc6 100644 --- a/perl/Geomag.pm +++ b/perl/Geomag.pm @@ -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(); } } diff --git a/perl/MiscLog.pm b/perl/MiscLog.pm new file mode 100644 index 00000000..e69de29b diff --git a/perl/Spot.pm b/perl/Spot.pm index 82bbc7dd..dca64688 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -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; } diff --git a/perl/cluster.pl b/perl/cluster.pl index d20b539c..4c65e868 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -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($_); } -- 2.43.0