X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FGeomag.pm;h=dc003638209c70b3095875e63042c40f27bc8633;hb=2b58ccdf81685a1167a43c38705a0d84b9d8d661;hp=ca16e363f445536b19a356d56652affa852c6774;hpb=0bd9d2811cc42417676a1b11b121681c2377d70a;p=spider.git diff --git a/perl/Geomag.pm b/perl/Geomag.pm index ca16e363..dc003638 100644 --- a/perl/Geomag.pm +++ b/perl/Geomag.pm @@ -16,9 +16,19 @@ use DXLog; use Julian; use IO::File; use DXDebug; +use DXDupe; use strict; -use vars qw($date $sfi $k $a $r $forecast @allowed @denied $fp $node $from); + +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); $fp = 0; # the DXLog fcb $date = 0; # the unix time of the WWV (notional) @@ -31,13 +41,28 @@ $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::data/wwv"; +$param = "$dirprefix/param"; + +$filterdef = bless ([ + # tag, sort, field, priv, special parser + ['by', 'c', 7], + ['origin', 'c', 8], + ['channel', 'n', 9], + ['by_dxcc', 'n', 10], + ['by_itu', 'n', 11], + ['by_zone', 'n', 12], + ['origin_dxcc', 'c', 13], + ['origin_itu', 'c', 14], + ['origin_itu', 'c', 15], + ], '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"; confess $@ if $@; } @@ -157,7 +182,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; @@ -181,7 +206,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) { @@ -225,8 +250,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; @@ -238,5 +263,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) = @_; + + # dump if too old + return 2 if $d < $main::systime - $dupage; + + my $dupkey = "W$d|$sfi|$k|$a"; + return DXDupe::check($dupkey, $main::systime+$dupage); +} + +sub listdups +{ + return DXDupe::listdups('W', $dupage, @_); +} 1; __END__; +