X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FSpot.pm;h=c492d918ab98a5a6941d3fb5a3c6451327a73223;hb=433209e1efed23493f25f1357d9c003696c1fb59;hp=df2a9730db869361a3a355a2d9475fab26c46cd0;hpb=bf70ca01121eabfc655ce899ebd14b1d31d1047f;p=spider.git diff --git a/perl/Spot.pm b/perl/Spot.pm index df2a9730..c492d918 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`; @@ -189,7 +193,6 @@ sub init if ($spotcachedays > 0) { my $t0 = [gettimeofday]; $spotcachedays = 2 if $spotcachedays < 2; - dbg "Spot::init - reading in $spotcachedays days of spots into cache"; for (my $i = 0; $i < $spotcachedays; ++$i) { my $now = $today->sub($i); my $fh = $fp->open($now); @@ -238,10 +241,9 @@ sub prepare # remove ssids and /xxx if present on spotter $out[4] =~ s/-\d+$//o; - # remove leading and trailing spaces + # remove leading and trailing spaces from comment field $out[3] = unpad($out[3]); - # add the 'dxcc' country on the end for both spotted and spotter, then the cluster call my @spd = Prefix::cty_data($out[1]); push @out, $spd[0]; @@ -348,6 +350,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; } }; @@ -355,7 +358,6 @@ sub search my $ecode = eval $eval; return ("Spot search error", $@) if $@; - my $fh; my $now = $fromdate; my $today = Julian::Day->new($main::systime); @@ -460,62 +462,78 @@ sub formatl { my $t = ztime($_[3]); my $d = cldate($_[3]); - my $width = ($_[0] ? $_[0] : 80) - 80 + 28; + my $spotter = "<$_[5]>"; my $comment = $_[4] || ''; - $comment = substr $comment, 0, $width if length($comment) > $width; - $comment .= ' ' x ($width - length($comment)) if length($comment) < $width; + $comment =~ s/\t+/ /g; + my $cl = length $comment; + my $s = sprintf "%9.1f %-11s %s %s", $_[1], $_[2], $d, $t; + my $width = ($_[0] ? $_[0] : 80) - length($spotter) - length($s) - 4; + + $comment = substr $comment, 0, $width if $cl > $width; + $comment .= ' ' x ($width-$cl) if $cl < $width; # return sprintf "%8.1f %-11s %s %s %-28.28s%7s>", $_[0], $_[1], $d, $t, ($_[3]||''), "<$_[4]" ; - return sprintf "%8.1f %-11s %s %s ${comment}%7s>", $_[1], $_[2], $d, $t, "<$_[5]" ; + return "$s $comment$spotter"; } # enter the spot for dup checking and return true if it is already a dup sub dup { - my ($freq, $call, $d, $text, $by, $cty) = @_; + 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); - if ($cty && $text && length $text <= 4) { - unless ($text =~ /^C?Q/ || $text =~ /^[\d\W]+$/) { - my @try = Prefix::cty_data($text); - $text = "" if $cty == $try[0]; - } - } my $otext = $text; # $text = Encode::encode("iso-8859-1", $text) if $main::can_encode && Encode::is_utf8($text, 1); $text =~ s/^\+\w+\s*//; # remove leading LoTW callsign $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$freq|$call|$by|$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 0; + return undef; +} + +sub dup_find +{ + return dup(@_, 1); } sub listdups @@ -523,11 +541,11 @@ 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; @@ -570,7 +588,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);