X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FGeomag.pm;h=1a56305c45a551043bac6d40953bc813d00f0e6d;hb=433209e1efed23493f25f1357d9c003696c1fb59;hp=225cb542f087155c84bbe7c2cd9a487dc20bbc10;hpb=97315924f561c56cef3b581691409d4217f5c1b5;p=spider.git diff --git a/perl/Geomag.pm b/perl/Geomag.pm index 225cb542..1a56305c 100644 --- a/perl/Geomag.pm +++ b/perl/Geomag.pm @@ -5,7 +5,7 @@ # # Copyright (c) 1998 - Dirk Koopman G1TLH # -# $Id$ +# # package Geomag; @@ -15,29 +15,59 @@ use DXUtil; use DXLog; use Julian; use IO::File; -use Carp; +use DXDebug; +use DXDupe; +use Time::HiRes qw(gettimeofday tv_interval); use strict; -use vars qw($date $sfi $k $a $forecast @allowed @denied $fp $node $from); + +use vars qw($date $sfi $k $a $r $forecast @allowed @denied $fp $node $from + $dirprefix $param + $duplth $dupage $filterdef); $fp = 0; # the DXLog fcb $date = 0; # the unix time of the WWV (notional) $sfi = 0; # the current SFI value $k = 0; # the current K value $a = 0; # the current A value +$r = 0; # the current R value $forecast = ""; # the current geomagnetic forecast $node = ""; # originating node $from = ""; # who this came from @allowed = (); # if present only these callsigns are regarded as valid WWV updators @denied = (); # if present ignore any wwv from these callsigns -my $dirprefix = "$main::data/wwv"; -my $param = "$dirprefix/param"; +$duplth = 20; # the length of text to use in the deduping +$dupage = 12*3600; # the length of time to hold spot dups + +$dirprefix = "$main::local_data/wwv"; +$param = "$dirprefix/param"; + +our $maxcache = 10; +our @cache; + + +$filterdef = bless ([ + # tag, sort, field, priv, special parser + ['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'); - mkdir $dirprefix, 0777 if !-e $dirprefix; # now unnecessary DXLog will create it 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 $@; } @@ -51,6 +81,7 @@ sub store print $fh "\$sfi = $sfi;\n"; print $fh "\$a = $a;\n"; print $fh "\$k = $k;\n"; + print $fh "\$r = $r;\n"; print $fh "\$from = '$from';\n"; print $fh "\$node = '$node';\n"; print $fh "\@denied = qw(", join(' ', @denied), ");\n" if @denied > 0; @@ -58,19 +89,28 @@ sub store close $fh; # log it - $fp->writeunix($date, "$from^$date^$sfi^$a^$k^$forecast^$node"); + 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) sub update { - my ($mydate, $mytime, $mysfi, $mya, $myk, $myforecast, $myfrom, $mynode) = @_; - if ((@allowed && grep {$_ eq $from} @allowed) || - (@denied && !grep {$_ eq $from} @denied) || + my ($mydate, $mytime, $mysfi, $mya, $myk, $myforecast, $myfrom, $mynode, $myr) = @_; + $myfrom =~ s/-\d+$//; + if ((@allowed && grep {$_ eq $myfrom} @allowed) || + (@denied && !grep {$_ eq $myfrom} @denied) || (@allowed == 0 && @denied == 0)) { # my $trydate = cltounix($mydate, sprintf("%02d18Z", $mytime)); - if ($mydate >= $date) { + if ($mydate > $date) { + if ($myr) { + $r = 0 + $myr; + } else { + $r = 0 unless abs ($mysfi - $sfi) > 3; + } $sfi = 0 + $mysfi; $k = 0 + $myk; $a = 0 + $mya; @@ -125,6 +165,11 @@ sub k @_ ? $k = shift : $k ; } +sub r +{ + @_ ? $r = shift : $r ; +} + sub a { @_ ? $a = shift : $a ; @@ -135,6 +180,7 @@ sub forecast @_ ? $forecast = shift : $forecast ; } + # # print some items from the log backwards in time # @@ -144,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--) { @@ -166,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; @@ -212,8 +266,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; @@ -225,5 +279,23 @@ sub readfile } return @in; } + +# enter the spot for dup checking and return true if it is already a dup +sub dup +{ + 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|$call"; + return DXDupe::check($dupkey, $main::systime+$dupage); +} + +sub listdups +{ + return DXDupe::listdups('W', $dupage, @_); +} 1; __END__; +