X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FWCY.pm;h=534d89d76ca9b2ce3ecf7dbaafe551d70e5501b2;hb=refs%2Fheads%2Fstaging;hp=4974d939620f51ad17b4865b05b0835457ed99a9;hpb=6a510dc82f3050640dfe6b8d499995348075fe7a;p=spider.git diff --git a/perl/WCY.pm b/perl/WCY.pm index 4974d939..534d89d7 100644 --- a/perl/WCY.pm +++ b/perl/WCY.pm @@ -4,7 +4,7 @@ # # Copyright (c) 2000 - Dirk Koopman G1TLH # -# $Id$ +# # package WCY; @@ -19,12 +19,6 @@ use Data::Dumper; use strict; -use vars qw($VERSION $BRANCH); -$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0; -$main::build += $VERSION; -$main::branch += $BRANCH; - use vars qw($date $sfi $k $expk $a $r $sa $gmf $au @allowed @denied $fp $node $from $dirprefix $param $duplth $dupage $filterdef); @@ -40,14 +34,18 @@ $gmf = ""; # Geomag activity $au = 'no'; # aurora warning $node = ""; # originating node $from = ""; # who this came from -@allowed = (); # if present only these callsigns are regarded as valid WWV updators +@allowed = qw(DK0WCY); # if present only these callsigns are regarded as valid WWV updators @denied = (); # if present ignore any wwv from these callsigns $duplth = 20; # the length of text to use in the deduping $dupage = 12*3600; # the length of time to hold spot dups -$dirprefix = "$main::data/wcy"; +$dirprefix = "$main::local_data/wcy"; $param = "$dirprefix/param"; +our $maxcache = 20; +our @cache; + + $filterdef = bless ([ # tag, sort, field, priv, special parser ['by', 'c', 11], @@ -61,11 +59,14 @@ $filterdef = bless ([ ['origin_zone', 'nz', 19], ], 'Filter::Cmd'); - sub init { $fp = DXLog::new('wcy', 'dat', 'm'); do "$param" if -e "$param"; + # read in existing data + @cache = readfile($main::systime); + shift @cache while @cache > $maxcache; + dbg(sprintf "WCY read in last %d records into cache", scalar @cache); confess $@ if $@; } @@ -83,10 +84,13 @@ sub store $fh->close; # log it - $fp->writeunix($date, "$date^$sfi^$a^$k^$expk^$r^$sa^$gmf^$au^$from^$node"); + my $s = "$date^$sfi^$a^$k^$expk^$r^$sa^$gmf^$au^$from^$node"; + $fp->writeunix($date, $s); + push @cache, [ split /\^/, $s ]; + shift @cache while @cache > $maxcache; } -# update WWV info in one go (usually from a PC23) +# update WCY info in one go (usually from a PC23) sub update { my ($mydate, $mytime, $mysfi, $mya, $myk, $myexpk, $myr, $mysa, $mygmf, $myau, $myfrom, $mynode) = @_; @@ -158,16 +162,23 @@ sub search { my $from = shift; my $to = shift; - my $date = $fp->unixtoj(shift); + my $t = shift; + my $date = $fp->unixtoj($t); my $pattern = shift; my $search; my @out; my $eval; my $count; my $i; - - $search = 1; - $eval = qq( + + if ($t == $main::systime && ($to && $to <= @cache)) { + dbg("using wcy cache") if isdbg('wcy'); + @out = reverse @cache; + pop @out while @out > $to; + } else { + dbg("using wwv file(s))") if isdbg('wwv'); + $search = 1; + $eval = qq( my \$c; my \$ref; for (\$c = \$#in; \$c >= 0; \$c--) { @@ -180,22 +191,23 @@ sub search } } ); - - $fp->close; # close any open files - my $fh = $fp->open($date); - for ($i = $count = 0; $count < $to; $i++ ) { - my @in = (); - if ($fh) { - while (<$fh>) { - chomp; - push @in, [ split '\^' ] if length > 2; + + $fp->close; # close any open files + my $fh = $fp->open($date); + for ($i = $count = 0; $count < $to; $i++ ) { + my @in = (); + if ($fh) { + while (<$fh>) { + chomp; + push @in, [ split '\^' ] if length > 2; + } + eval $eval; # do the search on this file + return ("Geomag search error", $@) if $@; + last if $count >= $to; # stop after n } - eval $eval; # do the search on this file - return ("Geomag search error", $@) if $@; - last if $count >= $to; # stop after n + $fh = $fp->openprev(); # get the next file + last if !$fh; } - $fh = $fp->openprev(); # get the next file - last if !$fh; } return @out; @@ -217,7 +229,7 @@ sub print_item my $d = cldate($r->[0]); my $t = (gmtime($r->[0]))[2]; - return sprintf("$d %02d %5d %3d %3d %3d %3d %-5s %-5s %6s <%s>", + return sprintf("$d %02d %5d %3d %3d %3d %3d %-5s %-5s %6s <%s>", $t, @$r[1..9]); }