+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?
# for doing connections and things
#
1 0 * * 0 DXUser::export("$main::data/user_asc")
+5 0 * * * DXDebug::dbgclean()
0 3 * * * Spot::daily()
-
@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 ();
%dbglevel = ();
$fp = undef;
$callback = undef;
+$keepdays = 10;
+$cleandays = 100;
# Avoid generating "subroutine redefined" warnings with the following
# hack (from CGI::Carp):
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__
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;
$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
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;
if ($search) {
\$count++;
next if \$count < $from;
- push \@out, print_item(\$ref);
+ unshift \@out, print_item(\$ref);
last if \$count >= \$to; # stop after n
}
}
$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) {
# 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;
{
my $from = shift;
my $to = shift;
- my @date = $fp->unixtoj(shift);
+ my $date = $fp->unixtoj(shift);
my $pattern = shift;
my $search;
my @out;
$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) {
#
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;
# $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;
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" : "";
$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
#
# 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>) {
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')],
}
# 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;
{
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(
);
$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>) {
#
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;
};
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");
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;
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>) {
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;
# 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;
}
}
}
projects / spider.git / commitdiff