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 $minspottime = 30*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 minspottime has passed.
83 our $beacontime = 5*60; # same as minspottime, but for beacons (and shorter)
85 our $dwelltime = 10; # the amount of time to wait for duplicates before issuing
86 # a spot to the user (no doubt waiting with bated breath).
88 our $limbotime = 5*60; # if there are fewer than $minqual candidates and $dwelltime
89 # has expired then allow this spot to live a bit longer. It may
90 # simply be that it is not in standard spot coverage. (ask G4PIQ
93 our $filterdef = $Spot::filterdef; # we use the same filter as the Spot system. Can't think why :-).
95 my $spots; # the GLOBAL spot cache
97 my %runtime; # how long each channel has been running
99 our $cachefn = localdata('rbn_cache');
100 our $cache_valid = 4*60; # The cache file is considered valid if it is not more than this old
102 our $maxqrgdiff = 10; # the maximum
103 our $minqual = 2; # the minimum quality we will accept for output
104 our $maxqual = 9; # if there is enough quality, then short circuit any remaining dwelltime.
107 my $noinrush = 0; # override the inrushpreventor if set
108 our $maxdeviants = 5; # the number of deviant QRGs to record for skimmer records
117 $spots = {VERSION=>$DATA_VERSION};
119 if (defined $DB::VERSION) {
128 my $self = DXChannel::alloc(@_);
130 # routing, this must go out here to prevent race condx
137 $self->{nouser} = {};
139 $self->{noraw10} = 0;
140 $self->{nospot10} = 0;
141 $self->{nouser10} = {};
142 $self->{norbn10} = 0;
143 $self->{nospothour} = 0;
144 $self->{nouserhour} = {};
145 $self->{norbnhour} = 0;
146 $self->{norawhour} = 0;
148 $self->{lasttime} = $main::systime;
149 $self->{minspottime} = $minspottime;
150 $self->{beacontime} = $beacontime;
151 $self->{showstats} = 0;
152 $self->{pingint} = 0;
153 $self->{nopings} = 0;
161 my ($self, $line, $sort) = @_;
162 my $user = $self->{user};
163 my $call = $self->{call};
164 my $name = $user->{name};
167 my $host = $self->{conn}->peerhost;
169 $self->{hostname} = $host;
171 $self->{name} = $name ? $name : $call;
172 $self->state('prompt'); # a bit of room for further expansion, passwords etc
173 $self->{lang} = $user->lang || $main::lang || 'en';
174 if ($line =~ /host=/) {
175 my ($h) = $line =~ /host=(\d+\.\d+\.\d+\.\d+)/;
176 $line =~ s/\s*host=\d+\.\d+\.\d+\.\d+// if $h;
178 ($h) = $line =~ /host=([\da..fA..F:]+)/;
179 $line =~ s/\s*host=[\da..fA..F:]+// if $h;
183 $self->{hostname} = $h;
186 $self->{width} = 80 unless $self->{width} && $self->{width} > 80;
187 $self->{consort} = $line; # save the connection type
189 LogDbg('DXCommand', "$call connected from $self->{hostname}");
191 # set some necessary flags on the user if they are connecting
192 $self->{registered} = 1;
193 # sort out privilege reduction
198 $nossid =~ s/-\d+$//;
200 $self->{inrbnfilter} = Filter::read_in('rbn', $call, 1)
201 || Filter::read_in('rbn', 'node_default', 1);
203 # clean up qra locators
204 my $qra = $user->qra;
205 $qra = undef if ($qra && !DXBearing::is_qra($qra));
207 my $lat = $user->lat;
208 my $long = $user->long;
209 $user->qra(DXBearing::lltoqra($lat, $long)) if (defined $lat && defined $long);
212 # if we have been running and stopped for a while
213 # if the cache is warm enough don't operate the inrush preventor
214 $self->{inrushpreventor} = exists $runtime{$call} && $runtime{$call} > $startup_delay || $noinrush ? 0 : $main::systime + $startup_delay;
215 dbg("RBN: noinrush: $noinrush, setting inrushpreventor on $self->{call} to $self->{inrushpreventor}");
218 my @queue; # the queue of spots ready to send
225 my $dbgrbn = isdbg('rbn');
227 # remove leading and trailing spaces
234 my $now = $main::systime;
237 dbg "RBN:RAW,$line" if isdbg('rbnraw');
238 return unless $line=~/^DX\s+de/;
240 my (undef, undef, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t, $tx) = split /[:\s]+/, $line;
242 # fix up FT8 spots from 7001
243 $t = $u, $u = '' if !$t && is_ztime($u);
244 $t = $sort, $sort = '' if !$t && is_ztime($sort);
245 my $qra = $spd, $spd = '' if is_qra($spd);
248 # is this anything like a callsign?
249 unless (is_callsign($call)) {
250 dbg("RBN: ERROR $call from $origin on $qrg is invalid, dumped");
254 # remove all extraneous crap from the origin - just leave the base callsign
255 my $norigin = basecall($origin);
257 dbg("RBN: ERROR '$origin' is an invalid callsign, dumped");
262 # is this callsign in badspotter list?
263 if ($DXProt::badspotter->in($origin) || $DXProt::badnode->in($origin)) {
264 dbg("RBN: ERROR $origin is a bad spotter/node, dumped");
269 unless ($qrg =~ /^\d+\.\d{1,3}$/) {
270 dbg("RBN: ERROR qrg $qrg from $origin invalid, dumped");
277 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');
281 ++$self->{norawhour};
287 # fix up times for things like 'NXDXF B' etc
288 if ($tx && is_ztime($t)) {
297 if ($sort && $sort eq 'NCDXF') {
301 if ($sort && $sort eq 'BEACON') {
304 if ($mode =~ /^PSK/) {
307 if ($mode eq 'RTTY') {
311 # The main de-duping key is [call, $frequency], but we probe a bit around that frequency to find a
312 # range of concurrent frequencies that might be in play.
314 # The key to this is deducing the true callsign by "majority voting" (the greater the number of spotters
315 # the more effective this is) together with some lexical analsys probably in conjuction with DXSpider
316 # 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)
317 # and some heuristical "Kwalitee" rating given distance from the zone centres of spotter, recipient user
318 # and spotted. A map can be generated once per user and spotter as they are essentially mostly static.
319 # The spotted will only get a coarse position unless other info is available. Programs that parse
320 # DX bulletins and the online data online databases could be be used and then cached.
322 # Obviously users have to opt in to receiving RBN spots and other users will simply be passed over and
325 # Clearly this will only work in the 'mojo' branch of DXSpider where it is possible to pass off external
326 # data requests to ephemeral or semi resident forked processes that do any grunt work and the main
327 # process to just the standard "message passing" which has been shown to be able to sustain over 5000
328 # per second (limited by the test program's output and network speed, rather than DXSpider's handling).
331 my $nqrg = nearest(1, $qrg * 10); # normalised to nearest Khz
332 my $sp = "$call|$nqrg"; # hopefully the skimmers will be calibrated at least this well!
335 my $cand = $spots->{$sp};
338 for ($i = $nqrg; !$cand && $i <= $nqrg+$search; $i += 1) {
340 $cand = $spots->{$new}, last if exists $spots->{$new};
343 my $diff = $i - $nqrg;
344 dbg(qq{RBN: QRG Diff using $new (+$diff) for $sp for qrg $qrg}) if (isdbg('rbnqrg') || ($dbgrbn && isdbg('rbn')));
350 for ($i = $nqrg; !$cand && $i >= $nqrg-$search; $i -= 1) {
352 $cand = $spots->{$new}, last if exists $spots->{$new};
355 my $diff = $nqrg - $i;
356 dbg(qq{RBN: QRG Diff using $new (-$diff) for $sp for qrg $qrg}) if (isdbg('rbnqrg') || ($dbgrbn && isdbg('rbn')));
361 # if we have one and there is only one slot and that slot's time isn't expired for respot then return
363 if ($cand && ref $cand) {
364 if (@$cand <= CData) {
365 if ($self->{minspottime} > 0 && $now - $cand->[CTime] < $self->{minspottime}) {
366 dbg("RBN: key: '$sp' call: $call qrg: $qrg DUPE \@ ". atime(int $cand->[CTime])) if $dbgrbn && isdbg('rbn');
370 dbg("RBN: key: '$sp' RESPOTTING call: $call qrg: $qrg last seen \@ ". atime(int $cand->[CTime])) if $dbgrbn && isdbg('rbn');
371 $cand->[CTime] = $now;
375 # otherwise we have a spot being built up at the moment
377 dbg("RBN: key '$sp' = '$cand' not ref");
380 # new spot / frequency
381 $spots->{$sp} = $cand = [$now, 0];
382 dbg("RBN: key: '$sp' call: $call qrg: $qrg NEW" . ($respot ? ' RESPOT' : '')) if $dbgrbn && isdbg('rbn');
385 # add me to the display queue unless we are waiting for initial in rush to finish
386 return unless $noinrush || $self->{inrushpreventor} < $main::systime;
388 # build up a new record and store it in the buildup
389 # deal with the unix time
390 my ($hh,$mm) = $t =~ /(\d\d)(\d\d)Z$/;
391 my $utz = $hh*3600 + $mm*60 + $main::systime_daystart; # possible issue with late spot from previous day
392 $utz -= 86400 if $utz > $now+3600; # too far ahead, drag it back one day
394 # create record and add into the buildup
395 my $r = [$origin, nearest(.1, $qrg), $call, $mode, $s, $t, $utz, $respot, $u];
396 my @s = Spot::prepare($r->[RQrg], $r->[RCall], $r->[RUtz], '', $r->[ROrigin]);
398 dbg("RBN: ERROR invalid prefix/callsign $call from $origin-# on $qrg, dumped");
402 if ($self->{inrbnfilter}) {
403 my ($want, undef) = $self->{inrbnfilter}->it($s);
406 $r->[RSpotData] = \@s;
408 ++$self->{queue}->{$sp};# unless @$cand>= CData; # queue the KEY (not the record)
410 dbg("RBN: key: '$sp' ADD RECORD call: $call qrg: $qrg origin: $origin respot: $respot") if $dbgrbn && isdbg('rbn');
415 dbg "RBN:DATA,$line" if $dbgrbn && isdbg('rbn');
419 # we should get the spot record minus the time, so just an array of record (arrays)
428 ++$self->{norbnhour};
430 # $r = [$origin, $qrg, $call, $mode, $s, $utz, $respot];
432 my $mode = $cand->[CData]->[RMode]; # as all the modes will be the same;
434 my @dxchan = DXChannel::get_all();
436 foreach my $dxchan (@dxchan) {
437 next unless $dxchan->is_user;
438 my $user = $dxchan->{user};
439 next unless $user && $user->wantrbn;
441 # does this user want this sort of spot at all?
443 ++$want if $user->wantbeacon && $mode =~ /^BCN|DXF/;
444 ++$want if $user->wantcw && $mode =~ /^CW/;
445 ++$want if $user->wantrtty && $mode =~ /^RTT/;
446 ++$want if $user->wantpsk && $mode =~ /^PSK|FSK|MSK/;
447 ++$want if $user->wantft && $mode =~ /^FT/;
449 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",
456 )) if isdbg('rbnll');
458 # send one spot to one user out of the ones that we have
459 $self->dx_spot($dxchan, $quality, $cand) if $want;
469 my $call = $dxchan->{call};
470 my $seeme = $dxchan->user->rbnseeme();
471 my $strength = 100; # because it could if we talk about FTx
477 ++$self->{nousers}->{$call};
478 ++$self->{nousers10}->{$call};
479 ++$self->{nousershour}->{$call};
482 my $rf = $dxchan->{rbnfilter} || $dxchan->{spotsfilter};
485 foreach my $r (@$cand) {
486 # $r = [$origin, $qrg, $call, $mode, $s, $t, $utz, $respot, $qra];
487 # Spot::prepare($qrg, $call, $utz, $comment, $origin);
488 next unless $r && ref $r;
490 $qra = $r->[RQra] if !$qra && $r->[RQra] && is_qra($r->[RQra]);
492 $comment = sprintf "%-3s %2ddB $quality", $r->[RMode], $r->[RStrength];
493 my $s = $r->[RSpotData]; # the prepared spot
494 $s->[SComment] = $comment; # apply new generated comment
496 ++$zone{$s->[SZone]}; # save the spotter's zone
498 # if the 'see me' flag is set, then show all the spots without further adornment (see set/rbnseeme for more info)
500 send_final($dxchan, $s);
504 # save the lowest strength one
505 if ($r->[RStrength] < $strength) {
506 $strength = $r->[RStrength];
508 dbg("RBN: STRENGTH spot: $s->[SCall] qrg: $s->[SQrg] origin: $s->[SOrigin] dB: $r->[RStrength] < $strength") if isdbg 'rbnll';
512 my ($want, undef) = $rf->it($s);
513 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';
520 $saver = $filtered; # if nothing passed the filter's lips then $saver == $filtered == undef !
525 # create a zone list of spotters
526 delete $zone{$saver->[SZone]}; # remove this spotter's zone (leaving all the other zones)
527 my $z = join ',', sort {$a <=> $b} keys %zone;
529 # alter spot data accordingly
530 $saver->[SComment] .= " Z:$z" if $z;
532 send_final($dxchan, $saver);
536 ++$self->{nospothour};
539 my $user = DXUser::get_current($saver->[SCall]) || DXUser->new($saver->[SCall]);
540 unless ($user->qra && is_qra($user->qra)) {
542 dbg("RBN: update qra on $saver->[SCall] to $qra");
544 # update lastseen if nothing else
554 my $call = $dxchan->{call};
557 dbg("RBN: SENDING to $call spot: $saver->[SCall] qrg: $saver->[SQrg] origin: $saver->[SOrigin] $saver->[SComment]") if isdbg 'rbnll';
558 if ($dxchan->{ve7cc}) {
559 my $call = $saver->[SOrigin];
560 $saver->[SOrigin] .= '-#';
561 $buf = VE7CC::dx_spot($dxchan, @$saver);
562 $saver->[SOrigin] = $call;
564 my $call = $saver->[SOrigin];
565 $saver->[SOrigin] = substr($call, 0, 6);
566 $saver->[SOrigin] .= '-#';
567 $buf = $dxchan->format_dx_spot(@$saver);
568 $saver->[SOrigin] = $call;
570 $dxchan->local_send('N', $buf);
576 my $rbnskim = isdbg('rbnskim');
578 foreach my $dxchan (DXChannel::get_all()) {
579 next unless $dxchan->is_rbn;
581 # At this point we run the queue to see if anything can be sent onwards to the punter
582 my $now = $main::systime;
583 my $ta = [gettimeofday];
586 # now run the waiting queue which just contains KEYS ($call|$qrg)
587 foreach my $sp (keys %{$dxchan->{queue}}) {
588 my $cand = $spots->{$sp};
591 unless ($cand && $cand->[CTime]) {
592 dbg "RBN Cand $sp " . ($cand ? 'def' : 'undef') . " [CTime] " . ($cand->[CTime] ? 'def' : 'undef') . " dwell $dwelltime";
593 delete $spots->{$sp};
594 delete $dxchan->{queue}->{$sp}; # remove
598 my $ctime = $cand->[CTime];
599 my $quality = @$cand - CData;
600 my $dwellsecs = $now - $ctime;
601 if ($quality >= $maxqual || $dwellsecs >= $dwelltime || $dwellsecs >= $limbotime) {
602 # we have a candidate, create qualitee value(s);
603 unless (@$cand > CData) {
604 dbg "RBN: QUEUE key '$sp' MISSING RECORDS, IGNORED" . dd($cand) if isdbg 'rbnqueue';
605 delete $spots->{$sp}; # don't remember it either - this means that a spot HAS to come in with sufficient spotters to be processed.
606 delete $dxchan->{queue}->{$sp};
609 dbg "RBN: QUEUE PROCESSING key: '$sp' $now >= $cand->[CTime]" if isdbg 'rbnqueue';
610 my $spotters = $quality;
612 # 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
613 my $r = $cand->[CData];
614 if ($dwellsecs > $limbotime && $quality < $minqual) {
615 if ( $rbnskim && isdbg('rbnskim')) {
618 my $lastin = difft($ctime, $now, 2);
619 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}";
623 delete $spots->{$sp}; # don't remember it either - this means that a spot HAS to come in with sufficient spotters to be processed.
624 delete $dxchan->{queue}->{$sp};
628 # we have a possible removal from Limbo, check for more than one skimmer and reset the quality if required
629 # DOES THIS TEST CAUSE RACES?
630 if (!$r->[Respot] && $quality >= $minqual && $dwellsecs > $dwelltime+1) {
632 # because we don't need to check for repeats by the same skimmer in the normal case, we do here
635 foreach my $wr (@$cand) {
637 push @origin, $wr->[ROrigin];
638 if (exists $seen{$wr->[ROrigin]}) {
641 $seen{$wr->[ROrigin]} = $wr;
643 # reset the quality to ignore dupes
645 $quality = keys %seen;
646 if ($quality >= $minqual) {
647 if ( $rbnskim && isdbg('rbnskim')) {
648 my $lastin = difft($ctime, $now, 2);
649 my $sk = join ' ', keys %seen;
650 my $or = join ' ', @origin;
651 my $s = "RBN:SKIM promoted from Limbo - key: '$sp' (lastin: $lastin Q now: $quality was $oq skimmers now: $sk";
652 $s .= " was $or" if $or ne $sk;
656 } elsif ($oq != $quality) {
657 if ( $rbnskim && isdbg('rbnskim')) {
658 my $lastin = difft($ctime, $now, 2);
659 my $sk = join ' ', keys %seen;
660 my $or = join ' ', @origin;
661 my $s = "RBN:SKIM quality reset key: '$sp' (lastin: $lastin Q now: $quality was $oq skimmers now: $sk was: $or)";
665 my @ncand = (@$cand[CTime, CQual], values %seen);
666 $spots->{$sp} = \@ncand;
670 # we now kick this spot into Limbo
671 if ($quality < $minqual) {
675 $quality = 9 if $quality > 9;
676 $cand->[CQual] = $quality if $quality > $cand->[CQual];
678 # this scores each candidate according to its skimmer's QRG score (i.e. how often it agrees with its peers)
679 # what happens is hash of all QRGs in candidates are incremented by that skimmer's reputation for "accuracy"
680 # or, more exactly, past agreement with the consensus. This score can be from -5 -> +5.
686 foreach $r (@$cand) {
688 if (exists $seen{$r->[ROrigin]}) {
692 $seen{$r->[ROrigin]} = 1;
693 $band ||= int $r->[RQrg] / 1000;
694 $sk = "SKIM|$r->[ROrigin]|$band"; # thus only once per set of candidates
695 $skimmer = $spots->{$sk};
697 $skimmer = $spots->{$sk} = [1, 0, 0, $now, []]; # this first time, this new skimmer gets the benefit of the doubt on frequency.
698 dbg("RBN:SKIM new slot $sk " . $json->encode($skimmer)) if $rbnskim && isdbg('rbnskim');
700 $qrg{$r->[RQrg]} += ($skimmer->[DScore] || 1);
703 # determine the most likely qrg and then set it - NOTE (-)ve votes, generated by the skimmer scoring system above, are ignored
708 while (my ($k, $votes) = each %qrg) {
716 # Ignore possible spots with 0 QRG score - as determined by the skimmer scoring system above - as they are likely to be wrong
718 if ( $rbnskim && isdbg('rbnskim')) {
720 while (my ($k, $v) = (each %qrg)) {
725 foreach $r (@$cand) {
726 next unless $r && ref $r;
727 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";
731 delete $spots->{$sp}; # get rid
732 delete $dxchan->{queue}->{$sp};
736 # detemine and spit out the deviants. Then adjust the scores according to whether it is a deviant or good
737 # NOTE: deviant nodes can become good (or less bad), and good nodes bad (or less good) on each spot that
738 # they generate. This is based solely on each skimmer's agreement (or not) with the "consensus" score generated
739 # above ($qrg). The resultant score + good + bad is stored per band and will be used the next time a spot
740 # appears on this band from each skimmer.
741 foreach $r (@$cand) {
742 next unless $r && ref $r;
743 my $diff = $c > 1 ? nearest(.1, $r->[RQrg] - $qrg) : 0;
744 $sk = "SKIM|$r->[ROrigin]|$band";
745 $skimmer = $spots->{$sk};
747 ++$skimmer->[DBad] if $skimmer->[DBad] < $maxdeviants;
748 --$skimmer->[DGood] if $skimmer->[DGood] > 0;
749 push @deviant, sprintf("$r->[ROrigin]:%+.1f", $diff);
750 push @{$skimmer->[DEviants]}, $diff;
751 shift @{$skimmer->[DEviants]} while @{$skimmer->[DEviants]} > $maxdeviants;
753 ++$skimmer->[DGood] if $skimmer->[DGood] < $maxdeviants;
754 --$skimmer->[DBad] if $skimmer->[DBad] > 0;
755 shift @{$skimmer->[DEviants]};
757 $skimmer->[DScore] = $skimmer->[DGood] - $skimmer->[DBad];
758 if ($rbnskim && isdbg('rbnskim')) {
759 my $lastin = difft($skimmer->[DLastin], $now, 2);
760 my $difflist = join(', ', @{$skimmer->[DEviants]});
761 $difflist = " band qrg diffs: $difflist" if $difflist;
762 dbg("RBN:SKIM key $sp slot $sk $r->[RQrg] - $qrg = $diff Skimmer score: $skimmer->[DGood] - $skimmer->[DBad] = $skimmer->[DScore] lastseen:$lastin ago$difflist");
764 $skimmer->[DLastin] = $now;
765 $r->[RSpotData]->[SQrg] = $qrg if $qrg && $c > 1; # set all the QRGs to the agreed value
768 $qrg = (sprintf "%.1f", $qrg)+0;
771 my $squality = "Q:$cand->[CQual]";
772 $squality .= '*' if $c > 1;
773 $squality .= '+' if $r->[Respot];
775 if (isdbg('progress')) {
776 my $rt = difft($ctime, $now, 2);
777 my $s = "RBN: SPOT key: '$sp' = $r->[RCall] on $r->[RQrg] by $r->[ROrigin] \@ $r->[RTime] $squality route: $dxchan->{call} dwell:$rt";
779 $s .= " QRGScore: $mv Deviants: $td/$spotters";
780 $s .= ' (' . join(', ', sort @deviant) . ')' if $td;
784 # finally send it out to any waiting public
785 send_dx_spot($dxchan, $squality, $cand);
787 # clear out the data and make this now just "spotted", but no further action required until respot time
788 dbg "RBN: QUEUE key '$sp' cleared" if isdbg 'rbn';
790 delete $dxchan->{queue}->{$sp};
792 # calculate new sp (which will be 70% likely the same as the old one)
793 # 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.
794 # and we want to store the key that corresponds to majority opinion.
795 my $nqrg = nearest(1, $qrg * 10); # normalised to nearest Khz
796 my $nsp = "$r->[RCall]|$nqrg";
798 dbg("RBN:SKIM CHANGE KEY sp '$sp' -> '$nsp' for storage") if $rbnskim && isdbg('rbnskim');
799 delete $spots->{$sp};
800 $spots->{$nsp} = [$now, $cand->[CQual]];
802 $spots->{$sp} = [$now, $cand->[CQual]];
806 dbg sprintf("RBN: QUEUE key: '$sp' SEND time not yet reached %.1f secs left", $cand->[CTime] + $dwelltime - $now) if isdbg 'rbnqueue';
809 if (isdbg('rbntimer')) {
810 my $diff = _diffus($ta);
811 dbg "RBN: TIMER process queue for call: $dxchan->{call} $items spots $diff uS";
818 foreach my $dxchan (DXChannel::get_all()) {
819 next unless $dxchan->is_rbn;
820 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');
821 if ($dxchan->{noraw} == 0 && $dxchan->{lasttime} > 60) {
822 LogDbg('RBN', "RBN: no input from $dxchan->{call}, disconnecting");
825 $dxchan->{noraw} = $dxchan->{norbn} = $dxchan->{nospot} = 0; $dxchan->{nousers} = {};
826 $runtime{$dxchan->{call}} += 60;
829 # save the spot cache
830 write_cache() unless $main::systime + $startup_delay < $main::systime;;
837 while (my ($k,$cand) = each %{$spots}) {
838 next if $k eq 'VERSION';
839 next if $k =~ /^O\|/;
840 next if $k =~ /^SKIM\|/;
842 if ($main::systime - $cand->[CTime] > $minspottime*2) {
850 dbg "RBN:STATS spot cache remain: $count removed: $removed"; # if isdbg('rbn');
851 foreach my $dxchan (DXChannel::get_all()) {
852 next unless $dxchan->is_rbn;
853 my $nq = keys %{$dxchan->{queue}};
854 my $pc = $dxchan->{noraw10} ? sprintf("%.1f%%",$dxchan->{norbn10}*100/$dxchan->{noraw10}) : '0.0%';
855 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}};
856 $dxchan->{noraw10} = $dxchan->{norbn10} = $dxchan->{nospot10} = 0; $dxchan->{nousers10} = {};
862 foreach my $dxchan (DXChannel::get_all()) {
863 next unless $dxchan->is_rbn;
864 my $nq = keys %{$dxchan->{queue}};
865 my $pc = $dxchan->{norawhour} ? sprintf("%.1f%%",$dxchan->{norbnhour}*100/$dxchan->{norawhour}) : '0.0%';
866 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}};
867 $dxchan->{norawhour} = $dxchan->{norbnhour} = $dxchan->{nospothour} = 0; $dxchan->{nousershour} = {};
878 my $ta = [ gettimeofday ];
879 $json->indent(1)->canonical(1) if isdbg 'rbncache';
880 my $s = eval {$json->encode($spots)};
882 my $fh = IO::File->new(">$cachefn") or confess("writing $cachefn $!");
886 dbg("RBN:Write_cache error '$@'");
889 $json->indent(0)->canonical(0);
890 my $diff = _diffms($ta);
891 my $size = sprintf('%.3fKB', (length($s) / 1000));
892 dbg("RBN:WRITE_CACHE size: $size time to write: $diff mS");
898 my $mt = (stat($cachefn))[9];
899 my $t = $main::systime - $mt || 1;
900 my $p = difft($mt, 2);
901 if ($t < $cache_valid) {
902 dbg("RBN:check_cache '$cachefn' spot cache exists, created $p ago and not too old");
903 my $fh = IO::File->new($cachefn);
908 dbg("RBN:check_cache cache read size " . length $s);
911 dbg("RBN:check_cache file read error $!");
915 eval {$spots = $json->decode($s)};
916 if ($spots && ref $spots) {
917 if (exists $spots->{VERSION} && $spots->{VERSION} == $DATA_VERSION) {
918 # now clean out anything that has spot build ups in progress
919 while (my ($k, $cand) = each %$spots) {
920 next if $k eq 'VERSION';
921 next if $k =~ /^O\|/;
922 next if $k =~ /^SKIM\|/;
923 if (@$cand > CData) {
924 $spots->{$k} = [$cand->[CTime], $cand->[CQual]];
927 dbg("RBN:check_cache spot cache restored");
931 dbg("RBN::checkcache error decoding $@");
934 my $d = difft($main::systime-$cache_valid);
935 dbg("RBN::checkcache '$cachefn' created $p ago is too old (> $d), ignored");
938 dbg("RBN:check_cache '$cachefn' spot cache not present");