X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FGeomag.pm;h=881ab9d6a83fa4217393b6f3aedf3a2b0407c2b5;hb=refs%2Fheads%2Fnewpc92timings;hp=037dcc50be74637e6d4721f962066789dd3b6106;hpb=44bab9382ffb0bf12639af84729d1c42ac4d9ae2;p=spider.git diff --git a/perl/Geomag.pm b/perl/Geomag.pm index 037dcc50..881ab9d6 100644 --- a/perl/Geomag.pm +++ b/perl/Geomag.pm @@ -5,7 +5,7 @@ # # Copyright (c) 1998 - Dirk Koopman G1TLH # -# $Id$ +# # package Geomag; @@ -19,9 +19,10 @@ use DXDebug; use DXDupe; use strict; + use vars qw($date $sfi $k $a $r $forecast @allowed @denied $fp $node $from $dirprefix $param - $duplth $dupage); + $duplth $dupage $filterdef); $fp = 0; # the DXLog fcb $date = 0; # the unix time of the WWV (notional) @@ -40,6 +41,19 @@ $dupage = 12*3600; # the length of time to hold spot dups $dirprefix = "$main::data/wwv"; $param = "$dirprefix/param"; +$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'); @@ -72,12 +86,13 @@ sub store sub update { my ($mydate, $mytime, $mysfi, $mya, $myk, $myforecast, $myfrom, $mynode, $myr) = @_; - if ((@allowed && grep {$_ eq $from} @allowed) || - (@denied && !grep {$_ eq $from} @denied) || + $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 { @@ -162,7 +177,7 @@ sub search { my $from = shift; my $to = shift; - my @date = $fp->unixtoj(shift); + my $date = $fp->unixtoj(shift); my $pattern = shift; my $search; my @out; @@ -186,7 +201,7 @@ sub search $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) { @@ -230,8 +245,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; @@ -247,12 +262,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); }