# this is to allow the feed to "warm up" with duplicates
# so that the "big rush" doesn't happen.
-our $minspottime = 30*60; # the time between respots of a callsign - if a call is
+our $respottime = 30*60; # the time between respots of a callsign - if a call is
# still being spotted (on the same freq) and it has been
# spotted before, it's spotted again after this time
- # until the next minspottime has passed.
+ # until the next respottime has passed.
+
our $beacontime = 5*60; # same as minspottime, but for beacons (and shorter)
our $dwelltime = 10; # the amount of time to wait for duplicates before issuing
# a spot to the user (no doubt waiting with bated breath).
+our $limbotime = 5*60; # if there are fewer than $minqual candidates and $dwelltime
+ # has expired then allow this spot to live a bit longer. It may
+ # simply be that it is not in standard spot coverage. (ask G4PIQ
+ # about this).
+
+our $cachetime = 60*60; # The length of time spot data is cached
+
our $filterdef = $Spot::filterdef; # we use the same filter as the Spot system. Can't think why :-).
my $spots; # the GLOBAL spot cache
+my $qrg; # the GlOBAL (ephemeral) qrg cache (generated on re-read of cache)
+
my %runtime; # how long each channel has been running
our $maxqrgdiff = 10; # the maximum
our $minqual = 2; # the minimum quality we will accept for output
+our $maxqual = 9; # if there is enough quality, then short circuit any remaining dwelltime.
my $json;
my $noinrush = 0; # override the inrushpreventor if set
our $maxdeviants = 5; # the number of deviant QRGs to record for skimmer records
+our %seeme; # the list of users that want to see themselves
+
+
sub init
{
$json = DXJSON->new;
$self->{norawhour} = 0;
$self->{sort} = 'N';
$self->{lasttime} = $main::systime;
- $self->{minspottime} = $minspottime;
+ $self->{respottime} = $respottime;
$self->{beacontime} = $beacontime;
$self->{showstats} = 0;
$self->{pingint} = 0;
return;
}
- $origin =~ s/\-(?:\d{1,2}\-)?\#$//; # get rid of all the crap we aren't interested in
+ # remove all extraneous crap from the origin - just leave the base callsign
+ my $norigin = basecall($origin);
+ unless ($norigin) {
+ dbg("RBN: ERROR '$origin' is an invalid callsign, dumped");
+ return;
+ }
+ $origin = $norigin;
+ # is this callsign in badspotter list?
+ if ($DXProt::badspotter->in($origin) || $DXProt::badnode->in($origin)) {
+ dbg("RBN: ERROR $origin is a bad spotter/node, dumped");
+ return;
+ }
+
+ # is the qrg valid
+ unless ($qrg =~ /^\d+\.\d{1,3}$/) {
+ dbg("RBN: ERROR qrg $qrg from $origin invalid, dumped");
+ return;
+ }
$sort ||= '';
$tx ||= '';
$qra ||= '';
- dbg qq{RBN:input decode or:$origin qr:$qrg ca:$call mo:$mode s:$s m:$m sp:$spd u:$u sort:$sort t:$t tx:$tx qra:$qra} if $dbgrbn;
+ dbg qq{RBN:input decode or:$origin qr:$qrg ca:$call mo:$mode s:$s m:$m sp:$spd u:$u sort:$sort t:$t tx:$tx qra:$qra} if $dbgrbn && isdbg('rbn');
++$self->{noraw};
++$self->{noraw10};
my $nqrg = nearest(1, $qrg * 10); # normalised to nearest Khz
my $sp = "$call|$nqrg"; # hopefully the skimmers will be calibrated at least this well!
+ # deal with the unix time
+ my ($hh,$mm) = $t =~ /(\d\d)(\d\d)Z$/;
+ my $utz = $hh*3600 + $mm*60 + $main::systime_daystart; # possible issue with late spot from previous day
+ $utz -= 86400 if $utz > $now+3600; # too far ahead, drag it back one day
+
+ #
+ # But before we do anything, if this call is in the seeme hash then just send the spot to them
+ #
+ if (exists $seeme{$call} && (my $scall = $seeme{$call})) {
+ my $uchan = DXChannel::get($call);
+ if ($uchan->is_user) {
+ if (isdbg('seeme')) {
+ dbg("seeme: $line");
+ dbg( qq{seemme:decode or:$origin qr:$qrg ca:$call mo:$mode s:$s m:$m sp:$spd u:$u sort:$sort t:$t tx:$tx qra:$qra});
+ }
+ my @s = Spot::prepare($qrg, $call, $utz, sprintf("%-3s %2ddB **SEEME**", $mode, $s), $origin.'-#');
+ my $buf = $uchan->format_dx_spot(@s);
+ dbg("seeme: result '$buf'") if isdbg('seeme');
+ $uchan->local_send('S', $buf) if $scall;
+ } else {
+ LogDbg("RBN Someone is playing silly persons $call is not a user and cannot do 'seeme', ignored and reset");
+ delete $seeme{$call};
+ }
+ }
# find it?
my $cand = $spots->{$sp};
unless ($cand) {
}
if ($cand) {
my $diff = $i - $nqrg;
- dbg(qq{RBN: QRG Diff using $new (+$diff) for $sp for qrg $qrg}) if (isdbg('rbnqrg') || $dbgrbn);
+ dbg(qq{RBN: QRG Diff using $new (+$diff) for $sp for qrg $qrg}) if (isdbg('rbnqrg') || ($dbgrbn && isdbg('rbn')));
$sp = $new;
}
}
}
if ($cand) {
my $diff = $nqrg - $i;
- dbg(qq{RBN: QRG Diff using $new (-$diff) for $sp for qrg $qrg}) if (isdbg('rbnqrg') || $dbgrbn);
+ dbg(qq{RBN: QRG Diff using $new (-$diff) for $sp for qrg $qrg}) if (isdbg('rbnqrg') || ($dbgrbn && isdbg('rbn')));
$sp = $new;
}
}
my $respot = 0;
if ($cand && ref $cand) {
if (@$cand <= CData) {
- if ($self->{minspottime} > 0 && $now - $cand->[CTime] < $self->{minspottime}) {
- dbg("RBN: key: '$sp' call: $call qrg: $qrg DUPE \@ ". atime(int $cand->[CTime])) if $dbgrbn;
+ if ($self->{respottime} > 0 && $now - $cand->[CTime] < $self->{respottime}) {
+ dbg("RBN: key: '$sp' call: $call qrg: $qrg DUPE \@ ". atime(int $cand->[CTime])) if $dbgrbn && isdbg('rbn');
return;
}
- dbg("RBN: key: '$sp' RESPOTTING call: $call qrg: $qrg last seen \@ ". atime(int $cand->[CTime])) if $dbgrbn;
+ dbg("RBN: key: '$sp' RESPOTTING call: $call qrg: $qrg last seen \@ ". atime(int $cand->[CTime])) if $dbgrbn && isdbg('rbn');
$cand->[CTime] = $now;
++$respot;
}
} else {
# new spot / frequency
$spots->{$sp} = $cand = [$now, 0];
- dbg("RBN: key: '$sp' call: $call qrg: $qrg NEW" . ($respot ? ' RESPOT' : '')) if $dbgrbn;
+ dbg("RBN: key: '$sp' call: $call qrg: $qrg NEW" . ($respot ? ' RESPOT' : '')) if $dbgrbn && isdbg('rbn');
}
# add me to the display queue unless we are waiting for initial in rush to finish
return unless $noinrush || $self->{inrushpreventor} < $main::systime;
# build up a new record and store it in the buildup
- # deal with the unix time
- my ($hh,$mm) = $t =~ /(\d\d)(\d\d)Z$/;
- my $utz = $hh*3600 + $mm*60 + $main::systime_daystart; # possible issue with late spot from previous day
- $utz -= 86400 if $utz > $now+3600; # too far ahead, drag it back one day
-
# create record and add into the buildup
my $r = [$origin, nearest(.1, $qrg), $call, $mode, $s, $t, $utz, $respot, $u];
my @s = Spot::prepare($r->[RQrg], $r->[RCall], $r->[RUtz], '', $r->[ROrigin]);
++$self->{queue}->{$sp};# unless @$cand>= CData; # queue the KEY (not the record)
- dbg("RBN: key: '$sp' ADD RECORD call: $call qrg: $qrg origin: $origin respot: $respot") if $dbgrbn;
+ dbg("RBN: key: '$sp' ADD RECORD call: $call qrg: $qrg origin: $origin respot: $respot") if $dbgrbn && isdbg('rbn');
push @$cand, $r;
} else {
- dbg "RBN:DATA,$line" if $dbgrbn;
+ dbg "RBN:DATA,$line" if $dbgrbn && isdbg('rbn');
}
}
my $quality = shift;
my $cand = shift;
my $call = $dxchan->{call};
- my $seeme = $dxchan->user->rbnseeme();
my $strength = 100; # because it could if we talk about FTx
my $saver;
my %zone;
++$zone{$s->[SZone]}; # save the spotter's zone
- # if the 'see me' flag is set, then show all the spots without further adornment (see set/rbnseeme for more info)
- if ($seeme) {
- send_final($dxchan, $s);
- next;
- }
-
# save the lowest strength one
if ($r->[RStrength] < $strength) {
$strength = $r->[RStrength];
unless ($user->qra && is_qra($user->qra)) {
$user->qra($qra);
dbg("RBN: update qra on $saver->[SCall] to $qra");
- $user->put;
}
+ # update lastseen if nothing else
+ $user->put;
}
}
}
$buf = $dxchan->format_dx_spot(@$saver);
$saver->[SOrigin] = $call;
}
- $dxchan->local_send('N', $buf);
+ $dxchan->local_send('R', $buf);
}
# per second
foreach my $sp (keys %{$dxchan->{queue}}) {
my $cand = $spots->{$sp};
++$items;
+
unless ($cand && $cand->[CTime]) {
dbg "RBN Cand $sp " . ($cand ? 'def' : 'undef') . " [CTime] " . ($cand->[CTime] ? 'def' : 'undef') . " dwell $dwelltime";
+ delete $spots->{$sp};
+ delete $dxchan->{queue}->{$sp}; # remove
next;
- }
- if ($now >= $cand->[CTime] + $dwelltime ) {
+ }
+
+ my $ctime = $cand->[CTime];
+ my $quality = @$cand - CData;
+ my $dwellsecs = $now - $ctime;
+ if ($quality >= $maxqual || $dwellsecs >= $dwelltime || $dwellsecs >= $limbotime) {
# we have a candidate, create qualitee value(s);
unless (@$cand > CData) {
dbg "RBN: QUEUE key '$sp' MISSING RECORDS, IGNORED" . dd($cand) if isdbg 'rbnqueue';
next;
}
dbg "RBN: QUEUE PROCESSING key: '$sp' $now >= $cand->[CTime]" if isdbg 'rbnqueue';
- my $quality = @$cand - CData;
my $spotters = $quality;
- # dump it and remove it from the queue if it is of unadequate quality
- if ($quality < $minqual) {
- if ($rbnskim) {
- my $r = $cand->[CData];
+ # dump it and remove it from the queue if it is of unadequate quality, but only if it is no longer in Limbo and can be reasonably passed on to its demise
+ my $r = $cand->[CData];
+ if ($dwellsecs > $limbotime && $quality < $minqual) {
+ if ( $rbnskim && isdbg('rbnskim')) {
+ $r = $cand->[CData];
if ($r) {
- my $s = "RBN:SKIM Ignored (Q:$quality < Q:$minqual) key: '$sp' = $r->[RCall] on $r->[RQrg] by $r->[ROrigin] \@ $r->[RTime] route: $dxchan->{call}";
+ my $lastin = difft($ctime, $now, 2);
+ my $s = "RBN:SKIM time in Limbo exceeded DUMPED (lastin: $lastin Q:$quality < Q:$minqual) key: '$sp' = $r->[RCall] on $r->[RQrg] by $r->[ROrigin] \@ $r->[RTime] route: $dxchan->{call}";
dbg($s);
}
}
next;
}
+ # we have a possible removal from Limbo, check for more than one skimmer and reset the quality if required
+ # DOES THIS TEST CAUSE RACES?
+ if (!$r->[Respot] && $quality >= $minqual && $dwellsecs > $dwelltime+1) {
+
+ # because we don't need to check for repeats by the same skimmer in the normal case, we do here
+ my %seen;
+ my @origin;
+ foreach my $wr (@$cand) {
+ next unless ref $wr;
+ push @origin, $wr->[ROrigin];
+ if (exists $seen{$wr->[ROrigin]}) {
+ next;
+ }
+ $seen{$wr->[ROrigin]} = $wr;
+ }
+ # reset the quality to ignore dupes
+ my $oq = $quality;
+ $quality = keys %seen;
+ if ($quality >= $minqual) {
+ if ( $rbnskim && isdbg('rbnskim')) {
+ my $lastin = difft($ctime, $now, 2);
+ my $sk = join ' ', keys %seen;
+ my $or = join ' ', @origin;
+ my $s = "RBN:SKIM promoted from Limbo - key: '$sp' (lastin: $lastin Q now: $quality was $oq skimmers now: $sk";
+ $s .= " was $or" if $or ne $sk;
+ $s .= ')';
+ dbg($s);
+ }
+ } elsif ($oq != $quality) {
+ if ( $rbnskim && isdbg('rbnskim')) {
+ my $lastin = difft($ctime, $now, 2);
+ my $sk = join ' ', keys %seen;
+ my $or = join ' ', @origin;
+ my $s = "RBN:SKIM quality reset key: '$sp' (lastin: $lastin Q now: $quality was $oq skimmers now: $sk was: $or)";
+ dbg($s);
+ }
+ # remove the excess
+ my @ncand = (@$cand[CTime, CQual], values %seen);
+ $spots->{$sp} = \@ncand;
+ }
+ }
+
+ # we now kick this spot into Limbo
+ if ($quality < $minqual) {
+ next;
+ }
+
$quality = 9 if $quality > 9;
$cand->[CQual] = $quality if $quality > $cand->[CQual];
- my $r;
-
# this scores each candidate according to its skimmer's QRG score (i.e. how often it agrees with its peers)
# what happens is hash of all QRGs in candidates are incremented by that skimmer's reputation for "accuracy"
# or, more exactly, past agreement with the consensus. This score can be from -5 -> +5.
foreach $r (@$cand) {
next unless ref $r;
if (exists $seen{$r->[ROrigin]}) {
- undef $r;
+ $r = 0;
next;
}
$seen{$r->[ROrigin]} = 1;
$skimmer = $spots->{$sk};
unless ($skimmer) {
$skimmer = $spots->{$sk} = [1, 0, 0, $now, []]; # this first time, this new skimmer gets the benefit of the doubt on frequency.
- dbg("RBN:SKIM new slot $sk " . $json->encode($skimmer)) if $rbnskim;
+ dbg("RBN:SKIM new slot $sk " . $json->encode($skimmer)) if $rbnskim && isdbg('rbnskim');
}
$qrg{$r->[RQrg]} += ($skimmer->[DScore] || 1);
}
# Ignore possible spots with 0 QRG score - as determined by the skimmer scoring system above - as they are likely to be wrong
unless ($qrg > 0) {
- if ($rbnskim) {
+ if ( $rbnskim && isdbg('rbnskim')) {
my $keys;
while (my ($k, $v) = (each %qrg)) {
$keys .= "$k=>$v, ";
shift @{$skimmer->[DEviants]};
}
$skimmer->[DScore] = $skimmer->[DGood] - $skimmer->[DBad];
- my $lastin = difft($skimmer->[DLastin], $now, 2);
- my $difflist = join(', ', @{$skimmer->[DEviants]});
- $difflist = " ($difflist)" if $difflist;
- dbg("RBN:SKIM key $sp slot $sk $r->[RQrg] - $qrg = $diff Skimmer score: $skimmer->[DGood] - $skimmer->[DBad] = $skimmer->[DScore] lastseen:$lastin ago$difflist") if $rbnskim;
+ if ($rbnskim && isdbg('rbnskim')) {
+ my $lastin = difft($skimmer->[DLastin], $now, 2);
+ my $difflist = join(', ', @{$skimmer->[DEviants]});
+ $difflist = " band qrg diffs: $difflist" if $difflist;
+ dbg("RBN:SKIM key $sp slot $sk $r->[RQrg] - $qrg = $diff Skimmer score: $skimmer->[DGood] - $skimmer->[DBad] = $skimmer->[DScore] lastseen:$lastin ago$difflist");
+ }
$skimmer->[DLastin] = $now;
$r->[RSpotData]->[SQrg] = $qrg if $qrg && $c > 1; # set all the QRGs to the agreed value
}
$squality .= '+' if $r->[Respot];
if (isdbg('progress')) {
- my $s = "RBN: SPOT key: '$sp' = $r->[RCall] on $r->[RQrg] by $r->[ROrigin] \@ $r->[RTime] $squality route: $dxchan->{call}";
+ my $rt = difft($ctime, $now, 2);
+ my $s = "RBN: SPOT key: '$sp' = $r->[RCall] on $r->[RQrg] by $r->[ROrigin] \@ $r->[RTime] $squality route: $dxchan->{call} dwell:$rt";
my $td = @deviant;
- $s .= " QRGScore $mv Deviants ($td/$spotters): ";
- $s .= join(', ', sort @deviant) if $td;
+ $s .= " QRGScore: $mv Deviants: $td/$spotters";
+ $s .= ' (' . join(', ', sort @deviant) . ')' if $td;
dbg($s);
}
my $nqrg = nearest(1, $qrg * 10); # normalised to nearest Khz
my $nsp = "$r->[RCall]|$nqrg";
if ($sp ne $nsp) {
- dbg("RBN:SKIM CHANGE KEY sp '$sp' -> '$nsp' for storage") if $rbnskim;
+ dbg("RBN:SKIM CHANGE KEY sp '$sp' -> '$nsp' for storage") if $rbnskim && isdbg('rbnskim');
delete $spots->{$sp};
$spots->{$nsp} = [$now, $cand->[CQual]];
} else {
next if $k =~ /^O\|/;
next if $k =~ /^SKIM\|/;
- if ($main::systime - $cand->[CTime] > $minspottime*2) {
+ if ($main::systime - $cand->[CTime] > $cachetime) {
delete $spots->{$k};
++$removed;
}
return undef;
}
+sub add_seeme
+{
+ my $call = shift;
+ $seeme{basecall($call)} = 1;
+}
+
+sub del_seeme
+{
+ my $call = shift;
+ delete $seeme{basecall($call)};
+}
1;
projects / spider.git / blobdiff