X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FGeomag.pm;h=1a56305c45a551043bac6d40953bc813d00f0e6d;hb=433209e1efed23493f25f1357d9c003696c1fb59;hp=e1ab6dd1c6ad3a977e9730bd9d1920df997a18a5;hpb=6a510dc82f3050640dfe6b8d499995348075fe7a;p=spider.git diff --git a/perl/Geomag.pm b/perl/Geomag.pm index e1ab6dd1..1a56305c 100644 --- a/perl/Geomag.pm +++ b/perl/Geomag.pm @@ -5,7 +5,7 @@ # # Copyright (c) 1998 - Dirk Koopman G1TLH # -# $Id$ +# # package Geomag; @@ -17,15 +17,10 @@ use Julian; use IO::File; use DXDebug; use DXDupe; +use Time::HiRes qw(gettimeofday tv_interval); 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 $a $r $forecast @allowed @denied $fp $node $from $dirprefix $param $duplth $dupage $filterdef); @@ -44,26 +39,35 @@ $from = ""; # who this came from $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/wwv"; +$dirprefix = "$main::local_data/wwv"; $param = "$dirprefix/param"; +our $maxcache = 10; +our @cache; + + $filterdef = bless ([ # tag, sort, field, priv, special parser - ['by', 'c', 7], - ['origin', 'c', 8], - ['channel', 'c', 9], - ['by_dxcc', 'nc', 10], - ['by_itu', 'ni', 11], - ['by_zone', 'nz', 12], - ['origin_dxcc', 'nc', 13], - ['origin_itu', 'ni', 14], - ['origin_zone', 'nz', 15], + ['by', 'c', 0], + ['origin', 'c', 1], + ['channel', 'c', 2], + ['by_dxcc', 'nc', 3], + ['by_itu', 'ni', 4], + ['by_zone', 'nz', 5], + ['origin_dxcc', 'nc', 6], + ['origin_itu', 'ni', 7], + ['origin_zone', 'nz', 8], ], 'Filter::Cmd'); sub init { $fp = DXLog::new('wwv', 'dat', 'm'); do "$param" if -e "$param"; + # read in existing data + my $t0 = [gettimeofday]; + @cache = readfile($main::systime); + shift @cache while @cache > $maxcache; + dbg(sprintf "WWV read in last %d records into cache in %dmS", scalar @cache, _diffms($t0)); confess $@ if $@; } @@ -85,7 +89,10 @@ sub store close $fh; # log it - $fp->writeunix($date, "$from^$date^$sfi^$a^$k^$forecast^$node^$r"); + my $s ="$from^$date^$sfi^$a^$k^$forecast^$node^$r"; + $fp->writeunix($date, $s); + push @cache, [ split /\^/, $s ]; + shift @cache while @cache > $maxcache; } # update WWV info in one go (usually from a PC23) @@ -98,7 +105,7 @@ sub update (@allowed == 0 && @denied == 0)) { # my $trydate = cltounix($mydate, sprintf("%02d18Z", $mytime)); - if ($mydate >= $date) { + if ($mydate > $date) { if ($myr) { $r = 0 + $myr; } else { @@ -183,15 +190,22 @@ 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; - - $search = 1; - $eval = qq( + + if ($t == $main::systime && ($to <= $maxcache)) { + dbg("using wwv cache") if isdbg('wwv'); + @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--) { @@ -205,22 +219,23 @@ sub search } ); - $fp->close; # close any open files - - my $fh = $fp->open($date); - for ($count = 0; $count < $to; ) { - 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 ($count = 0; $count < $to; ) { + 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; @@ -268,12 +283,12 @@ sub readfile # enter the spot for dup checking and return true if it is already a dup sub dup { - my ($d, $sfi, $k, $a, $text) = @_; + my ($d, $sfi, $k, $a, $text, $call) = @_; # dump if too old return 2 if $d < $main::systime - $dupage; - my $dupkey = "W$d|$sfi|$k|$a"; + my $dupkey = "W$d|$sfi|$k|$a|$call"; return DXDupe::check($dupkey, $main::systime+$dupage); }