X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FWCY.pm;h=657a49cb172c32142983077ae6620ed0ccda835c;hb=510a9f0644b3a0e02f5951702ada39616bfcfc2f;hp=7f19ccfd1263c007fb2157d44ec55a1dd4d2c9a5;hpb=f0910da57e166acb22e83de4e4b771d175074c80;p=spider.git diff --git a/perl/WCY.pm b/perl/WCY.pm index 7f19ccfd..657a49cb 100644 --- a/perl/WCY.pm +++ b/perl/WCY.pm @@ -18,6 +18,13 @@ use DXDebug; 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,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); @@ -33,7 +40,7 @@ $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 @@ -45,13 +52,13 @@ $filterdef = bless ([ # tag, sort, field, priv, special parser ['by', 'c', 11], ['origin', 'c', 12], - ['channel', 'n', 13], - ['by_dxcc', 'n', 14], - ['by_itu', 'n', 15], - ['by_zone', 'n', 16], - ['origin_dxcc', 'c', 17], - ['origin_itu', 'c', 18], - ['origin_itu', 'c', 19], + ['channel', 'c', 13], + ['by_dxcc', 'nc', 14], + ['by_itu', 'ni', 15], + ['by_zone', 'nz', 16], + ['origin_dxcc', 'nc', 17], + ['origin_itu', 'ni', 18], + ['origin_zone', 'nz', 19], ], 'Filter::Cmd'); @@ -83,8 +90,9 @@ sub store sub update { my ($mydate, $mytime, $mysfi, $mya, $myk, $myexpk, $myr, $mysa, $mygmf, $myau, $myfrom, $mynode) = @_; - 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)); @@ -235,12 +243,12 @@ sub readfile # enter the spot for dup checking and return true if it is already a dup sub dup { - my ($d, $sfi, $a, $k, $r) = @_; + my ($d) = @_; # dump if too old return 2 if $d < $main::systime - $dupage; - my $dupkey = "C$d|$sfi|$k|$a|$r"; + my $dupkey = "C$d"; return DXDupe::check($dupkey, $main::systime+$dupage); }