summary |
shortlog |
log |
commit | commitdiff |
tree
raw |
patch |
inline | side by side (from parent 1:
ece0b00)
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.
13 files changed:
+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?
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")
# for doing connections and things
#
1 0 * * 0 DXUser::export("$main::data/user_asc")
+5 0 * * * DXDebug::dbgclean()
@EXPORT = qw(dbginit dbg dbgadd dbgsub dbglist dbgdump isdbg dbgclose confess croak cluck);
use strict;
@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 ();
use DXUtil;
use DXLog ();
%dbglevel = ();
$fp = undef;
$callback = undef;
%dbglevel = ();
$fp = undef;
$callback = undef;
+$keepdays = 10;
+$cleandays = 100;
# Avoid generating "subroutine redefined" warnings with the following
# hack (from CGI::Carp):
# Avoid generating "subroutine redefined" warnings with the following
# hack (from CGI::Carp):
return Carp::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);
+ }
+}
+
my $ref = {};
$ref->{prefix} = "$main::data/$prefix";
$ref->{suffix} = $suffix if $suffix;
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;
}
# 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
{
# 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) {
# 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;
}
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;
$mode = 'r' if !$mode;
$self->{mode} = $mode;
$fh->autoflush(1) if $mode ne 'r'; # make it autoflushing if writable
$self->{fh} = $fh;
$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};
}
# DXDebug::dbg("opening $self->{fn}\n") if isdbg("dxlog");
return $self->{fh};
}
+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
return (stat $fn)[9];
}
# open the previous log file in sequence
- 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
}
# open the next log file in sequence
- 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
}
# convert a date into the correct format from a unix date depending on its sort
{
my $self = shift;
if ($self->{'sort'} eq 'm') {
{
my $self = shift;
if ($self->{'sort'} eq 'm') {
- return Julian::unixtojm(shift);
+ return Julian::Month->new(shift);
} elsif ($self->{'sort'} eq 'd') {
} 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
}
confess "shouldn't get here";
}
# write (actually append) to a file, opening new files as required
- my ($self, $year, $thing, $line) = @_;
+ my ($self, $jdate, $line) = @_;
if (!$self->{fh} ||
$self->{mode} ne ">>" ||
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
}
return $self->{fh}->print("$line\n");
}
# write (actually append) using the current date to a file, opening new files as required
{
my ($self, $line) = @_;
my $t = time;
{
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
}
# write (actually append) using a unix time to a file, opening new files as required
{
my ($self, $t, $line) = @_;
{
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
}
# close the log file handle
my $fcb = $DXLog::log;
my $from = shift;
my $to = shift;
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;
my $pattern = shift;
my $who = uc shift;
my $search;
if ($search) {
\$count++;
next if \$count < $from;
if ($search) {
\$count++;
next if \$count < $from;
- push \@out, print_item(\$ref);
+ unshift \@out, print_item(\$ref);
last if \$count >= \$to; # stop after n
}
}
last if \$count >= \$to; # stop after n
}
}
$fcb->close; # close any open files
$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) {
for ($count = 0; $count < $to; ) {
my $ref;
if ($fh) {
# my $ref = Route::get($call) || Route->new($call);
# return unless $self->in_filter_route($ref);
# 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;
# 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 $from = shift;
my $to = shift;
- my @date = $fp->unixtoj(shift);
+ my $date = $fp->unixtoj(shift);
my $pattern = shift;
my $search;
my @out;
my $pattern = shift;
my $search;
my @out;
$fp->close; # close any open files
$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) {
for ($count = 0; $count < $to; ) {
my @in = ();
if ($fh) {
- my @date = $fp->unixtoj(shift);
- my $fh = $fp->open(@date);
+ my $date = $fp->unixtoj(shift);
+ my $fh = $fp->open($date);
+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);
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
- my ($mon, $year) = (gmtime($t))[4..5];
-
+ my ($year, $day) = (gmtime($t))[5,7];
- 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
}
# take a julian date and subtract a number of days from it, returning the julian date
- 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;
- 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;
-# 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);
+# 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;
-# is it a leap year?
-sub isleap
- 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;
+}
my $ref;
my $i;
my $count;
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;
$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" : "";
$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
$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 $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
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
#
# return all the spots from a day's file as an array of references
# the parameter passed is a julian day
- my $fh = $fp->open(@_);
+ my $fh = $fp->open(shift);
if ($fh) {
my $in;
while (<$fh>) {
if ($fh) {
my $in;
while (<$fh>) {
return DXDupe::listdups('X', $dupage, @_);
}
return DXDupe::listdups('X', $dupage, @_);
}
- 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')],
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
}
# return true if the stat file is newer than than the spot file
- 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
{
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);
{
my $from = shift;
my $to = shift;
{
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 $pattern = shift;
my $search;
my @out;
my $eval;
my $count;
);
$fp->close; # close any open files
);
$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>) {
my @in = ();
if ($fh) {
while (<$fh>) {
- my @date = $fp->unixtoj(shift);
- my $fh = $fp->open(@date);
+ my $date = $fp->unixtoj(shift);
+ my $fh = $fp->open($date);
};
dbg("Local::init error $@") if $@;
};
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");
# print various flags
#dbg("seful info - \$^D: $^D \$^W: $^W \$^S: $^S \$^P: $^P");
use DXVars;
use DXUtil;
use DXLog;
use DXVars;
use DXUtil;
use DXLog;
-use vars qw(@list $fp @today $string);
+use vars qw(@list $fp $today $string);
$fp = DXLog::new('debug', 'dat', 'd');
$fp = DXLog::new('debug', 'dat', 'd');
-@today = Julian::unixtoj(time());
+$today = $fp->unixtoj(time());
my $nolines = 1;
my @prev;
my $nolines = 1;
my @prev;
push @list, "0" unless @list;
for my $entry (@list) {
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>) {
my $line;
if ($fh) {
while (<$fh>) {
use strict;
my $fp = DXLog::new('debug', 'dat', 'd');
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;
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
# 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++) {
$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;
sleep 5;
}
die $! if $i >= 20;