From: minima <minima>
Date: Mon, 20 Aug 2001 18:28:53 +0000 (+0000)
Subject: 1. protect against PC41s with field[3] == field[2]
X-Git-Tag: R_1_48~86
X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=f0910da57e166acb22e83de4e4b771d175074c80;p=spider.git

1. protect against PC41s with field[3] == field[2]
2. Redo Julian stuff as proper objects
3. Make the various Log display come out forwards instead of backwards
4. Add the dbgclean routine to system cron to clear out all debug files
more then 10 days old.
---

diff --git a/Changes b/Changes
index 2e5c2d67..862bb961 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,9 @@
+20Aug01=======================================================================
+1. protect against PC41s with field[3] == field[2]
+2. Redo Julian stuff as proper objects
+3. Make the various Log display come out forwards instead of backwards
+4. Add the dbgclean routine to system cron to clear out all debug files 
+more then 10 days old.
 19Aug01=======================================================================
 1. Fix rcmds
 2. make isolation when there are no filters present work again?
diff --git a/cmd/crontab b/cmd/crontab
index 5ebf80c7..d0a9ed84 100644
--- a/cmd/crontab
+++ b/cmd/crontab
@@ -6,5 +6,5 @@
 # for doing connections and things
 #
 1 0 * * 0 DXUser::export("$main::data/user_asc")
+5 0 * * * DXDebug::dbgclean()
 0 3 * * * Spot::daily()
-
diff --git a/perl/DXDebug.pm b/perl/DXDebug.pm
index 14f8dbd2..40cb3a25 100644
--- a/perl/DXDebug.pm
+++ b/perl/DXDebug.pm
@@ -14,7 +14,7 @@ require Exporter;
 @EXPORT = qw(dbginit dbg dbgadd dbgsub dbglist dbgdump isdbg dbgclose confess croak cluck);
 
 use strict;
-use vars qw(%dbglevel $fp $callback);
+use vars qw(%dbglevel $fp $callback $cleandays $keepdays);
 
 use DXUtil;
 use DXLog ();
@@ -23,6 +23,8 @@ use Carp ();
 %dbglevel = ();
 $fp = undef;
 $callback = undef;
+$keepdays = 10;
+$cleandays = 100;
 
 # Avoid generating "subroutine redefined" warnings with the following
 # hack (from CGI::Carp):
@@ -160,6 +162,24 @@ sub longmess
 	return Carp::longmess(@_);
 }
 
+# clean out old debug files, stop when you get a gap of more than a month
+sub dbgclean
+{
+	my $date = $fp->unixtoj($main::systime)->sub($keepdays+1);
+	my $i = 0;
+
+	while ($i < 31) {
+		my $fn = $fp->_genfn($date);
+		if (-e $fn) {
+			unlink $fn;
+			$i = 0;
+		} else {
+			$i++;
+		}
+		$date = $date->sub(1);
+	}
+}
+
 1;
 __END__
 
diff --git a/perl/DXLog.pm b/perl/DXLog.pm
index 80336e3e..748df39c 100644
--- a/perl/DXLog.pm
+++ b/perl/DXLog.pm
@@ -50,27 +50,38 @@ sub new
 	my $ref = {};
 	$ref->{prefix} = "$main::data/$prefix";
 	$ref->{suffix} = $suffix if $suffix;
-	$ref->{'sort'} = $sort;
-		
+	$ref->{sort} = $sort;
+	
 	# make sure the directory exists
 	mkdir($ref->{prefix}, 0777) unless -e $ref->{prefix};
 	return bless $ref;
 }
 
+sub _genfn
+{
+	my ($self, $jdate) = @_;
+	my $year = $jdate->year;
+	my $thing = $jdate->thing;
+	
+	my $fn = sprintf "$self->{prefix}/$year/%02d", $thing if $jdate->isa('Julian::Month');
+	$fn = sprintf "$self->{prefix}/$year/%03d", $thing if $jdate->isa('Julian::Day');
+	$fn .= ".$self->{suffix}" if $self->{suffix};
+	return $fn;
+}
+
 # open the appropriate data file
 sub open
 {
-	my ($self, $year, $thing, $mode) = @_;
+	my ($self, $jdate, $mode) = @_;
 	
 	# if we are writing, check that the directory exists
 	if (defined $mode) {
+		my $year = $jdate->year;
 		my $dir = "$self->{prefix}/$year";
 		mkdir($dir, 0777) if ! -e $dir;
 	}
-	
-	$self->{fn} = sprintf "$self->{prefix}/$year/%02d", $thing if $self->{'sort'} eq 'm';
-	$self->{fn} = sprintf "$self->{prefix}/$year/%03d", $thing if $self->{'sort'} eq 'd';
-	$self->{fn} .= ".$self->{suffix}" if $self->{suffix};
+
+	$self->{fn} = $self->_genfn($jdate);
 	
 	$mode = 'r' if !$mode;
 	$self->{mode} = $mode;
@@ -80,90 +91,86 @@ sub open
 	$fh->autoflush(1) if $mode ne 'r'; # make it autoflushing if writable
 	$self->{fh} = $fh;
 
-	$self->{year} = $year;
-	$self->{thing} = $thing;
+	$self->{jdate} = $jdate;
 	
 #	DXDebug::dbg("opening $self->{fn}\n") if isdbg("dxlog");
 	
 	return $self->{fh};
 }
 
-sub mtime
+sub delete($$)
+{
+	my ($self, $jdate) = @_;
+	my $fn = $self->_genfn($jdate);
+	unlink $fn;
+}
+
+sub mtime($$)
 {
-	my ($self, $year, $thing) = @_;
+	my ($self, $jdate) = @_;
 	
-	my $fn = sprintf "$self->{prefix}/$year/%02d", $thing if $self->{'sort'} eq 'm';
-	$fn = sprintf "$self->{prefix}/$year/%03d", $thing if $self->{'sort'} eq 'd';
-	$fn .= ".$self->{suffix}" if $self->{suffix};
+	my $fn = $self->_genfn($jdate);
 	return (stat $fn)[9];
 }
 
 # open the previous log file in sequence
-sub openprev
+sub openprev($$)
 {
 	my $self = shift;
-	if ($self->{'sort'} eq 'm') {
-		($self->{year}, $self->{thing}) = Julian::subm($self->{year}, $self->{thing}, 1);
-	} elsif ($self->{'sort'} eq 'd') {
-		($self->{year}, $self->{thing}) = Julian::sub($self->{year}, $self->{thing}, 1);
-	}
-	return $self->open($self->{year}, $self->{thing}, @_);
+	my $jdate = $self->{jdate}->sub(1);
+	return $self->open($jdate, @_);
 }
 
 # open the next log file in sequence
-sub opennext
+sub opennext($$)
 {
 	my $self = shift;
-	if ($self->{'sort'} eq 'm') {
-		($self->{year}, $self->{thing}) = Julian::addm($self->{year}, $self->{thing}, 1);
-	} elsif ($self->{'sort'} eq 'd') {
-		($self->{year}, $self->{thing}) = Julian::add($self->{year}, $self->{thing}, 1);
-	}
-	return $self->open($self->{year}, $self->{thing}, @_);
+	my $jdate = $self->{jdate}->add(1);
+	return $self->open($jdate, @_);
 }
 
 # convert a date into the correct format from a unix date depending on its sort
-sub unixtoj
+sub unixtoj($$)
 {
 	my $self = shift;
 	
 	if ($self->{'sort'} eq 'm') {
-		return Julian::unixtojm(shift);
+		return Julian::Month->new(shift);
 	} elsif ($self->{'sort'} eq 'd') {
-		return Julian::unixtoj(shift);
+		return Julian::Day->new(shift);
 	}
 	confess "shouldn't get here";
 }
 
 # write (actually append) to a file, opening new files as required
-sub write
+sub write($$$)
 {
-	my ($self, $year, $thing, $line) = @_;
+	my ($self, $jdate, $line) = @_;
 	if (!$self->{fh} || 
 		$self->{mode} ne ">>" || 
-		$year != $self->{year} || 
-		$thing != $self->{thing}) {
-		$self->open($year, $thing, ">>") or confess "can't open $self->{fn} $!";
+		$jdate->year != $self->{jdate}->year || 
+		$jdate->thing != $self->{jdate}->year) {
+		$self->open($jdate, ">>") 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
+sub writenow($$)
 {
 	my ($self, $line) = @_;
 	my $t = time;
-	my @date = $self->unixtoj($t);
-	return $self->write(@date, $line);
+	my $date = $self->unixtoj($t);
+	return $self->write($date, $line);
 }
 
 # write (actually append) using a unix time to a file, opening new files as required
-sub writeunix
+sub writeunix($$$)
 {
 	my ($self, $t, $line) = @_;
-	my @date = $self->unixtoj($t);
-	return $self->write(@date, $line);
+	my $date = $self->unixtoj($t);
+	return $self->write($date, $line);
 }
 
 # close the log file handle
diff --git a/perl/DXLogPrint.pm b/perl/DXLogPrint.pm
index 6d37cb41..c2434aba 100644
--- a/perl/DXLogPrint.pm
+++ b/perl/DXLogPrint.pm
@@ -27,7 +27,7 @@ sub print
 	my $fcb = $DXLog::log;
 	my $from = shift;
 	my $to = shift;
-	my @date = Julian::unixtojm(shift);
+	my $jdate = $fcb->unixtoj(shift);
 	my $pattern = shift;
 	my $who = uc shift;
 	my $search;
@@ -67,7 +67,7 @@ sub print
 					if ($search) {
 						\$count++;
 						next if \$count < $from;
-						push \@out, print_item(\$ref);
+						unshift \@out, print_item(\$ref);
 						last if \$count >= \$to;                  # stop after n
 					}
 				}
@@ -75,7 +75,7 @@ sub print
 	
 	$fcb->close;                                      # close any open files
 
-	my $fh = $fcb->open(@date); 
+	my $fh = $fcb->open($jdate); 
 	for ($count = 0; $count < $to; ) {
 		my $ref;
 		if ($fh) {
diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index ed8d2e5b..615dfdd0 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -920,6 +920,11 @@ sub normal
 #			my $ref = Route::get($call) || Route->new($call);
 #			return unless $self->in_filter_route($ref);
 
+			if ($field[3] eq $field[2]) {
+				dbg('PCPROT: invalid value') if isdbg('chanerr');
+				return;
+			}
+
 			# add this station to the user database, if required
 			my $user = DXUser->get_current($call);
 			$user = DXUser->new($call) if !$user;
diff --git a/perl/Geomag.pm b/perl/Geomag.pm
index 6b6d778d..e00dbd9e 100644
--- a/perl/Geomag.pm
+++ b/perl/Geomag.pm
@@ -175,7 +175,7 @@ sub search
 {
 	my $from = shift;
 	my $to = shift;
-	my @date = $fp->unixtoj(shift);
+	my $date = $fp->unixtoj(shift);
 	my $pattern = shift;
 	my $search;
 	my @out;
@@ -199,7 +199,7 @@ sub search
 	
 	$fp->close;					# close any open files
 	
-	my $fh = $fp->open(@date); 
+	my $fh = $fp->open($date); 
 	for ($count = 0; $count < $to; ) {
 		my @in = ();
 		if ($fh) {
@@ -243,8 +243,8 @@ sub print_item
 #
 sub readfile
 {
-	my @date = $fp->unixtoj(shift);
-	my $fh = $fp->open(@date); 
+	my $date = $fp->unixtoj(shift);
+	my $fh = $fp->open($date); 
 	my @spots = ();
 	my @in;
 	
diff --git a/perl/Julian.pm b/perl/Julian.pm
index 861f84d4..2307e08a 100644
--- a/perl/Julian.pm
+++ b/perl/Julian.pm
@@ -6,95 +6,131 @@
 # $Id$
 #
 
+use strict;
+
 package Julian;
 
-use strict;
+sub alloc($$$)
+{
+	my ($pkg, $year, $thing) = @_;
+	return bless [$year, $thing], ref($pkg)||$pkg;
+}
+
+sub copy
+{
+	my $old = shift;
+	return $old->alloc(@$old);
+}
+
+sub cmp($$)
+{
+	my ($a, $b) = @_;
+	return $a->[1] - $b->[1] if ($a->[0] == $b->[0]);
+	return $a->[0] - $b->[0];
+}
+
+sub year
+{
+	return $_[0]->[0];
+}
+
+sub thing
+{
+	return $_[0]->[1];
+}
+
+package Julian::Day;
+
+use vars qw(@ISA);
+@ISA = qw(Julian);
 
 my @days = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
 
-# take a unix date and transform it into a julian day (ie (1998, 13) = 13th day of 1998)
-sub unixtoj
+# is it a leap year?
+sub _isleap
 {
-	my $t = shift;
-	my ($year, $day) = (gmtime($t))[5,7];
-	
-	$year += 1900;
-	return ($year, $day+1);
+	my $year = shift;
+	return ($year % 4 == 0 && ($year % 100 != 0 || $year % 400 == 0)) ? 1 : 0; 
 }
 
-# take a unix and return a julian month from it
-sub unixtojm
+sub new($$)
 {
+	my $pkg = shift;
 	my $t = shift;
-	my ($mon, $year) = (gmtime($t))[4..5];
-
+	my ($year, $day) = (gmtime($t))[5,7];
 	$year += 1900;
-	return ($year, $mon + 1);
+	return $pkg->SUPER::alloc($year, $day+1);
 }
 
 # take a julian date and subtract a number of days from it, returning the julian date
-sub sub
+sub sub($$)
 {
-	my ($year, $day, $amount) = @_;
-	my $diny = isleap($year) ? 366 : 365;
-	$day -= $amount;
-	while ($day <= 0) {
-		$day += $diny;
-		$year -= 1;
-		$diny = isleap($year) ? 366 : 365;
+	my ($old, $amount) = @_;
+	my $self = $old->copy;
+	my $diny = _isleap($self->[0]) ? 366 : 365;
+	$self->[1] -= $amount;
+	while ($self->[1] <= 0) {
+		$self->[1] += $diny;
+		$self->[0] -= 1;
+		$diny = _isleap($self->[0]) ? 366 : 365;
 	}
-	return ($year, $day);
+	return $self;
 }
 
-sub add
+sub add($$)
 {
-	my ($year, $day, $amount) = @_;
-	my $diny = isleap($year) ? 366 : 365;
-	$day += $amount;
-	while ($day > $diny) {
-		$day -= $diny;
-		$year += 1;
-		$diny = isleap($year) ? 366 : 365;
+	my ($old, $amount) = @_;
+	my $self = $old->copy;
+	my $diny = _isleap($self->[0]) ? 366 : 365;
+	$self->[1] += $amount;
+	while ($self->[1] > $diny) {
+		$self->[1] -= $diny;
+		$self->[0] += 1;
+		$diny = _isleap($self->[0]) ? 366 : 365;
 	}
-	return ($year, $day);
+	return $self;
 } 
 
-# take a julian month and subtract a number of months from it, returning the julian month
-sub subm
+package Julian::Month;
+
+use vars qw(@ISA);
+@ISA = qw(Julian);
+
+sub new($$)
 {
-	my ($year, $mon, $amount) = @_;
-	$mon -= $amount;
-	while ($mon <= 0) {
-		$mon += 12;
-		$year -= 1;
-	}
-	return ($year, $mon);
+	my $pkg = shift;
+	my $t = shift;
+	my ($mon, $year) = (gmtime($t))[4,5];
+	$year += 1900;
+	return $pkg->SUPER::alloc($year, $mon+1);
 }
 
-sub addm
+# take a julian month and subtract a number of months from it, returning the julian month
+sub sub($$)
 {
-	my ($year, $mon, $amount) = @_;
-	$mon += $amount;
-	while ($mon > 12) {
-		$mon -= 12;
-		$year += 1;
+	my ($old, $amount) = @_;
+	my $self = $old->copy;
+	
+	$self->[1] -= $amount;
+	while ($self->[1] <= 0) {
+		$self->[1] += 12;
+		$self->[0] -= 1;
 	}
-	return ($year, $mon);
-} 
-
-sub cmp
-{
-	my ($y1, $d1, $y2, $d2) = @_;
-	return $d1 - $d2 if ($y1 == $y2);
-	return $y1 - $y2;
+	return $self;
 }
 
-# is it a leap year?
-sub isleap
+sub add($$)
 {
-	my $year = shift;
-	return ($year % 4 == 0 && ($year % 100 != 0 || $year % 400 == 0)) ? 1 : 0; 
-}
+	my ($old, $amount) = @_;
+	my $self = $old->copy;
+
+	$self->[1] += $amount;
+	while ($self->[1] > 12) {
+		$self->[1] -= 12;
+		$self->[0] += 1;
+	}
+	return $self;
+} 
 
 
 1;
diff --git a/perl/Spot.pm b/perl/Spot.pm
index 074ae740..f8925d3d 100644
--- a/perl/Spot.pm
+++ b/perl/Spot.pm
@@ -167,15 +167,15 @@ sub search
 	my $ref;
 	my $i;
 	my $count;
-	my @today = Julian::unixtoj(time());
-	my @fromdate;
-	my @todate;
+	my $today = Julian::Day->new(time());
+	my $fromdate;
+	my $todate;
 
 	$dayfrom = 0 if !$dayfrom;
 	$dayto = $maxdays unless $dayto;
 	$dayto = $dayfrom + $maxdays if $dayto < $dayfrom;
-	@fromdate = Julian::sub(@today, $dayfrom);
-	@todate = Julian::sub(@fromdate, $dayto);
+	$fromdate = $today->sub($dayfrom);
+	$todate = $fromdate->sub($dayto);
 	$from = 0 unless $from;
 	$to = $defaultspots unless $to;
 	$hint = $hint ? "next unless $hint" : "";
@@ -211,11 +211,11 @@ sub search
 	$fp->close;					# close any open files
 
 	for ($i = $count = 0; $i < $maxdays; ++$i) {	# look thru $maxdays worth of files only
-		my @now = Julian::sub(@fromdate, $i); # but you can pick which $maxdays worth
-		last if Julian::cmp(@now, @todate) <= 0;         
+		my $now = $fromdate->sub($i); # but you can pick which $maxdays worth
+		last if $now->cmp($todate) <= 0;         
 	
 		my @spots = ();
-		my $fh = $fp->open(@now); # get the next file
+		my $fh = $fp->open($now); # get the next file
 		if ($fh) {
 			my $in;
 			eval $eval;			# do the search on this file
@@ -279,11 +279,11 @@ sub formatl
 #
 # return all the spots from a day's file as an array of references
 # the parameter passed is a julian day
-sub readfile
+sub readfile($)
 {
 	my @spots;
 	
-	my $fh = $fp->open(@_); 
+	my $fh = $fp->open(shift); 
 	if ($fh) {
 		my $in;
 		while (<$fh>) {
@@ -317,11 +317,11 @@ sub listdups
 	return DXDupe::listdups('X', $dupage, @_);
 }
 
-sub genstats
+sub genstats($)
 {
-	my @date = @_;
-	my $in = $fp->open(@date);
-	my $out = $statp->open(@date, 'w');
+	my $date = shift;
+	my $in = $fp->open($date);
+	my $out = $statp->open($date, 'w');
 	my @freq = (
 				[0, Bands::get_freq('160m')],
 				[1, Bands::get_freq('80m')],
@@ -382,20 +382,19 @@ sub genstats
 }
 
 # return true if the stat file is newer than than the spot file
-sub checkstats
+sub checkstats($)
 {
-	my @date = @_;
-	my $in = $fp->mtime(@date);
-	my $out = $statp->mtime(@date);
+	my $date = shift;
+	my $in = $fp->mtime($date);
+	my $out = $statp->mtime($date);
 	return defined $out && defined $in && $out >= $in;
 }
 
 # daily processing
 sub daily
 {
-	my @date = Julian::unixtoj($main::systime);
-	@date = Julian::sub(@date, 1);
-	genstats(@date) unless checkstats(@date);
+	my $date = Julian::Day->new($main::systime)->sub(1);
+	genstats($date) unless checkstats($date);
 }
 1;
 
diff --git a/perl/WCY.pm b/perl/WCY.pm
index ee9679c6..7f19ccfd 100644
--- a/perl/WCY.pm
+++ b/perl/WCY.pm
@@ -150,12 +150,13 @@ sub search
 {
 	my $from = shift;
 	my $to = shift;
-	my @date = $fp->unixtoj(shift);
+	my $date = $fp->unixtoj(shift);
 	my $pattern = shift;
 	my $search;
 	my @out;
 	my $eval;
 	my $count;
+	my $i;
 	
 	$search = 1;
 	$eval = qq(
@@ -173,9 +174,8 @@ sub search
 			  );
 	
 	$fp->close;					# close any open files
-	
-	my $fh = $fp->open(@date); 
-	for ($count = 0; $count < $to; ) {
+	my $fh = $fp->open($date); 
+	for ($i = $count = 0; $count < $to; $i++ ) {
 		my @in = ();
 		if ($fh) {
 			while (<$fh>) {
@@ -218,8 +218,8 @@ sub print_item
 #
 sub readfile
 {
-	my @date = $fp->unixtoj(shift);
-	my $fh = $fp->open(@date); 
+	my $date = $fp->unixtoj(shift);
+	my $fh = $fp->open($date); 
 	my @spots = ();
 	my @in;
 	
diff --git a/perl/cluster.pl b/perl/cluster.pl
index 572be7a9..f96b6173 100755
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -455,6 +455,9 @@ eval {
 };
 dbg("Local::init error $@") if $@;
 
+dbg("cleaning out old debug files");
+DXDebug::dbgclean();
+
 # print various flags
 #dbg("seful info - \$^D: $^D \$^W: $^W \$^S: $^S \$^P: $^P");
 
diff --git a/perl/grepdbg b/perl/grepdbg
index 467c7853..55d09788 100755
--- a/perl/grepdbg
+++ b/perl/grepdbg
@@ -26,13 +26,14 @@ BEGIN {
 use DXVars;
 use DXUtil;
 use DXLog;
+use Julian;
 
 use strict;
 
-use vars qw(@list $fp @today $string);
+use vars qw(@list $fp $today $string);
 
 $fp = DXLog::new('debug', 'dat', 'd');
-@today = Julian::unixtoj(time()); 
+$today = $fp->unixtoj(time()); 
 my $nolines = 1;
 my @prev;
 
@@ -51,8 +52,8 @@ die "usage: grepdbg [nn] [[-nnn] ..] <regexp>\n" unless  $string;
 
 push @list, "0" unless @list;
 for my $entry (@list) {
-	my @now = Julian::sub(@today, $entry); 
-	my $fh = $fp->open(@now); 
+	my $now = $today->sub($entry); 
+	my $fh = $fp->open($now); 
 	my $line;
 	if ($fh) {
 		while (<$fh>) {
diff --git a/perl/watchdbg b/perl/watchdbg
index 92765ab4..348ac8fe 100755
--- a/perl/watchdbg
+++ b/perl/watchdbg
@@ -30,8 +30,8 @@ use DXLog;
 use strict;
 
 my $fp = DXLog::new('debug', 'dat', 'd');
-my @today = Julian::unixtoj(time()); 
-my $fh = $fp->open(@today) or die $!; 
+my $today = $fp->unixtoj(time()); 
+my $fh = $fp->open($today) or die $!; 
 my $nolines = 1;
 $nolines = shift if $ARGV[0] =~ /^-?\d+$/;
 $nolines = abs $nolines if $nolines < 0;  
@@ -58,16 +58,16 @@ for (;;) {
 		
 		# check that the debug hasn't rolled over to next day
 		# open it if it has
-		my @now = Julian::unixtoj(time()); 
-		if ($today[1] != $now[1]) {
+		my $now = $fp->unixtoj(time()); 
+		if ($today->cmp($now)) {
 			$fp->close;
 			my $i;
 			for ($i = 0; $i < 20; $i++) {
-				last if $fh = $fp->open(@now);
+				last if $fh = $fp->open($now);
 				sleep 5;
 			}
 		 	die $! if $i >= 20; 
-			@today = @now;
+			$today = $now;
 		}
 	}
 }