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 unless ($self->{hostname}) {
176 $self->{hostname} = $self->{conn}->peerhost || 'unknown';
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('err', "$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
205 # $self->{inrbnfilter} = Filter::read_in('rbn', $call, 1)
206 # || Filter::read_in('rbn', 'node_default', 1);
208 Filter::load_dxchan($self, 'rbn', 1);
210 # clean up qra locators
211 my $qra = $user->qra;
212 $qra = undef if ($qra && !DXBearing::is_qra($qra));
214 my $lat = $user->lat;
215 my $long = $user->long;
216 $user->qra(DXBearing::lltoqra($lat, $long)) if (defined $lat && defined $long);
219 # if we have been running and stopped for a while
220 # if the cache is warm enough don't operate the inrush preventor
221 $self->{inrushpreventor} = exists $runtime{$call} && $runtime{$call} > $startup_delay || $noinrush ? 0 : $main::systime + $startup_delay;
222 dbg("RBN: noinrush: $noinrush, setting inrushpreventor on $self->{call} to $self->{inrushpreventor}");
225 my @queue; # the queue of spots ready to send
232 my $dbgrbn = isdbg('rbn');
234 # remove leading and trailing spaces
241 my $now = $main::systime;
244 dbg "RBN:RAW,$line" if isdbg('rbnraw');
245 return unless $line=~/^DX\s+de/;
247 my (undef, undef, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t, $tx) = split /[:\s]+/, $line;
249 # fix up "direct" (from a "skimmer server") connections
250 # basically the $mode is missing so everything is shifted down one
251 # so "cheat" and modify the line and do it again
252 if ($mode =~ /^\d+$/) {
253 $line =~ s/ $mode\s+dB/CW $mode dB/i;
254 (undef, undef, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t, $tx) = split /[:\s]+/, $line;
255 dbg "RBN: inserted CW for missing mode" if $dbgrbn;
258 # fix up FT8 spots from 7001
259 $t = $u, $u = '' if !$t && is_ztime($u);
260 $t = $sort, $sort = '' if !$t && is_ztime($sort);
261 my $qra = $spd, $spd = '' if is_qra($spd);
264 # is this anything like a callsign?
265 unless (is_callsign($call)) {
266 dbg("RBN: ERROR $call from $origin on $qrg is invalid, dumped");
271 if ($DXProt::baddx->in($call)) {
272 dbg("RBN: Bad DX spot '$call', ignored");
273 dbg($line) if isdbg('nologchan');
278 # remove all extraneous crap from the origin - just leave the base callsign
279 my $norigin = basecall($origin);
281 dbg("RBN: ERROR '$origin' is an invalid callsign, dumped");
286 # is this callsign in badspotter list?
287 if ($DXProt::badspotter->in($origin) || $DXProt::badnode->in($origin)) {
288 dbg("RBN: ERROR $origin is a bad spotter/node, dumped");
293 unless ($qrg =~ /^\d+\.\d{1,3}$/) {
294 dbg("RBN: ERROR qrg $qrg from $origin invalid, dumped");
301 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');
305 ++$self->{norawhour};
311 # fix up times for things like 'NXDXF B' etc
312 if ($tx && is_ztime($t)) {
321 if ($sort && $sort eq 'NCDXF') {
325 if ($sort && $sort eq 'BEACON') {
328 if ($mode =~ /^PSK/) {
331 if ($mode eq 'RTTY') {
335 # The main de-duping key is [call, $frequency], but we probe a bit around that frequency to find a
336 # range of concurrent frequencies that might be in play.
338 # The key to this is deducing the true callsign by "majority voting" (the greater the number of spotters
339 # the more effective this is) together with some lexical analsys probably in conjuction with DXSpider
340 # 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)
341 # and some heuristical "Kwalitee" rating given distance from the zone centres of spotter, recipient user
342 # and spotted. A map can be generated once per user and spotter as they are essentially mostly static.
343 # The spotted will only get a coarse position unless other info is available. Programs that parse
344 # DX bulletins and the online data online databases could be be used and then cached.
346 # Obviously users have to opt in to receiving RBN spots and other users will simply be passed over and
349 # Clearly this will only work in the 'mojo' branch of DXSpider where it is possible to pass off external
350 # data requests to ephemeral or semi resident forked processes that do any grunt work and the main
351 # process to just the standard "message passing" which has been shown to be able to sustain over 5000
352 # per second (limited by the test program's output and network speed, rather than DXSpider's handling).
355 my $nqrg = nearest(1, $qrg * 10); # normalised to nearest Khz
356 my $sp = "$call|$nqrg"; # hopefully the skimmers will be calibrated at least this well!
358 # deal with the unix time
359 my ($hh,$mm) = $t =~ /(\d\d)(\d\d)Z$/;
360 my $utz = $hh*3600 + $mm*60 + $main::systime_daystart; # possible issue with late spot from previous day
361 $utz -= 86400 if $utz > $now+3600; # too far ahead, drag it back one day
364 # But before we do anything, if this call is in the seeme hash then just send the spot to them
366 if (exists $seeme{$call} && (my $ref = $seeme{$call})) {
367 foreach my $rcall ( @$ref) {
368 my $uchan = DXChannel::get($rcall);
370 if ($uchan->is_user) {
371 if (isdbg('seeme')) {
373 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});
375 my @s = Spot::prepare($qrg, $call, $utz, sprintf("%-3s %2ddB **SEEME**", $mode, $s), $origin.'-#');
376 my $buf = $uchan->format_dx_spot(@s);
377 dbg("seeme: result '$buf'") if isdbg('seeme');
378 $uchan->local_send('S', $buf);
380 LogDbg('err',"RBN Someone is playing silly persons $rcall is not a user and cannot do 'seeme', ignored and reset");
388 my $cand = $spots->{$sp};
391 for ($i = $nqrg; !$cand && $i <= $nqrg+$search; $i += 1) {
393 $cand = $spots->{$new}, last if exists $spots->{$new};
396 my $diff = $i - $nqrg;
397 dbg(qq{RBN: QRG Diff using $new (+$diff) for $sp for qrg $qrg}) if (isdbg('rbnqrg') || ($dbgrbn && isdbg('rbn')));
403 for ($i = $nqrg; !$cand && $i >= $nqrg-$search; $i -= 1) {
405 $cand = $spots->{$new}, last if exists $spots->{$new};
408 my $diff = $nqrg - $i;
409 dbg(qq{RBN: QRG Diff using $new (-$diff) for $sp for qrg $qrg}) if (isdbg('rbnqrg') || ($dbgrbn && isdbg('rbn')));
414 # if we have one and there is only one slot and that slot's time isn't expired for respot then return
416 if ($cand && ref $cand) {
417 if (@$cand <= CData) {
418 if ($self->{respottime} > 0 && $now - $cand->[CTime] < $self->{respottime}) {
419 dbg("RBN: key: '$sp' call: $call qrg: $qrg DUPE \@ ". atime(int $cand->[CTime])) if $dbgrbn && isdbg('rbn');
423 dbg("RBN: key: '$sp' RESPOTTING call: $call qrg: $qrg last seen \@ ". atime(int $cand->[CTime])) if $dbgrbn && isdbg('rbn');
424 $cand->[CTime] = $now;
428 # otherwise we have a spot being built up at the moment
430 dbg("RBN: key '$sp' = '$cand' not ref");
433 # new spot / frequency
434 $spots->{$sp} = $cand = [$now, 0];
435 dbg("RBN: key: '$sp' call: $call qrg: $qrg NEW" . ($respot ? ' RESPOT' : '')) if $dbgrbn && isdbg('rbn');
438 # add me to the display queue unless we are waiting for initial in rush to finish
439 return unless $noinrush || $self->{inrushpreventor} < $main::systime;
441 # build up a new record and store it in the buildup
442 # create record and add into the buildup
443 my $r = [$origin, nearest(.1, $qrg), $call, $mode, $s, $t, $utz, $respot, $u];
444 my @s = Spot::prepare($r->[RQrg], $r->[RCall], $r->[RUtz], '', $r->[ROrigin]);
446 dbg("RBN: ERROR invalid prefix/callsign $call from $origin-# on $qrg, dumped");
450 if ($self->{inrbnfilter}) {
451 my ($want, undef) = $self->{inrbnfilter}->it($s);
454 $r->[RSpotData] = \@s;
456 ++$self->{queue}->{$sp};# unless @$cand>= CData; # queue the KEY (not the record)
458 dbg("RBN: key: '$sp' ADD RECORD call: $call qrg: $qrg origin: $origin respot: $respot") if $dbgrbn && isdbg('rbn');
463 dbg "RBN:DATA,$line" if $dbgrbn && isdbg('rbn');
467 # we should get the spot record minus the time, so just an array of record (arrays)
476 ++$self->{norbnhour};
478 # $r = [$origin, $qrg, $call, $mode, $s, $utz, $respot];
480 my $mode = $cand->[CData]->[RMode]; # as all the modes will be the same;
482 my @dxchan = DXChannel::get_all();
484 foreach my $dxchan (@dxchan) {
485 next unless $dxchan->is_user;
486 my $user = $dxchan->{user};
487 next unless $user && $user->wantrbn;
489 # does this user want this sort of spot at all?
491 ++$want if $user->wantbeacon && $mode =~ /^BCN|DXF/;
492 ++$want if $user->wantcw && $mode =~ /^CW/;
493 ++$want if $user->wantrtty && $mode =~ /^RTT/;
494 ++$want if $user->wantpsk && $mode =~ /^PSK|FSK|MSK/;
495 ++$want if $user->wantft && $mode =~ /^FT/;
497 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",
504 )) if isdbg('rbnll');
506 # send one spot to one user out of the ones that we have
507 $self->dx_spot($dxchan, $quality, $cand) if $want;
517 my $call = $dxchan->{call};
518 my $strength = 100; # because it could if we talk about FTx
524 ++$self->{nousers}->{$call};
525 ++$self->{nousers10}->{$call};
526 ++$self->{nousershour}->{$call};
529 my $rf = $dxchan->{rbnfilter} || $dxchan->{spotsfilter};
532 foreach my $r (@$cand) {
533 # $r = [$origin, $qrg, $call, $mode, $s, $t, $utz, $respot, $qra];
534 # Spot::prepare($qrg, $call, $utz, $comment, $origin);
535 next unless $r && ref $r;
537 $qra = $r->[RQra] if !$qra && $r->[RQra] && is_qra($r->[RQra]);
539 $comment = sprintf "%-3s %2ddB $quality", $r->[RMode], $r->[RStrength];
540 my $s = $r->[RSpotData]; # the prepared spot
541 $s->[SComment] = $comment; # apply new generated comment
543 ++$zone{$s->[SZone]}; # save the spotter's zone
545 # save the lowest strength one
546 if ($r->[RStrength] < $strength) {
547 $strength = $r->[RStrength];
549 dbg("RBN: STRENGTH spot: $s->[SCall] qrg: $s->[SQrg] origin: $s->[SOrigin] dB: $r->[RStrength] < $strength") if isdbg 'rbnll';
553 my ($want, undef) = $rf->it($s);
554 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';
561 $saver = $filtered; # if nothing passed the filter's lips then $saver == $filtered == undef !
566 # create a zone list of spotters
567 delete $zone{$saver->[SZone]}; # remove this spotter's zone (leaving all the other zones)
568 my $z = join ',', sort {$a <=> $b} keys %zone;
570 # alter spot data accordingly
571 $saver->[SComment] .= " Z:$z" if $z;
573 send_final($dxchan, $saver);
577 ++$self->{nospothour};
580 my $user = DXUser::get_current($saver->[SCall]) || DXUser->new($saver->[SCall]);
581 unless ($user->qra && is_qra($user->qra)) {
583 dbg("RBN: update qra on $saver->[SCall] to $qra");
585 # update lastseen if nothing else
595 my $call = $dxchan->{call};
598 dbg("RBN: SENDING to $call spot: $saver->[SCall] qrg: $saver->[SQrg] origin: $saver->[SOrigin] $saver->[SComment]") if isdbg 'rbnll';
599 if ($dxchan->{ve7cc}) {
600 my $call = $saver->[SOrigin];
601 $saver->[SOrigin] .= '-#';
602 $buf = VE7CC::dx_spot($dxchan, @$saver);
603 $saver->[SOrigin] = $call;
605 my $call = $saver->[SOrigin];
606 $saver->[SOrigin] = substr($call, 0, 6);
607 $saver->[SOrigin] .= '-#';
608 $buf = $dxchan->format_dx_spot(@$saver);
609 $saver->[SOrigin] = $call;
611 $dxchan->local_send('R', $buf);
617 my $rbnskim = isdbg('rbnskim');
619 foreach my $dxchan (DXChannel::get_all()) {
620 next unless $dxchan->is_rbn;
622 # At this point we run the queue to see if anything can be sent onwards to the punter
623 my $now = $main::systime;
624 my $ta = [gettimeofday];
627 # now run the waiting queue which just contains KEYS ($call|$qrg)
628 foreach my $sp (keys %{$dxchan->{queue}}) {
629 my $cand = $spots->{$sp};
632 unless ($cand && $cand->[CTime]) {
633 dbg "RBN Cand $sp " . ($cand ? 'def' : 'undef') . " [CTime] " . ($cand->[CTime] ? 'def' : 'undef') . " dwell $dwelltime";
634 delete $spots->{$sp};
635 delete $dxchan->{queue}->{$sp}; # remove
639 my $ctime = $cand->[CTime];
640 my $quality = @$cand - CData;
641 my $dwellsecs = $now - $ctime;
642 if ($quality >= $maxqual || $dwellsecs >= $dwelltime || $dwellsecs >= $limbotime) {
643 # we have a candidate, create qualitee value(s);
644 unless (@$cand > CData) {
645 dbg "RBN: QUEUE key '$sp' MISSING RECORDS, IGNORED" . dd($cand) if isdbg 'rbnqueue';
646 delete $spots->{$sp}; # don't remember it either - this means that a spot HAS to come in with sufficient spotters to be processed.
647 delete $dxchan->{queue}->{$sp};
650 dbg "RBN: QUEUE PROCESSING key: '$sp' $now >= $cand->[CTime]" if isdbg 'rbnqueue';
651 my $spotters = $quality;
653 # 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
654 my $r = $cand->[CData];
655 if ($dwellsecs > $limbotime && $quality < $minqual) {
656 if ( $rbnskim && isdbg('rbnskim')) {
659 my $lastin = difft($ctime, $now, 2);
660 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}";
664 delete $spots->{$sp}; # don't remember it either - this means that a spot HAS to come in with sufficient spotters to be processed.
665 delete $dxchan->{queue}->{$sp};
669 # we have a possible removal from Limbo, check for more than one skimmer and reset the quality if required
670 # DOES THIS TEST CAUSE RACES?
671 if (!$r->[Respot] && $quality >= $minqual && $dwellsecs > $dwelltime+1) {
673 # because we don't need to check for repeats by the same skimmer in the normal case, we do here
676 foreach my $wr (@$cand) {
678 push @origin, $wr->[ROrigin];
679 if (exists $seen{$wr->[ROrigin]}) {
682 $seen{$wr->[ROrigin]} = $wr;
684 # reset the quality to ignore dupes
686 $quality = keys %seen;
687 if ($quality >= $minqual) {
688 if ( $rbnskim && isdbg('rbnskim')) {
689 my $lastin = difft($ctime, $now, 2);
690 my $sk = join ' ', keys %seen;
691 my $or = join ' ', @origin;
692 my $s = "RBN:SKIM promoted from Limbo - key: '$sp' (lastin: $lastin Q now: $quality was $oq skimmers now: $sk";
693 $s .= " was $or" if $or ne $sk;
697 } elsif ($oq != $quality) {
698 if ( $rbnskim && isdbg('rbnskim')) {
699 my $lastin = difft($ctime, $now, 2);
700 my $sk = join ' ', keys %seen;
701 my $or = join ' ', @origin;
702 my $s = "RBN:SKIM quality reset key: '$sp' (lastin: $lastin Q now: $quality was $oq skimmers now: $sk was: $or)";
706 my @ncand = (@$cand[CTime, CQual], values %seen);
707 $spots->{$sp} = \@ncand;
711 # we now kick this spot into Limbo
712 if ($quality < $minqual) {
716 $quality = 9 if $quality > 9;
717 $cand->[CQual] = $quality if $quality > $cand->[CQual];
719 # this scores each candidate according to its skimmer's QRG score (i.e. how often it agrees with its peers)
720 # what happens is hash of all QRGs in candidates are incremented by that skimmer's reputation for "accuracy"
721 # or, more exactly, past agreement with the consensus. This score can be from -5 -> +5.
727 foreach $r (@$cand) {
729 if (exists $seen{$r->[ROrigin]}) {
733 $seen{$r->[ROrigin]} = 1;
734 $band ||= int $r->[RQrg] / 1000;
735 $sk = "SKIM|$r->[ROrigin]|$band"; # thus only once per set of candidates
736 $skimmer = $spots->{$sk};
738 $skimmer = $spots->{$sk} = [1, 0, 0, $now, []]; # this first time, this new skimmer gets the benefit of the doubt on frequency.
739 dbg("RBN:SKIM new slot $sk " . $json->encode($skimmer)) if $rbnskim && isdbg('rbnskim');
741 $qrg{$r->[RQrg]} += ($skimmer->[DScore] || 1);
744 # determine the most likely qrg and then set it - NOTE (-)ve votes, generated by the skimmer scoring system above, are ignored
749 while (my ($k, $votes) = each %qrg) {
757 # Ignore possible spots with 0 QRG score - as determined by the skimmer scoring system above - as they are likely to be wrong
759 if ( $rbnskim && isdbg('rbnskim')) {
761 while (my ($k, $v) = (each %qrg)) {
766 foreach $r (@$cand) {
767 next unless $r && ref $r;
768 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";
772 delete $spots->{$sp}; # get rid
773 delete $dxchan->{queue}->{$sp};
777 # detemine and spit out the deviants. Then adjust the scores according to whether it is a deviant or good
778 # NOTE: deviant nodes can become good (or less bad), and good nodes bad (or less good) on each spot that
779 # they generate. This is based solely on each skimmer's agreement (or not) with the "consensus" score generated
780 # above ($qrg). The resultant score + good + bad is stored per band and will be used the next time a spot
781 # appears on this band from each skimmer.
782 foreach $r (@$cand) {
783 next unless $r && ref $r;
784 my $diff = $c > 1 ? nearest(.1, $r->[RQrg] - $qrg) : 0;
785 $sk = "SKIM|$r->[ROrigin]|$band";
786 $skimmer = $spots->{$sk};
788 ++$skimmer->[DBad] if $skimmer->[DBad] < $maxdeviants;
789 --$skimmer->[DGood] if $skimmer->[DGood] > 0;
790 push @deviant, sprintf("$r->[ROrigin]:%+.1f", $diff);
791 push @{$skimmer->[DEviants]}, $diff;
792 shift @{$skimmer->[DEviants]} while @{$skimmer->[DEviants]} > $maxdeviants;
794 ++$skimmer->[DGood] if $skimmer->[DGood] < $maxdeviants;
795 --$skimmer->[DBad] if $skimmer->[DBad] > 0;
796 shift @{$skimmer->[DEviants]};
798 $skimmer->[DScore] = $skimmer->[DGood] - $skimmer->[DBad];
799 if ($rbnskim && isdbg('rbnskim')) {
800 my $lastin = difft($skimmer->[DLastin], $now, 2);
801 my $difflist = join(', ', @{$skimmer->[DEviants]});
802 $difflist = " band qrg diffs: $difflist" if $difflist;
803 dbg("RBN:SKIM key $sp slot $sk $r->[RQrg] - $qrg = $diff Skimmer score: $skimmer->[DGood] - $skimmer->[DBad] = $skimmer->[DScore] lastseen:$lastin ago$difflist");
805 $skimmer->[DLastin] = $now;
806 $r->[RSpotData]->[SQrg] = $qrg if $qrg && $c > 1; # set all the QRGs to the agreed value
809 $qrg = (sprintf "%.1f", $qrg)+0;
812 my $squality = "Q:$cand->[CQual]";
813 $squality .= '*' if $c > 1;
814 $squality .= '+' if $r->[Respot];
816 if (isdbg('progress')) {
817 my $rt = difft($ctime, $now, 2);
818 my $s = "RBN: SPOT key: '$sp' = $r->[RCall] on $r->[RQrg] by $r->[ROrigin] \@ $r->[RTime] $squality route: $dxchan->{call} dwell:$rt";
820 $s .= " QRGScore: $mv Deviants: $td/$spotters";
821 $s .= ' (' . join(', ', sort @deviant) . ')' if $td;
825 # finally send it out to any waiting public
826 send_dx_spot($dxchan, $squality, $cand);
828 # clear out the data and make this now just "spotted", but no further action required until respot time
829 dbg "RBN: QUEUE key '$sp' cleared" if isdbg 'rbn';
831 delete $dxchan->{queue}->{$sp};
833 # calculate new sp (which will be 70% likely the same as the old one)
834 # 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.
835 # and we want to store the key that corresponds to majority opinion.
836 my $nqrg = nearest(1, $qrg * 10); # normalised to nearest Khz
837 my $nsp = "$r->[RCall]|$nqrg";
839 dbg("RBN:SKIM CHANGE KEY sp '$sp' -> '$nsp' for storage") if $rbnskim && isdbg('rbnskim');
840 delete $spots->{$sp};
841 $spots->{$nsp} = [$now, $cand->[CQual]];
843 $spots->{$sp} = [$now, $cand->[CQual]];
847 dbg sprintf("RBN: QUEUE key: '$sp' SEND time not yet reached %.1f secs left", $cand->[CTime] + $dwelltime - $now) if isdbg 'rbnqueue';
850 if (isdbg('rbntimer')) {
851 my $diff = _diffus($ta);
852 dbg "RBN: TIMER process queue for call: $dxchan->{call} $items spots $diff uS";
859 foreach my $dxchan (DXChannel::get_all()) {
860 next unless $dxchan->is_rbn;
861 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');
862 if ($dxchan->{noraw} == 0 && $dxchan->{lasttime} > 60) {
863 LogDbg('err', "RBN: no input from $dxchan->{call}, disconnecting");
866 $dxchan->{noraw} = $dxchan->{norbn} = $dxchan->{nospot} = 0; $dxchan->{nousers} = {};
867 $runtime{$dxchan->{call}} += 60;
870 # save the spot cache
871 write_cache() unless $main::systime + $startup_delay < $main::systime;;
878 while (my ($k,$cand) = each %{$spots}) {
879 next if $k eq 'VERSION';
880 next if $k =~ /^O\|/;
881 next if $k =~ /^SKIM\|/;
883 if ($main::systime - $cand->[CTime] > $cachetime) {
891 dbg "RBN:STATS spot cache remain: $count removed: $removed"; # if isdbg('rbn');
892 foreach my $dxchan (DXChannel::get_all()) {
893 next unless $dxchan->is_rbn;
894 my $nq = keys %{$dxchan->{queue}};
895 my $pc = $dxchan->{noraw10} ? sprintf("%.1f%%",$dxchan->{norbn10}*100/$dxchan->{noraw10}) : '0.0%';
896 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}};
897 $dxchan->{noraw10} = $dxchan->{norbn10} = $dxchan->{nospot10} = 0; $dxchan->{nousers10} = {};
903 foreach my $dxchan (DXChannel::get_all()) {
904 next unless $dxchan->is_rbn;
905 my $nq = keys %{$dxchan->{queue}};
906 my $pc = $dxchan->{norawhour} ? sprintf("%.1f%%",$dxchan->{norbnhour}*100/$dxchan->{norawhour}) : '0.0%';
907 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}};
908 $dxchan->{norawhour} = $dxchan->{norbnhour} = $dxchan->{nospothour} = 0; $dxchan->{nousershour} = {};
921 my $ta = [ gettimeofday ];
923 $json->indent(1)->canonical(1) if isdbg 'rbncache';
924 my $s = eval {$json->encode($spots)};
926 my $fh = IO::File->new(">$cachefn") or confess("writing $cachefn $!");
930 dbg("RBN:Write_cache error '$@'");
933 $json->indent(0)->canonical(0);
934 my $diff = _diffms($ta);
935 my $size = sprintf('%.3fKB', (length($s) / 1000));
936 dbg("RBN:WRITE_CACHE size: $size time to write: $diff mS");
942 my $mt = (stat($cachefn))[9];
943 my $t = $main::systime - $mt || 1;
944 my $p = difft($mt, 2);
945 if ($t < $cache_valid) {
946 dbg("RBN:check_cache '$cachefn' spot cache exists, created $p ago and not too old");
947 my $fh = IO::File->new($cachefn);
952 dbg("RBN:check_cache cache read size " . length $s);
955 dbg("RBN:check_cache file read error $!");
959 eval {$spots = $json->decode($s)};
960 if ($spots && ref $spots) {
961 if (exists $spots->{VERSION} && $spots->{VERSION} == $DATA_VERSION) {
962 # now clean out anything that has spot build ups in progress
963 while (my ($k, $cand) = each %$spots) {
964 next if $k eq 'VERSION';
965 next if $k =~ /^O\|/;
966 next if $k =~ /^SKIM\|/;
967 if (@$cand > CData) {
968 $spots->{$k} = [$cand->[CTime], $cand->[CQual]];
971 dbg("RBN:check_cache spot cache restored");
975 dbg("RBN::checkcache error decoding $@");
978 my $d = difft($main::systime-$cache_valid);
979 dbg("RBN::checkcache '$cachefn' created $p ago is too old (> $d), ignored");
982 dbg("RBN:check_cache '$cachefn' spot cache not present");
991 my $base = basecall($call);
992 my $ref = $seeme{$base} || [];
993 push @$ref, $call unless grep $_ eq $call, @$ref;
994 $seeme{$base} = $ref;
1000 my $base = basecall($call);
1001 my $ref = $seeme{$base};
1002 return unless $ref && @$ref;
1004 @$ref = grep {$_ ne $call} @$ref;
1006 $seeme{$base} = $ref;
1008 delete $seeme{basecall($call)};