2 # The RBN connection system
4 # Copyright (c) 2020 Dirk Koopman G1TLH
21 use Math::Round qw(nearest nearest_floor);
23 use Time::HiRes qw(gettimeofday);
70 our $DATA_VERSION = 1;
72 our @ISA = qw(DXChannel);
74 our $startup_delay = 5*60; # don't send anything out until this timer has expired
75 # this is to allow the feed to "warm up" with duplicates
76 # so that the "big rush" doesn't happen.
78 our $respottime = 3*60; # the time between respots of a callsign - if a call is
79 # still being spotted (on the same freq) and it has been
80 # spotted before, it's spotted again after this time
81 # until the next respottime has passed.
84 our $beacontime = 5*60; # same as minspottime, but for beacons (and shorter)
86 our $dwelltime = 10; # the amount of time to wait for duplicates before issuing
87 # a spot to the user (no doubt waiting with bated breath).
89 our $limbotime = 5*60; # if there are fewer than $minqual candidates and $dwelltime
90 # has expired then allow this spot to live a bit longer. It may
91 # simply be that it is not in standard spot coverage. (ask G4PIQ
94 our $cachetime = 60*60; # The length of time spot data is cached
96 our $filterdef = $Spot::filterdef; # we use the same filter as the Spot system. Can't think why :-).
98 my $spots; # the GLOBAL spot cache
99 my $qrg; # the GlOBAL (ephemeral) qrg cache (generated on re-read of cache)
102 my %runtime; # how long each channel has been running
104 our $cachefn = localdata('rbn_cache');
105 our $cache_valid = 4*60; # The cache file is considered valid if it is not more than this old
107 our $maxqrgdiff = 10; # the maximum
108 our $minqual = 2; # the minimum quality we will accept for output
109 our $maxqual = 9; # if there is enough quality, then short circuit any remaining dwelltime.
112 my $noinrush = 0; # override the inrushpreventor if set
113 our $maxdeviants = 5; # the number of deviant QRGs to record for skimmer records
115 our %seeme; # the list of users that want to see themselves
125 $spots = {VERSION=>$DATA_VERSION};
127 if (defined $DB::VERSION) {
136 my $self = DXChannel::alloc(@_);
138 # routing, this must go out here to prevent race condx
145 $self->{nouser} = {};
147 $self->{noraw10} = 0;
148 $self->{nospot10} = 0;
149 $self->{nouser10} = {};
150 $self->{norbn10} = 0;
151 $self->{nospothour} = 0;
152 $self->{nouserhour} = {};
153 $self->{norbnhour} = 0;
154 $self->{norawhour} = 0;
156 $self->{lasttime} = $main::systime;
157 $self->{respottime} = $respottime;
158 $self->{beacontime} = $beacontime;
159 $self->{showstats} = 0;
160 $self->{pingint} = 0;
161 $self->{nopings} = 0;
169 my ($self, $line, $sort) = @_;
170 my $user = $self->{user};
171 my $call = $self->{call};
172 my $name = $user->{name};
175 my $host = $self->{conn}->peerhost;
177 $self->{hostname} = $host;
179 $self->{name} = $name ? $name : $call;
180 $self->state('prompt'); # a bit of room for further expansion, passwords etc
181 $self->{lang} = $user->lang || $main::lang || 'en';
182 if ($line =~ /host=/) {
183 my ($h) = $line =~ /host=(\d+\.\d+\.\d+\.\d+)/;
184 $line =~ s/\s*host=\d+\.\d+\.\d+\.\d+// if $h;
186 ($h) = $line =~ /host=([\da..fA..F:]+)/;
187 $line =~ s/\s*host=[\da..fA..F:]+// if $h;
191 $self->{hostname} = $h;
194 $self->{width} = 80 unless $self->{width} && $self->{width} > 80;
195 $self->{consort} = $line; # save the connection type
197 LogDbg('DXCommand', "$call connected from $self->{hostname}");
199 # set some necessary flags on the user if they are connecting
200 $self->{registered} = 1;
201 # sort out privilege reduction
206 $nossid =~ s/-\d+$//;
208 $self->{inrbnfilter} = Filter::read_in('rbn', $call, 1)
209 || Filter::read_in('rbn', 'node_default', 1);
211 # clean up qra locators
212 my $qra = $user->qra;
213 $qra = undef if ($qra && !DXBearing::is_qra($qra));
215 my $lat = $user->lat;
216 my $long = $user->long;
217 $user->qra(DXBearing::lltoqra($lat, $long)) if (defined $lat && defined $long);
220 # if we have been running and stopped for a while
221 # if the cache is warm enough don't operate the inrush preventor
222 $self->{inrushpreventor} = exists $runtime{$call} && $runtime{$call} > $startup_delay || $noinrush ? 0 : $main::systime + $startup_delay;
223 dbg("RBN: noinrush: $noinrush, setting inrushpreventor on $self->{call} to $self->{inrushpreventor}");
226 my @queue; # the queue of spots ready to send
233 my $dbgrbn = isdbg('rbn');
235 # remove leading and trailing spaces
242 my $now = $main::systime;
245 dbg "RBN:RAW,$line" if isdbg('rbnraw');
246 return unless $line=~/^DX\s+de/;
248 my (undef, undef, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t, $tx) = split /[:\s]+/, $line;
250 # fix up FT8 spots from 7001
251 $t = $u, $u = '' if !$t && is_ztime($u);
252 $t = $sort, $sort = '' if !$t && is_ztime($sort);
253 my $qra = $spd, $spd = '' if is_qra($spd);
256 # is this anything like a callsign?
257 unless (is_callsign($call)) {
258 dbg("RBN: ERROR $call from $origin on $qrg is invalid, dumped");
262 # remove all extraneous crap from the origin - just leave the base callsign
263 my $norigin = basecall($origin);
265 dbg("RBN: ERROR '$origin' is an invalid callsign, dumped");
270 # is this callsign in badspotter list?
271 if ($DXProt::badspotter->in($origin) || $DXProt::badnode->in($origin)) {
272 dbg("RBN: ERROR $origin is a bad spotter/node, dumped");
277 unless ($qrg =~ /^\d+\.\d{1,3}$/) {
278 dbg("RBN: ERROR qrg $qrg from $origin invalid, dumped");
285 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');
289 ++$self->{norawhour};
295 # fix up times for things like 'NXDXF B' etc
296 if ($tx && is_ztime($t)) {
305 if ($sort && $sort eq 'NCDXF') {
309 if ($sort && $sort eq 'BEACON') {
312 if ($mode =~ /^PSK/) {
315 if ($mode eq 'RTTY') {
319 # The main de-duping key is [call, $frequency], but we probe a bit around that frequency to find a
320 # range of concurrent frequencies that might be in play.
322 # The key to this is deducing the true callsign by "majority voting" (the greater the number of spotters
323 # the more effective this is) together with some lexical analsys probably in conjuction with DXSpider
324 # data sources (for singleton spots) to then generate a "centre" from and to zone (whatever that will mean if it isn't the usual one)
325 # and some heuristical "Kwalitee" rating given distance from the zone centres of spotter, recipient user
326 # and spotted. A map can be generated once per user and spotter as they are essentially mostly static.
327 # The spotted will only get a coarse position unless other info is available. Programs that parse
328 # DX bulletins and the online data online databases could be be used and then cached.
330 # Obviously users have to opt in to receiving RBN spots and other users will simply be passed over and
333 # Clearly this will only work in the 'mojo' branch of DXSpider where it is possible to pass off external
334 # data requests to ephemeral or semi resident forked processes that do any grunt work and the main
335 # process to just the standard "message passing" which has been shown to be able to sustain over 5000
336 # per second (limited by the test program's output and network speed, rather than DXSpider's handling).
339 my $nqrg = nearest(1, $qrg * 10); # normalised to nearest Khz
340 my $sp = "$call|$nqrg"; # hopefully the skimmers will be calibrated at least this well!
342 # deal with the unix time
343 my ($hh,$mm) = $t =~ /(\d\d)(\d\d)Z$/;
344 my $utz = $hh*3600 + $mm*60 + $main::systime_daystart; # possible issue with late spot from previous day
345 $utz -= 86400 if $utz > $now+3600; # too far ahead, drag it back one day
348 # But before we do anything, if this call is in the seeme hash then just send the spot to them
350 if (exists $seeme{$call} && (my $ref = $seeme{$call})) {
351 foreach my $rcall ( @$ref) {
352 my $uchan = DXChannel::get($rcall);
354 if ($uchan->is_user) {
355 if (isdbg('seeme')) {
357 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});
359 my @s = Spot::prepare($qrg, $call, $utz, sprintf("%-3s %2ddB **SEEME**", $mode, $s), $origin.'-#');
360 my $buf = $uchan->format_dx_spot(@s);
361 dbg("seeme: result '$buf'") if isdbg('seeme');
362 $uchan->local_send('S', $buf);
364 LogDbg("RBN Someone is playing silly persons $rcall is not a user and cannot do 'seeme', ignored and reset");
372 my $cand = $spots->{$sp};
375 for ($i = $nqrg; !$cand && $i <= $nqrg+$search; $i += 1) {
377 $cand = $spots->{$new}, last if exists $spots->{$new};
380 my $diff = $i - $nqrg;
381 dbg(qq{RBN: QRG Diff using $new (+$diff) for $sp for qrg $qrg}) if (isdbg('rbnqrg') || ($dbgrbn && isdbg('rbn')));
387 for ($i = $nqrg; !$cand && $i >= $nqrg-$search; $i -= 1) {
389 $cand = $spots->{$new}, last if exists $spots->{$new};
392 my $diff = $nqrg - $i;
393 dbg(qq{RBN: QRG Diff using $new (-$diff) for $sp for qrg $qrg}) if (isdbg('rbnqrg') || ($dbgrbn && isdbg('rbn')));
398 # if we have one and there is only one slot and that slot's time isn't expired for respot then return
400 if ($cand && ref $cand) {
401 if (@$cand <= CData) {
402 if ($self->{respottime} > 0 && $now - $cand->[CTime] < $self->{respottime}) {
403 dbg("RBN: key: '$sp' call: $call qrg: $qrg DUPE \@ ". atime(int $cand->[CTime])) if $dbgrbn && isdbg('rbn');
407 dbg("RBN: key: '$sp' RESPOTTING call: $call qrg: $qrg last seen \@ ". atime(int $cand->[CTime])) if $dbgrbn && isdbg('rbn');
408 $cand->[CTime] = $now;
412 # otherwise we have a spot being built up at the moment
414 dbg("RBN: key '$sp' = '$cand' not ref");
417 # new spot / frequency
418 $spots->{$sp} = $cand = [$now, 0];
419 dbg("RBN: key: '$sp' call: $call qrg: $qrg NEW" . ($respot ? ' RESPOT' : '')) if $dbgrbn && isdbg('rbn');
422 # add me to the display queue unless we are waiting for initial in rush to finish
423 return unless $noinrush || $self->{inrushpreventor} < $main::systime;
425 # build up a new record and store it in the buildup
426 # create record and add into the buildup
427 my $r = [$origin, nearest(.1, $qrg), $call, $mode, $s, $t, $utz, $respot, $u];
428 my @s = Spot::prepare($r->[RQrg], $r->[RCall], $r->[RUtz], '', $r->[ROrigin]);
430 dbg("RBN: ERROR invalid prefix/callsign $call from $origin-# on $qrg, dumped");
434 if ($self->{inrbnfilter}) {
435 my ($want, undef) = $self->{inrbnfilter}->it($s);
438 $r->[RSpotData] = \@s;
440 ++$self->{queue}->{$sp};# unless @$cand>= CData; # queue the KEY (not the record)
442 dbg("RBN: key: '$sp' ADD RECORD call: $call qrg: $qrg origin: $origin respot: $respot") if $dbgrbn && isdbg('rbn');
447 dbg "RBN:DATA,$line" if $dbgrbn && isdbg('rbn');
451 # we should get the spot record minus the time, so just an array of record (arrays)
460 ++$self->{norbnhour};
462 # $r = [$origin, $qrg, $call, $mode, $s, $utz, $respot];
464 my $mode = $cand->[CData]->[RMode]; # as all the modes will be the same;
466 my @dxchan = DXChannel::get_all();
468 foreach my $dxchan (@dxchan) {
469 next unless $dxchan->is_user;
470 my $user = $dxchan->{user};
471 next unless $user && $user->wantrbn;
473 # does this user want this sort of spot at all?
475 ++$want if $user->wantbeacon && $mode =~ /^BCN|DXF/;
476 ++$want if $user->wantcw && $mode =~ /^CW/;
477 ++$want if $user->wantrtty && $mode =~ /^RTT/;
478 ++$want if $user->wantpsk && $mode =~ /^PSK|FSK|MSK/;
479 ++$want if $user->wantft && $mode =~ /^FT/;
481 dbg(sprintf("RBN: spot selection for $dxchan->{call} mode: '$mode' want: $want flags rbn:%d ft:%d bcn:%d cw:%d psk:%d rtty:%d",
488 )) if isdbg('rbnll');
490 # send one spot to one user out of the ones that we have
491 $self->dx_spot($dxchan, $quality, $cand) if $want;
501 my $call = $dxchan->{call};
502 my $strength = 100; # because it could if we talk about FTx
508 ++$self->{nousers}->{$call};
509 ++$self->{nousers10}->{$call};
510 ++$self->{nousershour}->{$call};
513 my $rf = $dxchan->{rbnfilter} || $dxchan->{spotsfilter};
516 foreach my $r (@$cand) {
517 # $r = [$origin, $qrg, $call, $mode, $s, $t, $utz, $respot, $qra];
518 # Spot::prepare($qrg, $call, $utz, $comment, $origin);
519 next unless $r && ref $r;
521 $qra = $r->[RQra] if !$qra && $r->[RQra] && is_qra($r->[RQra]);
523 $comment = sprintf "%-3s %2ddB $quality", $r->[RMode], $r->[RStrength];
524 my $s = $r->[RSpotData]; # the prepared spot
525 $s->[SComment] = $comment; # apply new generated comment
527 ++$zone{$s->[SZone]}; # save the spotter's zone
529 # save the lowest strength one
530 if ($r->[RStrength] < $strength) {
531 $strength = $r->[RStrength];
533 dbg("RBN: STRENGTH spot: $s->[SCall] qrg: $s->[SQrg] origin: $s->[SOrigin] dB: $r->[RStrength] < $strength") if isdbg 'rbnll';
537 my ($want, undef) = $rf->it($s);
538 dbg("RBN: FILTERING for $call spot: $s->[SCall] qrg: $s->[SQrg] origin: $s->[SOrigin] dB: $r->[RStrength] com: '$s->[SComment]' want: " . ($want ? 'YES':'NO')) if isdbg 'rbnll';
545 $saver = $filtered; # if nothing passed the filter's lips then $saver == $filtered == undef !
550 # create a zone list of spotters
551 delete $zone{$saver->[SZone]}; # remove this spotter's zone (leaving all the other zones)
552 my $z = join ',', sort {$a <=> $b} keys %zone;
554 # alter spot data accordingly
555 $saver->[SComment] .= " Z:$z" if $z;
557 send_final($dxchan, $saver);
561 ++$self->{nospothour};
564 my $user = DXUser::get_current($saver->[SCall]) || DXUser->new($saver->[SCall]);
565 unless ($user->qra && is_qra($user->qra)) {
567 dbg("RBN: update qra on $saver->[SCall] to $qra");
569 # update lastseen if nothing else
579 my $call = $dxchan->{call};
582 dbg("RBN: SENDING to $call spot: $saver->[SCall] qrg: $saver->[SQrg] origin: $saver->[SOrigin] $saver->[SComment]") if isdbg 'rbnll';
583 if ($dxchan->{ve7cc}) {
584 my $call = $saver->[SOrigin];
585 $saver->[SOrigin] .= '-#';
586 $buf = VE7CC::dx_spot($dxchan, @$saver);
587 $saver->[SOrigin] = $call;
589 my $call = $saver->[SOrigin];
590 $saver->[SOrigin] = substr($call, 0, 6);
591 $saver->[SOrigin] .= '-#';
592 $buf = $dxchan->format_dx_spot(@$saver);
593 $saver->[SOrigin] = $call;
595 $dxchan->local_send('R', $buf);
601 my $rbnskim = isdbg('rbnskim');
603 foreach my $dxchan (DXChannel::get_all()) {
604 next unless $dxchan->is_rbn;
606 # At this point we run the queue to see if anything can be sent onwards to the punter
607 my $now = $main::systime;
608 my $ta = [gettimeofday];
611 # now run the waiting queue which just contains KEYS ($call|$qrg)
612 foreach my $sp (keys %{$dxchan->{queue}}) {
613 my $cand = $spots->{$sp};
616 unless ($cand && $cand->[CTime]) {
617 dbg "RBN Cand $sp " . ($cand ? 'def' : 'undef') . " [CTime] " . ($cand->[CTime] ? 'def' : 'undef') . " dwell $dwelltime";
618 delete $spots->{$sp};
619 delete $dxchan->{queue}->{$sp}; # remove
623 my $ctime = $cand->[CTime];
624 my $quality = @$cand - CData;
625 my $dwellsecs = $now - $ctime;
626 if ($quality >= $maxqual || $dwellsecs >= $dwelltime || $dwellsecs >= $limbotime) {
627 # we have a candidate, create qualitee value(s);
628 unless (@$cand > CData) {
629 dbg "RBN: QUEUE key '$sp' MISSING RECORDS, IGNORED" . dd($cand) if isdbg 'rbnqueue';
630 delete $spots->{$sp}; # don't remember it either - this means that a spot HAS to come in with sufficient spotters to be processed.
631 delete $dxchan->{queue}->{$sp};
634 dbg "RBN: QUEUE PROCESSING key: '$sp' $now >= $cand->[CTime]" if isdbg 'rbnqueue';
635 my $spotters = $quality;
637 # 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
638 my $r = $cand->[CData];
639 if ($dwellsecs > $limbotime && $quality < $minqual) {
640 if ( $rbnskim && isdbg('rbnskim')) {
643 my $lastin = difft($ctime, $now, 2);
644 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}";
648 delete $spots->{$sp}; # don't remember it either - this means that a spot HAS to come in with sufficient spotters to be processed.
649 delete $dxchan->{queue}->{$sp};
653 # we have a possible removal from Limbo, check for more than one skimmer and reset the quality if required
654 # DOES THIS TEST CAUSE RACES?
655 if (!$r->[Respot] && $quality >= $minqual && $dwellsecs > $dwelltime+1) {
657 # because we don't need to check for repeats by the same skimmer in the normal case, we do here
660 foreach my $wr (@$cand) {
662 push @origin, $wr->[ROrigin];
663 if (exists $seen{$wr->[ROrigin]}) {
666 $seen{$wr->[ROrigin]} = $wr;
668 # reset the quality to ignore dupes
670 $quality = keys %seen;
671 if ($quality >= $minqual) {
672 if ( $rbnskim && isdbg('rbnskim')) {
673 my $lastin = difft($ctime, $now, 2);
674 my $sk = join ' ', keys %seen;
675 my $or = join ' ', @origin;
676 my $s = "RBN:SKIM promoted from Limbo - key: '$sp' (lastin: $lastin Q now: $quality was $oq skimmers now: $sk";
677 $s .= " was $or" if $or ne $sk;
681 } elsif ($oq != $quality) {
682 if ( $rbnskim && isdbg('rbnskim')) {
683 my $lastin = difft($ctime, $now, 2);
684 my $sk = join ' ', keys %seen;
685 my $or = join ' ', @origin;
686 my $s = "RBN:SKIM quality reset key: '$sp' (lastin: $lastin Q now: $quality was $oq skimmers now: $sk was: $or)";
690 my @ncand = (@$cand[CTime, CQual], values %seen);
691 $spots->{$sp} = \@ncand;
695 # we now kick this spot into Limbo
696 if ($quality < $minqual) {
700 $quality = 9 if $quality > 9;
701 $cand->[CQual] = $quality if $quality > $cand->[CQual];
703 # this scores each candidate according to its skimmer's QRG score (i.e. how often it agrees with its peers)
704 # what happens is hash of all QRGs in candidates are incremented by that skimmer's reputation for "accuracy"
705 # or, more exactly, past agreement with the consensus. This score can be from -5 -> +5.
711 foreach $r (@$cand) {
713 if (exists $seen{$r->[ROrigin]}) {
717 $seen{$r->[ROrigin]} = 1;
718 $band ||= int $r->[RQrg] / 1000;
719 $sk = "SKIM|$r->[ROrigin]|$band"; # thus only once per set of candidates
720 $skimmer = $spots->{$sk};
722 $skimmer = $spots->{$sk} = [1, 0, 0, $now, []]; # this first time, this new skimmer gets the benefit of the doubt on frequency.
723 dbg("RBN:SKIM new slot $sk " . $json->encode($skimmer)) if $rbnskim && isdbg('rbnskim');
725 $qrg{$r->[RQrg]} += ($skimmer->[DScore] || 1);
728 # determine the most likely qrg and then set it - NOTE (-)ve votes, generated by the skimmer scoring system above, are ignored
733 while (my ($k, $votes) = each %qrg) {
741 # Ignore possible spots with 0 QRG score - as determined by the skimmer scoring system above - as they are likely to be wrong
743 if ( $rbnskim && isdbg('rbnskim')) {
745 while (my ($k, $v) = (each %qrg)) {
750 foreach $r (@$cand) {
751 next unless $r && ref $r;
752 dbg "RBN:SKIM cand $i QRG likely wrong from '$sp' = $r->[RCall] on $r->[RQrg] by $r->[ROrigin] \@ $r->[RTime] (qrgs: $keys c: $c) route: $dxchan->{call}, ignored";
756 delete $spots->{$sp}; # get rid
757 delete $dxchan->{queue}->{$sp};
761 # detemine and spit out the deviants. Then adjust the scores according to whether it is a deviant or good
762 # NOTE: deviant nodes can become good (or less bad), and good nodes bad (or less good) on each spot that
763 # they generate. This is based solely on each skimmer's agreement (or not) with the "consensus" score generated
764 # above ($qrg). The resultant score + good + bad is stored per band and will be used the next time a spot
765 # appears on this band from each skimmer.
766 foreach $r (@$cand) {
767 next unless $r && ref $r;
768 my $diff = $c > 1 ? nearest(.1, $r->[RQrg] - $qrg) : 0;
769 $sk = "SKIM|$r->[ROrigin]|$band";
770 $skimmer = $spots->{$sk};
772 ++$skimmer->[DBad] if $skimmer->[DBad] < $maxdeviants;
773 --$skimmer->[DGood] if $skimmer->[DGood] > 0;
774 push @deviant, sprintf("$r->[ROrigin]:%+.1f", $diff);
775 push @{$skimmer->[DEviants]}, $diff;
776 shift @{$skimmer->[DEviants]} while @{$skimmer->[DEviants]} > $maxdeviants;
778 ++$skimmer->[DGood] if $skimmer->[DGood] < $maxdeviants;
779 --$skimmer->[DBad] if $skimmer->[DBad] > 0;
780 shift @{$skimmer->[DEviants]};
782 $skimmer->[DScore] = $skimmer->[DGood] - $skimmer->[DBad];
783 if ($rbnskim && isdbg('rbnskim')) {
784 my $lastin = difft($skimmer->[DLastin], $now, 2);
785 my $difflist = join(', ', @{$skimmer->[DEviants]});
786 $difflist = " band qrg diffs: $difflist" if $difflist;
787 dbg("RBN:SKIM key $sp slot $sk $r->[RQrg] - $qrg = $diff Skimmer score: $skimmer->[DGood] - $skimmer->[DBad] = $skimmer->[DScore] lastseen:$lastin ago$difflist");
789 $skimmer->[DLastin] = $now;
790 $r->[RSpotData]->[SQrg] = $qrg if $qrg && $c > 1; # set all the QRGs to the agreed value
793 $qrg = (sprintf "%.1f", $qrg)+0;
796 my $squality = "Q:$cand->[CQual]";
797 $squality .= '*' if $c > 1;
798 $squality .= '+' if $r->[Respot];
800 if (isdbg('progress')) {
801 my $rt = difft($ctime, $now, 2);
802 my $s = "RBN: SPOT key: '$sp' = $r->[RCall] on $r->[RQrg] by $r->[ROrigin] \@ $r->[RTime] $squality route: $dxchan->{call} dwell:$rt";
804 $s .= " QRGScore: $mv Deviants: $td/$spotters";
805 $s .= ' (' . join(', ', sort @deviant) . ')' if $td;
809 # finally send it out to any waiting public
810 send_dx_spot($dxchan, $squality, $cand);
812 # clear out the data and make this now just "spotted", but no further action required until respot time
813 dbg "RBN: QUEUE key '$sp' cleared" if isdbg 'rbn';
815 delete $dxchan->{queue}->{$sp};
817 # calculate new sp (which will be 70% likely the same as the old one)
818 # we do this to cope with the fact that the first spotter may well be "wrongly calibrated" giving a qrg that disagrees with the majority.
819 # and we want to store the key that corresponds to majority opinion.
820 my $nqrg = nearest(1, $qrg * 10); # normalised to nearest Khz
821 my $nsp = "$r->[RCall]|$nqrg";
823 dbg("RBN:SKIM CHANGE KEY sp '$sp' -> '$nsp' for storage") if $rbnskim && isdbg('rbnskim');
824 delete $spots->{$sp};
825 $spots->{$nsp} = [$now, $cand->[CQual]];
827 $spots->{$sp} = [$now, $cand->[CQual]];
831 dbg sprintf("RBN: QUEUE key: '$sp' SEND time not yet reached %.1f secs left", $cand->[CTime] + $dwelltime - $now) if isdbg 'rbnqueue';
834 if (isdbg('rbntimer')) {
835 my $diff = _diffus($ta);
836 dbg "RBN: TIMER process queue for call: $dxchan->{call} $items spots $diff uS";
843 foreach my $dxchan (DXChannel::get_all()) {
844 next unless $dxchan->is_rbn;
845 dbg "RBN:STATS minute $dxchan->{call} raw: $dxchan->{noraw} retrieved spots: $dxchan->{norbn} delivered: $dxchan->{nospot} after filtering to users: " . scalar keys %{$dxchan->{nousers}} if isdbg('rbnstats');
846 if ($dxchan->{noraw} == 0 && $dxchan->{lasttime} > 60) {
847 LogDbg('RBN', "RBN: no input from $dxchan->{call}, disconnecting");
850 $dxchan->{noraw} = $dxchan->{norbn} = $dxchan->{nospot} = 0; $dxchan->{nousers} = {};
851 $runtime{$dxchan->{call}} += 60;
854 # save the spot cache
855 write_cache() unless $main::systime + $startup_delay < $main::systime;;
862 while (my ($k,$cand) = each %{$spots}) {
863 next if $k eq 'VERSION';
864 next if $k =~ /^O\|/;
865 next if $k =~ /^SKIM\|/;
867 if ($main::systime - $cand->[CTime] > $cachetime) {
875 dbg "RBN:STATS spot cache remain: $count removed: $removed"; # if isdbg('rbn');
876 foreach my $dxchan (DXChannel::get_all()) {
877 next unless $dxchan->is_rbn;
878 my $nq = keys %{$dxchan->{queue}};
879 my $pc = $dxchan->{noraw10} ? sprintf("%.1f%%",$dxchan->{norbn10}*100/$dxchan->{noraw10}) : '0.0%';
880 dbg "RBN:STATS 10-minute $dxchan->{call} queue: $nq raw: $dxchan->{noraw10} retrieved spots: $dxchan->{norbn10} ($pc) delivered: $dxchan->{nospot10} after filtering to users: " . scalar keys %{$dxchan->{nousers10}};
881 $dxchan->{noraw10} = $dxchan->{norbn10} = $dxchan->{nospot10} = 0; $dxchan->{nousers10} = {};
887 foreach my $dxchan (DXChannel::get_all()) {
888 next unless $dxchan->is_rbn;
889 my $nq = keys %{$dxchan->{queue}};
890 my $pc = $dxchan->{norawhour} ? sprintf("%.1f%%",$dxchan->{norbnhour}*100/$dxchan->{norawhour}) : '0.0%';
891 dbg "RBN:STATS hour $dxchan->{call} queue: $nq raw: $dxchan->{norawhour} retrieved spots: $dxchan->{norbnhour} ($pc) delivered: $dxchan->{nospothour} after filtering to users: " . scalar keys %{$dxchan->{nousershour}};
892 $dxchan->{norawhour} = $dxchan->{norbnhour} = $dxchan->{nospothour} = 0; $dxchan->{nousershour} = {};
903 my $ta = [ gettimeofday ];
904 $json->indent(1)->canonical(1) if isdbg 'rbncache';
905 my $s = eval {$json->encode($spots)};
907 my $fh = IO::File->new(">$cachefn") or confess("writing $cachefn $!");
911 dbg("RBN:Write_cache error '$@'");
914 $json->indent(0)->canonical(0);
915 my $diff = _diffms($ta);
916 my $size = sprintf('%.3fKB', (length($s) / 1000));
917 dbg("RBN:WRITE_CACHE size: $size time to write: $diff mS");
923 my $mt = (stat($cachefn))[9];
924 my $t = $main::systime - $mt || 1;
925 my $p = difft($mt, 2);
926 if ($t < $cache_valid) {
927 dbg("RBN:check_cache '$cachefn' spot cache exists, created $p ago and not too old");
928 my $fh = IO::File->new($cachefn);
933 dbg("RBN:check_cache cache read size " . length $s);
936 dbg("RBN:check_cache file read error $!");
940 eval {$spots = $json->decode($s)};
941 if ($spots && ref $spots) {
942 if (exists $spots->{VERSION} && $spots->{VERSION} == $DATA_VERSION) {
943 # now clean out anything that has spot build ups in progress
944 while (my ($k, $cand) = each %$spots) {
945 next if $k eq 'VERSION';
946 next if $k =~ /^O\|/;
947 next if $k =~ /^SKIM\|/;
948 if (@$cand > CData) {
949 $spots->{$k} = [$cand->[CTime], $cand->[CQual]];
952 dbg("RBN:check_cache spot cache restored");
956 dbg("RBN::checkcache error decoding $@");
959 my $d = difft($main::systime-$cache_valid);
960 dbg("RBN::checkcache '$cachefn' created $p ago is too old (> $d), ignored");
963 dbg("RBN:check_cache '$cachefn' spot cache not present");
972 my $base = basecall($call);
973 my $ref = $seeme{$base} || [];
974 push @$ref, $call unless grep $_ eq $call, @$ref;
975 $seeme{$base} = $ref;
981 my $base = basecall($call);
982 my $ref = $seeme{$base};
983 return unless $ref && @$ref;
985 @$ref = grep {$_ ne $call} @$ref;
987 $seeme{$base} = $ref;
989 delete $seeme{basecall($call)};