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
110 our %seeme; # the list of users that want to see themselves
120 $spots = {VERSION=>$DATA_VERSION};
122 if (defined $DB::VERSION) {
131 my $self = DXChannel::alloc(@_);
133 # routing, this must go out here to prevent race condx
140 $self->{nouser} = {};
142 $self->{noraw10} = 0;
143 $self->{nospot10} = 0;
144 $self->{nouser10} = {};
145 $self->{norbn10} = 0;
146 $self->{nospothour} = 0;
147 $self->{nouserhour} = {};
148 $self->{norbnhour} = 0;
149 $self->{norawhour} = 0;
151 $self->{lasttime} = $main::systime;
152 $self->{minspottime} = $minspottime;
153 $self->{beacontime} = $beacontime;
154 $self->{showstats} = 0;
155 $self->{pingint} = 0;
156 $self->{nopings} = 0;
164 my ($self, $line, $sort) = @_;
165 my $user = $self->{user};
166 my $call = $self->{call};
167 my $name = $user->{name};
170 my $host = $self->{conn}->peerhost;
172 $self->{hostname} = $host;
174 $self->{name} = $name ? $name : $call;
175 $self->state('prompt'); # a bit of room for further expansion, passwords etc
176 $self->{lang} = $user->lang || $main::lang || 'en';
177 if ($line =~ /host=/) {
178 my ($h) = $line =~ /host=(\d+\.\d+\.\d+\.\d+)/;
179 $line =~ s/\s*host=\d+\.\d+\.\d+\.\d+// if $h;
181 ($h) = $line =~ /host=([\da..fA..F:]+)/;
182 $line =~ s/\s*host=[\da..fA..F:]+// if $h;
186 $self->{hostname} = $h;
189 $self->{width} = 80 unless $self->{width} && $self->{width} > 80;
190 $self->{consort} = $line; # save the connection type
192 LogDbg('DXCommand', "$call connected from $self->{hostname}");
194 # set some necessary flags on the user if they are connecting
195 $self->{registered} = 1;
196 # sort out privilege reduction
201 $nossid =~ s/-\d+$//;
203 $self->{inrbnfilter} = Filter::read_in('rbn', $call, 1)
204 || Filter::read_in('rbn', 'node_default', 1);
206 # clean up qra locators
207 my $qra = $user->qra;
208 $qra = undef if ($qra && !DXBearing::is_qra($qra));
210 my $lat = $user->lat;
211 my $long = $user->long;
212 $user->qra(DXBearing::lltoqra($lat, $long)) if (defined $lat && defined $long);
215 # if we have been running and stopped for a while
216 # if the cache is warm enough don't operate the inrush preventor
217 $self->{inrushpreventor} = exists $runtime{$call} && $runtime{$call} > $startup_delay || $noinrush ? 0 : $main::systime + $startup_delay;
218 dbg("RBN: noinrush: $noinrush, setting inrushpreventor on $self->{call} to $self->{inrushpreventor}");
221 my @queue; # the queue of spots ready to send
228 my $dbgrbn = isdbg('rbn');
230 # remove leading and trailing spaces
237 my $now = $main::systime;
240 dbg "RBN:RAW,$line" if isdbg('rbnraw');
241 return unless $line=~/^DX\s+de/;
243 my (undef, undef, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t, $tx) = split /[:\s]+/, $line;
245 # fix up FT8 spots from 7001
246 $t = $u, $u = '' if !$t && is_ztime($u);
247 $t = $sort, $sort = '' if !$t && is_ztime($sort);
248 my $qra = $spd, $spd = '' if is_qra($spd);
251 # is this anything like a callsign?
252 unless (is_callsign($call)) {
253 dbg("RBN: ERROR $call from $origin on $qrg is invalid, dumped");
257 # remove all extraneous crap from the origin - just leave the base callsign
258 my $norigin = basecall($origin);
260 dbg("RBN: ERROR '$origin' is an invalid callsign, dumped");
265 # is this callsign in badspotter list?
266 if ($DXProt::badspotter->in($origin) || $DXProt::badnode->in($origin)) {
267 dbg("RBN: ERROR $origin is a bad spotter/node, dumped");
272 unless ($qrg =~ /^\d+\.\d{1,3}$/) {
273 dbg("RBN: ERROR qrg $qrg from $origin invalid, dumped");
280 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');
284 ++$self->{norawhour};
290 # fix up times for things like 'NXDXF B' etc
291 if ($tx && is_ztime($t)) {
300 if ($sort && $sort eq 'NCDXF') {
304 if ($sort && $sort eq 'BEACON') {
307 if ($mode =~ /^PSK/) {
310 if ($mode eq 'RTTY') {
314 # The main de-duping key is [call, $frequency], but we probe a bit around that frequency to find a
315 # range of concurrent frequencies that might be in play.
317 # The key to this is deducing the true callsign by "majority voting" (the greater the number of spotters
318 # the more effective this is) together with some lexical analsys probably in conjuction with DXSpider
319 # 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)
320 # and some heuristical "Kwalitee" rating given distance from the zone centres of spotter, recipient user
321 # and spotted. A map can be generated once per user and spotter as they are essentially mostly static.
322 # The spotted will only get a coarse position unless other info is available. Programs that parse
323 # DX bulletins and the online data online databases could be be used and then cached.
325 # Obviously users have to opt in to receiving RBN spots and other users will simply be passed over and
328 # Clearly this will only work in the 'mojo' branch of DXSpider where it is possible to pass off external
329 # data requests to ephemeral or semi resident forked processes that do any grunt work and the main
330 # process to just the standard "message passing" which has been shown to be able to sustain over 5000
331 # per second (limited by the test program's output and network speed, rather than DXSpider's handling).
334 my $nqrg = nearest(1, $qrg * 10); # normalised to nearest Khz
335 my $sp = "$call|$nqrg"; # hopefully the skimmers will be calibrated at least this well!
337 # deal with the unix time
338 my ($hh,$mm) = $t =~ /(\d\d)(\d\d)Z$/;
339 my $utz = $hh*3600 + $mm*60 + $main::systime_daystart; # possible issue with late spot from previous day
340 $utz -= 86400 if $utz > $now+3600; # too far ahead, drag it back one day
343 # But before we do anything, if this call is in the seeme hash then just send the spot to them
345 if (exists $seeme{$call} && (my $scall = $seeme{$call})) {
346 my $uchan = DXChannel::get($call);
347 if ($uchan->is_user) {
348 if (isdbg('seeme')) {
350 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});
352 my @s = Spot::prepare($qrg, $call, $utz, sprintf("%-3s %2ddB **SEEME**", $mode, $s), $origin.'-#');
353 my $buf = $uchan->format_dx_spot(@s);
354 dbg("seeme: result '$buf'") if isdbg('seeme');
355 $uchan->local_send('S', $buf) if $scall;
357 LogDbg("RBN Someone is playing silly persons $call is not a user and cannot do 'seeme', ignored and reset");
358 delete $seeme{$call};
362 my $cand = $spots->{$sp};
365 for ($i = $nqrg; !$cand && $i <= $nqrg+$search; $i += 1) {
367 $cand = $spots->{$new}, last if exists $spots->{$new};
370 my $diff = $i - $nqrg;
371 dbg(qq{RBN: QRG Diff using $new (+$diff) for $sp for qrg $qrg}) if (isdbg('rbnqrg') || ($dbgrbn && isdbg('rbn')));
377 for ($i = $nqrg; !$cand && $i >= $nqrg-$search; $i -= 1) {
379 $cand = $spots->{$new}, last if exists $spots->{$new};
382 my $diff = $nqrg - $i;
383 dbg(qq{RBN: QRG Diff using $new (-$diff) for $sp for qrg $qrg}) if (isdbg('rbnqrg') || ($dbgrbn && isdbg('rbn')));
388 # if we have one and there is only one slot and that slot's time isn't expired for respot then return
390 if ($cand && ref $cand) {
391 if (@$cand <= CData) {
392 if ($self->{minspottime} > 0 && $now - $cand->[CTime] < $self->{minspottime}) {
393 dbg("RBN: key: '$sp' call: $call qrg: $qrg DUPE \@ ". atime(int $cand->[CTime])) if $dbgrbn && isdbg('rbn');
397 dbg("RBN: key: '$sp' RESPOTTING call: $call qrg: $qrg last seen \@ ". atime(int $cand->[CTime])) if $dbgrbn && isdbg('rbn');
398 $cand->[CTime] = $now;
402 # otherwise we have a spot being built up at the moment
404 dbg("RBN: key '$sp' = '$cand' not ref");
407 # new spot / frequency
408 $spots->{$sp} = $cand = [$now, 0];
409 dbg("RBN: key: '$sp' call: $call qrg: $qrg NEW" . ($respot ? ' RESPOT' : '')) if $dbgrbn && isdbg('rbn');
412 # add me to the display queue unless we are waiting for initial in rush to finish
413 return unless $noinrush || $self->{inrushpreventor} < $main::systime;
415 # build up a new record and store it in the buildup
416 # create record and add into the buildup
417 my $r = [$origin, nearest(.1, $qrg), $call, $mode, $s, $t, $utz, $respot, $u];
418 my @s = Spot::prepare($r->[RQrg], $r->[RCall], $r->[RUtz], '', $r->[ROrigin]);
420 dbg("RBN: ERROR invalid prefix/callsign $call from $origin-# on $qrg, dumped");
424 if ($self->{inrbnfilter}) {
425 my ($want, undef) = $self->{inrbnfilter}->it($s);
428 $r->[RSpotData] = \@s;
430 ++$self->{queue}->{$sp};# unless @$cand>= CData; # queue the KEY (not the record)
432 dbg("RBN: key: '$sp' ADD RECORD call: $call qrg: $qrg origin: $origin respot: $respot") if $dbgrbn && isdbg('rbn');
437 dbg "RBN:DATA,$line" if $dbgrbn && isdbg('rbn');
441 # we should get the spot record minus the time, so just an array of record (arrays)
450 ++$self->{norbnhour};
452 # $r = [$origin, $qrg, $call, $mode, $s, $utz, $respot];
454 my $mode = $cand->[CData]->[RMode]; # as all the modes will be the same;
456 my @dxchan = DXChannel::get_all();
458 foreach my $dxchan (@dxchan) {
459 next unless $dxchan->is_user;
460 my $user = $dxchan->{user};
461 next unless $user && $user->wantrbn;
463 # does this user want this sort of spot at all?
465 ++$want if $user->wantbeacon && $mode =~ /^BCN|DXF/;
466 ++$want if $user->wantcw && $mode =~ /^CW/;
467 ++$want if $user->wantrtty && $mode =~ /^RTT/;
468 ++$want if $user->wantpsk && $mode =~ /^PSK|FSK|MSK/;
469 ++$want if $user->wantft && $mode =~ /^FT/;
471 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",
478 )) if isdbg('rbnll');
480 # send one spot to one user out of the ones that we have
481 $self->dx_spot($dxchan, $quality, $cand) if $want;
491 my $call = $dxchan->{call};
492 my $strength = 100; # because it could if we talk about FTx
498 ++$self->{nousers}->{$call};
499 ++$self->{nousers10}->{$call};
500 ++$self->{nousershour}->{$call};
503 my $rf = $dxchan->{rbnfilter} || $dxchan->{spotsfilter};
506 foreach my $r (@$cand) {
507 # $r = [$origin, $qrg, $call, $mode, $s, $t, $utz, $respot, $qra];
508 # Spot::prepare($qrg, $call, $utz, $comment, $origin);
509 next unless $r && ref $r;
511 $qra = $r->[RQra] if !$qra && $r->[RQra] && is_qra($r->[RQra]);
513 $comment = sprintf "%-3s %2ddB $quality", $r->[RMode], $r->[RStrength];
514 my $s = $r->[RSpotData]; # the prepared spot
515 $s->[SComment] = $comment; # apply new generated comment
517 ++$zone{$s->[SZone]}; # save the spotter's zone
519 # save the lowest strength one
520 if ($r->[RStrength] < $strength) {
521 $strength = $r->[RStrength];
523 dbg("RBN: STRENGTH spot: $s->[SCall] qrg: $s->[SQrg] origin: $s->[SOrigin] dB: $r->[RStrength] < $strength") if isdbg 'rbnll';
527 my ($want, undef) = $rf->it($s);
528 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';
535 $saver = $filtered; # if nothing passed the filter's lips then $saver == $filtered == undef !
540 # create a zone list of spotters
541 delete $zone{$saver->[SZone]}; # remove this spotter's zone (leaving all the other zones)
542 my $z = join ',', sort {$a <=> $b} keys %zone;
544 # alter spot data accordingly
545 $saver->[SComment] .= " Z:$z" if $z;
547 send_final($dxchan, $saver);
551 ++$self->{nospothour};
554 my $user = DXUser::get_current($saver->[SCall]) || DXUser->new($saver->[SCall]);
555 unless ($user->qra && is_qra($user->qra)) {
557 dbg("RBN: update qra on $saver->[SCall] to $qra");
559 # update lastseen if nothing else
569 my $call = $dxchan->{call};
572 dbg("RBN: SENDING to $call spot: $saver->[SCall] qrg: $saver->[SQrg] origin: $saver->[SOrigin] $saver->[SComment]") if isdbg 'rbnll';
573 if ($dxchan->{ve7cc}) {
574 my $call = $saver->[SOrigin];
575 $saver->[SOrigin] .= '-#';
576 $buf = VE7CC::dx_spot($dxchan, @$saver);
577 $saver->[SOrigin] = $call;
579 my $call = $saver->[SOrigin];
580 $saver->[SOrigin] = substr($call, 0, 6);
581 $saver->[SOrigin] .= '-#';
582 $buf = $dxchan->format_dx_spot(@$saver);
583 $saver->[SOrigin] = $call;
585 $dxchan->local_send('R', $buf);
591 my $rbnskim = isdbg('rbnskim');
593 foreach my $dxchan (DXChannel::get_all()) {
594 next unless $dxchan->is_rbn;
596 # At this point we run the queue to see if anything can be sent onwards to the punter
597 my $now = $main::systime;
598 my $ta = [gettimeofday];
601 # now run the waiting queue which just contains KEYS ($call|$qrg)
602 foreach my $sp (keys %{$dxchan->{queue}}) {
603 my $cand = $spots->{$sp};
606 unless ($cand && $cand->[CTime]) {
607 dbg "RBN Cand $sp " . ($cand ? 'def' : 'undef') . " [CTime] " . ($cand->[CTime] ? 'def' : 'undef') . " dwell $dwelltime";
608 delete $spots->{$sp};
609 delete $dxchan->{queue}->{$sp}; # remove
613 my $ctime = $cand->[CTime];
614 my $quality = @$cand - CData;
615 my $dwellsecs = $now - $ctime;
616 if ($quality >= $maxqual || $dwellsecs >= $dwelltime || $dwellsecs >= $limbotime) {
617 # we have a candidate, create qualitee value(s);
618 unless (@$cand > CData) {
619 dbg "RBN: QUEUE key '$sp' MISSING RECORDS, IGNORED" . dd($cand) if isdbg 'rbnqueue';
620 delete $spots->{$sp}; # don't remember it either - this means that a spot HAS to come in with sufficient spotters to be processed.
621 delete $dxchan->{queue}->{$sp};
624 dbg "RBN: QUEUE PROCESSING key: '$sp' $now >= $cand->[CTime]" if isdbg 'rbnqueue';
625 my $spotters = $quality;
627 # 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
628 my $r = $cand->[CData];
629 if ($dwellsecs > $limbotime && $quality < $minqual) {
630 if ( $rbnskim && isdbg('rbnskim')) {
633 my $lastin = difft($ctime, $now, 2);
634 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}";
638 delete $spots->{$sp}; # don't remember it either - this means that a spot HAS to come in with sufficient spotters to be processed.
639 delete $dxchan->{queue}->{$sp};
643 # we have a possible removal from Limbo, check for more than one skimmer and reset the quality if required
644 # DOES THIS TEST CAUSE RACES?
645 if (!$r->[Respot] && $quality >= $minqual && $dwellsecs > $dwelltime+1) {
647 # because we don't need to check for repeats by the same skimmer in the normal case, we do here
650 foreach my $wr (@$cand) {
652 push @origin, $wr->[ROrigin];
653 if (exists $seen{$wr->[ROrigin]}) {
656 $seen{$wr->[ROrigin]} = $wr;
658 # reset the quality to ignore dupes
660 $quality = keys %seen;
661 if ($quality >= $minqual) {
662 if ( $rbnskim && isdbg('rbnskim')) {
663 my $lastin = difft($ctime, $now, 2);
664 my $sk = join ' ', keys %seen;
665 my $or = join ' ', @origin;
666 my $s = "RBN:SKIM promoted from Limbo - key: '$sp' (lastin: $lastin Q now: $quality was $oq skimmers now: $sk";
667 $s .= " was $or" if $or ne $sk;
671 } elsif ($oq != $quality) {
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 quality reset key: '$sp' (lastin: $lastin Q now: $quality was $oq skimmers now: $sk was: $or)";
680 my @ncand = (@$cand[CTime, CQual], values %seen);
681 $spots->{$sp} = \@ncand;
685 # we now kick this spot into Limbo
686 if ($quality < $minqual) {
690 $quality = 9 if $quality > 9;
691 $cand->[CQual] = $quality if $quality > $cand->[CQual];
693 # this scores each candidate according to its skimmer's QRG score (i.e. how often it agrees with its peers)
694 # what happens is hash of all QRGs in candidates are incremented by that skimmer's reputation for "accuracy"
695 # or, more exactly, past agreement with the consensus. This score can be from -5 -> +5.
701 foreach $r (@$cand) {
703 if (exists $seen{$r->[ROrigin]}) {
707 $seen{$r->[ROrigin]} = 1;
708 $band ||= int $r->[RQrg] / 1000;
709 $sk = "SKIM|$r->[ROrigin]|$band"; # thus only once per set of candidates
710 $skimmer = $spots->{$sk};
712 $skimmer = $spots->{$sk} = [1, 0, 0, $now, []]; # this first time, this new skimmer gets the benefit of the doubt on frequency.
713 dbg("RBN:SKIM new slot $sk " . $json->encode($skimmer)) if $rbnskim && isdbg('rbnskim');
715 $qrg{$r->[RQrg]} += ($skimmer->[DScore] || 1);
718 # determine the most likely qrg and then set it - NOTE (-)ve votes, generated by the skimmer scoring system above, are ignored
723 while (my ($k, $votes) = each %qrg) {
731 # Ignore possible spots with 0 QRG score - as determined by the skimmer scoring system above - as they are likely to be wrong
733 if ( $rbnskim && isdbg('rbnskim')) {
735 while (my ($k, $v) = (each %qrg)) {
740 foreach $r (@$cand) {
741 next unless $r && ref $r;
742 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";
746 delete $spots->{$sp}; # get rid
747 delete $dxchan->{queue}->{$sp};
751 # detemine and spit out the deviants. Then adjust the scores according to whether it is a deviant or good
752 # NOTE: deviant nodes can become good (or less bad), and good nodes bad (or less good) on each spot that
753 # they generate. This is based solely on each skimmer's agreement (or not) with the "consensus" score generated
754 # above ($qrg). The resultant score + good + bad is stored per band and will be used the next time a spot
755 # appears on this band from each skimmer.
756 foreach $r (@$cand) {
757 next unless $r && ref $r;
758 my $diff = $c > 1 ? nearest(.1, $r->[RQrg] - $qrg) : 0;
759 $sk = "SKIM|$r->[ROrigin]|$band";
760 $skimmer = $spots->{$sk};
762 ++$skimmer->[DBad] if $skimmer->[DBad] < $maxdeviants;
763 --$skimmer->[DGood] if $skimmer->[DGood] > 0;
764 push @deviant, sprintf("$r->[ROrigin]:%+.1f", $diff);
765 push @{$skimmer->[DEviants]}, $diff;
766 shift @{$skimmer->[DEviants]} while @{$skimmer->[DEviants]} > $maxdeviants;
768 ++$skimmer->[DGood] if $skimmer->[DGood] < $maxdeviants;
769 --$skimmer->[DBad] if $skimmer->[DBad] > 0;
770 shift @{$skimmer->[DEviants]};
772 $skimmer->[DScore] = $skimmer->[DGood] - $skimmer->[DBad];
773 if ($rbnskim && isdbg('rbnskim')) {
774 my $lastin = difft($skimmer->[DLastin], $now, 2);
775 my $difflist = join(', ', @{$skimmer->[DEviants]});
776 $difflist = " band qrg diffs: $difflist" if $difflist;
777 dbg("RBN:SKIM key $sp slot $sk $r->[RQrg] - $qrg = $diff Skimmer score: $skimmer->[DGood] - $skimmer->[DBad] = $skimmer->[DScore] lastseen:$lastin ago$difflist");
779 $skimmer->[DLastin] = $now;
780 $r->[RSpotData]->[SQrg] = $qrg if $qrg && $c > 1; # set all the QRGs to the agreed value
783 $qrg = (sprintf "%.1f", $qrg)+0;
786 my $squality = "Q:$cand->[CQual]";
787 $squality .= '*' if $c > 1;
788 $squality .= '+' if $r->[Respot];
790 if (isdbg('progress')) {
791 my $rt = difft($ctime, $now, 2);
792 my $s = "RBN: SPOT key: '$sp' = $r->[RCall] on $r->[RQrg] by $r->[ROrigin] \@ $r->[RTime] $squality route: $dxchan->{call} dwell:$rt";
794 $s .= " QRGScore: $mv Deviants: $td/$spotters";
795 $s .= ' (' . join(', ', sort @deviant) . ')' if $td;
799 # finally send it out to any waiting public
800 send_dx_spot($dxchan, $squality, $cand);
802 # clear out the data and make this now just "spotted", but no further action required until respot time
803 dbg "RBN: QUEUE key '$sp' cleared" if isdbg 'rbn';
805 delete $dxchan->{queue}->{$sp};
807 # calculate new sp (which will be 70% likely the same as the old one)
808 # 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.
809 # and we want to store the key that corresponds to majority opinion.
810 my $nqrg = nearest(1, $qrg * 10); # normalised to nearest Khz
811 my $nsp = "$r->[RCall]|$nqrg";
813 dbg("RBN:SKIM CHANGE KEY sp '$sp' -> '$nsp' for storage") if $rbnskim && isdbg('rbnskim');
814 delete $spots->{$sp};
815 $spots->{$nsp} = [$now, $cand->[CQual]];
817 $spots->{$sp} = [$now, $cand->[CQual]];
821 dbg sprintf("RBN: QUEUE key: '$sp' SEND time not yet reached %.1f secs left", $cand->[CTime] + $dwelltime - $now) if isdbg 'rbnqueue';
824 if (isdbg('rbntimer')) {
825 my $diff = _diffus($ta);
826 dbg "RBN: TIMER process queue for call: $dxchan->{call} $items spots $diff uS";
833 foreach my $dxchan (DXChannel::get_all()) {
834 next unless $dxchan->is_rbn;
835 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');
836 if ($dxchan->{noraw} == 0 && $dxchan->{lasttime} > 60) {
837 LogDbg('RBN', "RBN: no input from $dxchan->{call}, disconnecting");
840 $dxchan->{noraw} = $dxchan->{norbn} = $dxchan->{nospot} = 0; $dxchan->{nousers} = {};
841 $runtime{$dxchan->{call}} += 60;
844 # save the spot cache
845 write_cache() unless $main::systime + $startup_delay < $main::systime;;
852 while (my ($k,$cand) = each %{$spots}) {
853 next if $k eq 'VERSION';
854 next if $k =~ /^O\|/;
855 next if $k =~ /^SKIM\|/;
857 if ($main::systime - $cand->[CTime] > $minspottime*2) {
865 dbg "RBN:STATS spot cache remain: $count removed: $removed"; # if isdbg('rbn');
866 foreach my $dxchan (DXChannel::get_all()) {
867 next unless $dxchan->is_rbn;
868 my $nq = keys %{$dxchan->{queue}};
869 my $pc = $dxchan->{noraw10} ? sprintf("%.1f%%",$dxchan->{norbn10}*100/$dxchan->{noraw10}) : '0.0%';
870 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}};
871 $dxchan->{noraw10} = $dxchan->{norbn10} = $dxchan->{nospot10} = 0; $dxchan->{nousers10} = {};
877 foreach my $dxchan (DXChannel::get_all()) {
878 next unless $dxchan->is_rbn;
879 my $nq = keys %{$dxchan->{queue}};
880 my $pc = $dxchan->{norawhour} ? sprintf("%.1f%%",$dxchan->{norbnhour}*100/$dxchan->{norawhour}) : '0.0%';
881 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}};
882 $dxchan->{norawhour} = $dxchan->{norbnhour} = $dxchan->{nospothour} = 0; $dxchan->{nousershour} = {};
893 my $ta = [ gettimeofday ];
894 $json->indent(1)->canonical(1) if isdbg 'rbncache';
895 my $s = eval {$json->encode($spots)};
897 my $fh = IO::File->new(">$cachefn") or confess("writing $cachefn $!");
901 dbg("RBN:Write_cache error '$@'");
904 $json->indent(0)->canonical(0);
905 my $diff = _diffms($ta);
906 my $size = sprintf('%.3fKB', (length($s) / 1000));
907 dbg("RBN:WRITE_CACHE size: $size time to write: $diff mS");
913 my $mt = (stat($cachefn))[9];
914 my $t = $main::systime - $mt || 1;
915 my $p = difft($mt, 2);
916 if ($t < $cache_valid) {
917 dbg("RBN:check_cache '$cachefn' spot cache exists, created $p ago and not too old");
918 my $fh = IO::File->new($cachefn);
923 dbg("RBN:check_cache cache read size " . length $s);
926 dbg("RBN:check_cache file read error $!");
930 eval {$spots = $json->decode($s)};
931 if ($spots && ref $spots) {
932 if (exists $spots->{VERSION} && $spots->{VERSION} == $DATA_VERSION) {
933 # now clean out anything that has spot build ups in progress
934 while (my ($k, $cand) = each %$spots) {
935 next if $k eq 'VERSION';
936 next if $k =~ /^O\|/;
937 next if $k =~ /^SKIM\|/;
938 if (@$cand > CData) {
939 $spots->{$k} = [$cand->[CTime], $cand->[CQual]];
942 dbg("RBN:check_cache spot cache restored");
946 dbg("RBN::checkcache error decoding $@");
949 my $d = difft($main::systime-$cache_valid);
950 dbg("RBN::checkcache '$cachefn' created $p ago is too old (> $d), ignored");
953 dbg("RBN:check_cache '$cachefn' spot cache not present");
968 delete $seeme{$call};