X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FGeomag.pm;h=6bc925b8bd3fa2bedd3f2af0f86ea4958a618a9b;hb=b9dffeff7239952814342dad19db3a51def6fab7;hp=8f17eaf32000442462ca1bd1bbbf840e4e942dd9;hpb=6ccc3a6e864a2fee18786a7070400c7c4f22cf7c;p=spider.git diff --git a/perl/Geomag.pm b/perl/Geomag.pm index 8f17eaf3..6bc925b8 100644 --- a/perl/Geomag.pm +++ b/perl/Geomag.pm @@ -20,12 +20,6 @@ use DXDupe; 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); @@ -49,15 +43,15 @@ $param = "$dirprefix/param"; $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 @@ -92,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 { @@ -267,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); }