X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FGeomag.pm;h=e84e5d50c35a5d4a472800713cd02480c81ea084;hb=88665a2bed3b9ec9e97237938a95a045b2a21bb4;hp=ca16e363f445536b19a356d56652affa852c6774;hpb=19f68ea69f734f50b46fba21aab99315d5803e09;p=spider.git diff --git a/perl/Geomag.pm b/perl/Geomag.pm index ca16e363..e84e5d50 100644 --- a/perl/Geomag.pm +++ b/perl/Geomag.pm @@ -18,7 +18,9 @@ use IO::File; use DXDebug; use strict; -use vars qw($date $sfi $k $a $r $forecast @allowed @denied $fp $node $from); +use vars qw($date $sfi $k $a $r $forecast @allowed @denied $fp $node $from + $dirprefix $param + %dup $duplth $dupage); $fp = 0; # the DXLog fcb $date = 0; # the unix time of the WWV (notional) @@ -31,8 +33,12 @@ $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"; +%dup = (); # the spot duplicates hash +$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"; sub init { @@ -238,5 +244,41 @@ 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; + + $d /= 60; # to the nearest minute + chomp $text; + $text = substr($text, 0, $duplth) if length $text > $duplth; + my $dupkey = "$d|$sfi|$k|$a|$text"; + return 1 if exists $dup{$dupkey}; + $dup{$dupkey} = $d * 60; # in seconds (to the nearest minute) + return 0; +} + +# called every hour and cleans out the dup cache +sub process +{ + my $cutoff = $main::systime - $dupage; + while (my ($key, $val) = each %dup) { + delete $dup{$key} if $val < $cutoff; + } +} + +sub listdups +{ + my @out; + for (sort { $dup{$a} <=> $dup{$b} } keys %dup) { + my $val = $dup{$_}; + push @out, "$_ = $val (" . cldatetime($val) . ")"; + } + return @out; +} 1; __END__;