From: djk <djk>
Date: Fri, 13 Nov 1998 12:28:46 +0000 (+0000)
Subject: added new debugging to daily file logging
X-Git-Tag: SPIDER_1_5~16
X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?p=spider.git;a=commitdiff_plain;h=50bafbfa099ff0847beeb30e41bc62a361ef0536

added new debugging to daily file logging
added Filter and MiscLog.pm RFU
added logging for WWV
---

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($_);
 }