X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FSpot.pm;h=1dbd96f088bad8c9f84cb138c05c4a55f485a7fb;hb=6e6df48886f4ebdec69cf6980d066773b144fc82;hp=89fdec5b8460dc7b1465d382f144d73b54a51600;hpb=b55a5be0062fb96613a2f42c25de550d69283b7a;p=spider.git diff --git a/perl/Spot.pm b/perl/Spot.pm index 89fdec5b..1dbd96f0 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -20,7 +20,7 @@ use Data::Dumper; use QSL; use DXSql; use Time::HiRes qw(gettimeofday tv_interval); - +use Math::Round qw(nearest nearest_floor); use strict; @@ -73,7 +73,11 @@ our %spotcache; # the cache of data within the last $spotcachedays 0 or 2+ d our $spotcachedays = 2; # default 2 days worth our $minselfspotqrg = 1240000; # minimum freq above which self spotting is allowed -our $readback = 1; +our $readback = $main::is_win ? 0 : 1; # don't read spot files backwards if it's windows +our $qrggranularity = 1000; # normalise the qrg to this number of hz (default: 100khz), so tough luck if you have a fumble fingers moment +our $timegranularity = 600; # ditto to the nearest 100 seconds +our $oldstyle = 0; # revert to traditional dupe key format + if ($readback) { $readback = `which tac`; @@ -347,6 +351,7 @@ sub search dbg("Spot::search hint='$hint', expr='$expr', spotno=$from-$to, day=$dayfrom-$dayto\n") if isdbg('search'); # build up eval to execute + dbg("Spot::search Spot eval: $expr") if isdbg('searcheval'); $expr =~ s/\$r/\$_[0]/g; my $eval = qq{ sub { return $expr; } }; @@ -354,7 +359,6 @@ sub search my $ecode = eval $eval; return ("Spot search error", $@) if $@; - my $fh; my $now = $fromdate; my $today = Julian::Day->new($main::systime); @@ -476,22 +480,30 @@ sub formatl # enter the spot for dup checking and return true if it is already a dup sub dup { - my ($freq, $call, $d, $text, $by, $node) = @_; + my ($freq, $call, $d, $text, $by, $node, $just_find) = @_; + + dbg("Spot::dup: freq=$freq call=$call d=$d text='$text' by=$by node=$node" . ($just_find ? " jf=$just_find" : "")) if isdbg('spotdup'); # dump if too old return 2 if $d < $main::systime - $dupage; - + # turn the time into minutes (should be already but...) $d = int ($d / 60); $d *= 60; + my $nd = nearest($timegranularity, $d); + # remove SSID or area $by =~ s|[-/]\d+$||; # $freq = sprintf "%.1f", $freq; # normalise frequency $freq = int $freq; # normalise frequency + + my $qrg = nearest($qrggranularity, $freq); # to the nearest however many hz + $call = substr($call, 0, $maxcalllth) if length $call > $maxcalllth; + chomp $text; $text =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg; $text = uc unpad($text); @@ -501,32 +513,40 @@ sub dup $text =~ s/\s{2,}[\dA-Z]?[A-Z]\d?$// if length $text > 24; $text =~ s/[\W\x00-\x2F\x7B-\xFF]//g; # tautology, just to make quite sure! $text = substr($text, 0, $duplth) if length $text > $duplth; - my $ldupkey = "X$|$call|$by|$node|$freq|$d|$text"; + my $ldupkey = $oldstyle ? "X|$call|$by|$node|$freq|$d|$text" : "X|$call|$by|$node|$qrg|$nd|$text"; + + dbg("Spot::dup ldupkey $ldupkey") if isdbg('spotdup'); + my $t = DXDupe::find($ldupkey); return 1 if $t && $t - $main::systime > 0; - DXDupe::add($ldupkey, $main::systime+$dupage); + DXDupe::add($ldupkey, $main::systime+$dupage) unless $just_find; $otext = substr($otext, 0, $duplth) if length $otext > $duplth; $otext =~ s/\s+$//; if (length $otext && $otext ne $text) { - $ldupkey = "X$freq|$call|$by|$otext"; + $ldupkey = $oldstyle ? "X|$freq|$call|$by|$otext" : "X|$qrg|$call|$by|$otext"; $t = DXDupe::find($ldupkey); return 1 if $t && $t - $main::systime > 0; - DXDupe::add($ldupkey, $main::systime+$dupage); + DXDupe::add($ldupkey, $main::systime+$dupage) unless $just_find; } return undef; } +sub dup_find +{ + return dup(@_, 1); +} + sub listdups { return DXDupe::listdups('X', $dupage, @_); } -sub genstats($) +sub genstats { my $date = shift; - my $in = $fp->open($date); - my $out = $statp->open($date, 'w'); + my $in = $fp->open($date) or dbg("Spot::genstats: Cannot open " . $fp->fn($date) . " $!"); + my $out = $statp->open($date, 'w') or dbg("Spot::genstats: Cannot open " . $statp->fn($date) . " $!"); my @freq; my %list; my @tot; @@ -569,7 +589,7 @@ sub genstats($) } # return true if the stat file is newer than than the spot file -sub checkstats($) +sub checkstats { my $date = shift; my $in = $fp->mtime($date);