X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FRBN.pm;h=15b4aa479fc86b1dd2702233dda887f0d380e243;hb=cbb522ef802d48991734a4ce803fa6ffa9774588;hp=9687b18f6f2741ac15931eae6a0fda7e36b5b91e;hpb=d40358b98c4f3fe24890369543dd7768c99da962;p=spider.git diff --git a/perl/RBN.pm b/perl/RBN.pm index 9687b18f..15b4aa47 100644 --- a/perl/RBN.pm +++ b/perl/RBN.pm @@ -11,15 +11,102 @@ package RBN; use 5.10.1; -use DXUtil; +use lib qw {.}; + use DXDebug; +use DXUtil; use DXLog; use DXUser; use DXChannel; use Math::Round qw(nearest); +use Date::Parse; +use Time::HiRes qw(gettimeofday); +use Spot; +use DXJSON; +use IO::File; + +use constant { + ROrigin => 0, + RQrg => 1, + RCall => 2, + RMode => 3, + RStrength => 4, + RTime => 5, + RUtz => 6, + Respot => 7, + RQra => 8, + RSpotData => 9, + }; + +use constant { + SQrg => 0, + SCall => 1, + STime => 2, + SComment => 3, + SOrigin => 4, + SZone => 11, + }; +use constant { + OQual => 0, + OAvediff => 1, + OSpare => 2, + ODiff => 3, + }; +use constant { + CTime => 0, + CQual => 1, + CData => 2, + }; + + +our $DATA_VERSION = 1; our @ISA = qw(DXChannel); +our $startup_delay = 5*60; # don't send anything out until this timer has expired + # this is to allow the feed to "warm up" with duplicates + # so that the "big rush" doesn't happen. + +our $minspottime = 30*60; # the time between respots of a callsign - if a call is + # still being spotted (on the same freq) and it has been + # spotted before, it's spotted again after this time + # until the next minspottime has passed. + +our $beacontime = 5*60; # same as minspottime, but for beacons (and shorter) + +our $dwelltime = 10; # the amount of time to wait for duplicates before issuing + # a spot to the user (no doubt waiting with bated breath). + +our $filterdef = $Spot::filterdef; # we use the same filter as the Spot system. Can't think why :-). + +my $spots; # the GLOBAL spot cache + +my %runtime; # how long each channel has been running + +our $cachefn = localdata('rbn_cache'); +our $cache_valid = 4*60; # The cache file is considered valid if it is not more than this old + +our $maxqrgdiff = 10; # the maximum +our $minqual = 2; # the minimum quality we will accept for output + +my $json; +my $noinrush = 0; # override the inrushpreventor if set + +sub init +{ + $json = DXJSON->new; + if (check_cache()) { + $noinrush = 1; + } else { + $spots = {VERSION=>$DATA_VERSION}; + } + if (defined $DB::VERSION) { + $noinrush = 1; + $json->indent(1); + } + +} + sub new { my $self = DXChannel::alloc(@_); @@ -28,17 +115,27 @@ sub new my $pkg = shift; my $call = shift; - DXProt::_add_thingy($main::routeroot, [$call, 0, 0, 1, undef, undef, $self->hostname], ); - $self->{d} = {}; - $self->{spot} = {}; $self->{last} = 0; $self->{noraw} = 0; $self->{nospot} = 0; + $self->{nouser} = {}; $self->{norbn} = 0; + $self->{noraw10} = 0; + $self->{nospot10} = 0; + $self->{nouser10} = {}; + $self->{norbn10} = 0; + $self->{nospothour} = 0; + $self->{nouserhour} = {}; + $self->{norbnhour} = 0; + $self->{norawhour} = 0; $self->{sort} = 'N'; $self->{lasttime} = $main::systime; - $self->{minspottime} = 60*60; + $self->{minspottime} = $minspottime; + $self->{beacontime} = $beacontime; $self->{showstats} = 0; + $self->{pingint} = 0; + $self->{nopings} = 0; + $self->{queue} = {}; return $self; } @@ -49,8 +146,6 @@ sub start my $user = $self->{user}; my $call = $self->{call}; my $name = $user->{name}; - my $dref = $self->{d}; - my $spotref = $self->{spot}; # log it my $host = $self->{conn}->peerhost; @@ -67,7 +162,10 @@ sub start ($h) = $line =~ /host=([\da..fA..F:]+)/; $line =~ s/\s*host=[\da..fA..F:]+// if $h; } - $self->{hostname} = $h if $h; + if ($h) { + $h =~ s/^::ffff://; + $self->{hostname} = $h; + } } $self->{width} = 80 unless $self->{width} && $self->{width} > 80; $self->{consort} = $line; # save the connection type @@ -82,11 +180,10 @@ sub start # get the filters my $nossid = $call; $nossid =~ s/-\d+$//; - - $self->{spotsfilter} = Filter::read_in('spots', $call, 0) - || Filter::read_in('spots', $nossid, 0) - || Filter::read_in('spots', 'user_default', 0); + $self->{inrbnfilter} = Filter::read_in('rbn', $call, 1) + || Filter::read_in('rbn', 'node_default', 1); + # clean up qra locators my $qra = $user->qra; $qra = undef if ($qra && !DXBearing::is_qra($qra)); @@ -95,18 +192,21 @@ sub start my $long = $user->long; $user->qra(DXBearing::lltoqra($lat, $long)) if (defined $lat && defined $long); } + + # if we have been running and stopped for a while + # if the cache is warm enough don't operate the inrush preventor + $self->{inrushpreventor} = exists $runtime{$call} && $runtime{$call} > $startup_delay || $noinrush ? 0 : $main::systime + $startup_delay; + dbg("RBN: noinrush: $noinrush, setting inrushpreventor on $self->{call} to $self->{inrushpreventor}"); } +my @queue; # the queue of spots ready to send + sub normal { my $self = shift; my $line = shift; my @ans; - my $d = $self->{d}; - my $spot = $self->{spot}; - - # save this for them's that need it - my $rawline = $line; +# my $spots = $self->{spot}; # remove leading and trailing spaces chomp $line; @@ -115,10 +215,11 @@ sub normal # add base RBN - my $tim = $main::systime; + my $now = $main::systime; # parse line dbg "RBN:RAW,$line" if isdbg('rbnraw'); + return unless $line=~/^DX\s+de/; my (undef, undef, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t, $tx) = split /[:\s]+/, $line; @@ -127,12 +228,24 @@ sub normal $t = $sort, $sort = '' if !$t && is_ztime($sort); my $qra = $spd, $spd = '' if is_qra($spd); $u = $qra if $qra; - -# no warnings qw(uninitialized); - -# dbg qq{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 $line =~ /DX/; -# use warnings; + # is this anything like a callsign? + unless (is_callsign($call)) { + dbg("RBN: ERROR $call from $origin on $qrg is invalid, dumped"); + return; + } + + $origin =~ s/\-(?:\d{1,2}\-)?\#$//; # get rid of all the crap we aren't interested in + + + $sort ||= ''; + $tx ||= ''; + $qra ||= ''; + dbg qq{RBN:input decode or:$origin qr:$qrg ca:$call mo:$mode s:$s m:$m sp:$spd u:$u sort:$sort t:$t tx:$tx qra:$qra} if isdbg('rbn'); + + ++$self->{noraw}; + ++$self->{noraw10}; + ++$self->{norawhour}; my $b; @@ -148,20 +261,22 @@ sub normal return (0); } } - - # We have an RBN data line, dedupe it very simply on time, ignore QRG completely. - # This works because the skimmers are NTP controlled (or should be) and will receive - # the spot at the same time (velocity factor of the atmosphere and network delays - # carefully (not) taken into account :-) - - # Note, there is no intelligence here, but there are clearly basic heuristics that could - # be applied at this point that reject (more likely rewrite) the call of a busted spot that would - # useful for a zonal hotspot requirement from the cluster node. + if ($sort && $sort eq 'NCDXF') { + $mode = 'DXF'; + $t = $tx; + } + if ($sort && $sort eq 'BEACON') { + $mode = 'BCN'; + } + if ($mode =~ /^PSK/) { + $mode = 'PSK'; + } + if ($mode eq 'RTTY') { + $mode = 'RTT'; + } - # In reality, this mechanism would be incorporated within the cluster code, utilising the dxqsl database, - # and other resources in DXSpider, thus creating a zone map for an emitted spot. This is then passed through the - # normal "to-user" spot system (where normal spots are sent to be displayed per user) and then be - # processed through the normal, per user, spot filtering system - like a regular spot. + # The main de-duping key is [call, $frequency], but we probe a bit around that frequency to find a + # range of concurrent frequencies that might be in play. # The key to this is deducing the true callsign by "majority voting" (the greater the number of spotters # the more effective this is) together with some lexical analsys probably in conjuction with DXSpider @@ -177,104 +292,437 @@ sub normal # Clearly this will only work in the 'mojo' branch of DXSpider where it is possible to pass off external # data requests to ephemeral or semi resident forked processes that do any grunt work and the main # process to just the standard "message passing" which has been shown to be able to sustain over 5000 - # per second (limited by the test program's output and network speed, rather than DXSpider's handling). - - my $p = "$t|$call"; - ++$self->{noraw}; - return if $d->{$p}; - - # new RBN input - $d->{$p} = $tim; - ++$self->{norbn}; - $qrg = sprintf('%.1f', nearest(.1, $qrg)); # to nearest 100Hz (to catch the odd multiple decpl QRG [eg '7002.07']). - if (isdbg('rbnraw')) { - my $ss = join(',', "RBN", $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t); - $ss .= ",$b" if $b; - dbg "RBNRAW:$ss"; + # per second (limited by the test program's output and network speed, rather than DXSpider's handling). + + my $nearest = 1; + my $search = 5; + my $mult = 10; + my $tqrg = $qrg * $mult; + my $nqrg = nearest($nearest, $tqrg); # normalised to nearest Khz +# my $nqrg = nearest_even($qrg); # normalised to nearest Khz + my $sp = "$call|$nqrg"; # hopefully the skimmers will be calibrated at least this well! + + # find it? + my $cand = $spots->{$sp}; + unless ($cand) { + my ($i, $new); + for ($i = $tqrg; !$cand && $i <= $tqrg+$search; $i += 1) { + $new = "$call|$i"; + $cand = $spots->{$new}, last if exists $spots->{$new}; + } + if ($cand) { + my $diff = $i - $tqrg; + dbg(qq{RBN: QRG Diff using $new (+$diff) for $sp for qrg $qrg}) if (isdbg('rbnqrg') || isdbg('rbn')); + $sp = $new; + } + } + unless ($cand) { + my ($i, $new); + for ($i = $tqrg; !$cand && $i >= $tqrg-$search; $i -= 1) { + $new = "$call|$i"; + $cand = $spots->{$new}, last if exists $spots->{$new}; + } + if ($cand) { + my $diff = $tqrg - $i; + dbg(qq{RBN: QRG Diff using $new (-$diff) for $sp for qrg $qrg}) if (isdbg('rbnqrg') || isdbg('rbn')); + $sp = $new; + } } + + # if we have one and there is only one slot and that slot's time isn't expired for respot then return + my $respot = 0; + if ($cand && ref $cand) { + if (@$cand <= CData) { + unless ($self->{minspottime} > 0 && $now - $cand->[CTime] >= $self->{minspottime}) { + dbg("RBN: key: '$sp' call: $call qrg: $qrg DUPE \@ ". atime(int $cand->[CTime])) if isdbg('rbn'); + return; + } + + dbg("RBN: key: '$sp' RESPOTTING call: $call qrg: $qrg last seen \@ ". atime(int $cand->[CTime])) if isdbg('rbn'); + $cand->[CTime] = $now; + ++$respot; + } - # Determine whether to "SPOT" it based on whether we have not seen it before (near this QRG) or, - # if we have, has it been a "while" since the last time we spotted it? If it has been spotted - # before then "RESPOT" it. - my $nqrg = nearest(1, $qrg); # normalised to nearest Khz - my $sp = "$call|$nqrg"; # hopefully the skimmers will be calibrated at least this well! - my $ts = $spot->{$sp}; - - if (!$ts || ($self->{minspottime} > 0 && $tim - $ts >= $self->{minspottime})) { - ++$self->{nospot}; - my $tag = $ts ? "RESPOT" : "SPOT"; - $t .= ",$b" if $b; - $sort ||= ''; - dbg "RBN:" . join(',', $tag, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t); - - send_dx_spot($self, $line, $mode); - - $spot->{$sp} = $tim; + # otherwise we have a spot being built up at the moment + } elsif ($cand) { + dbg("RBN: key '$sp' = '$cand' not ref"); + return; } - } else { - dbg "RBN:DATA,$line" if isdbg('rbn'); - } - # periodic clearing out of the two caches - if (($tim % 60 == 0 && $tim > $self->{last}) || ($self->{last} && $tim >= $self->{last} + 60)) { - my $count = 0; - my $removed = 0; + # here we either have an existing spot record buildup on the go, or we need to create the first one + unless ($cand) { + $spots->{$sp} = $cand = [$now, 0]; + dbg("RBN: key: '$sp' call: $call qrg: $qrg NEW" . ($respot ? ' RESPOT' : '')) if isdbg('rbn'); + } - while (my ($k,$v) = each %{$d}) { - if ($tim-$v > 60) { - delete $d->{$k}; - ++$removed - } else { - ++$count; - } + # add me to the display queue unless we are waiting for initial in rush to finish + return unless $noinrush || $self->{inrushpreventor} < $main::systime; + + # build up a new record and store it in the buildup + # deal with the unix time + my ($hh,$mm) = $t =~ /(\d\d)(\d\d)Z$/; + my $utz = $hh*3600 + $mm*60 + $main::systime_daystart; # possible issue with late spot from previous day + $utz -= 86400 if $utz > $now+3600; # too far ahead, drag it back one day + + # create record and add into the buildup + my $r = [$origin, nearest(.1, $qrg), $call, $mode, $s, $t, $utz, $respot, $u]; + my @s = Spot::prepare($r->[RQrg], $r->[RCall], $r->[RUtz], '', $r->[ROrigin]); + if ($s[5] == 666) { + dbg("RBN: ERROR invalid prefix/callsign $call from $origin-# on $qrg, dumped"); + return; } - dbg "RBN:ADMIN,rbn cache: $removed removed $count remain" if isdbg('rbn'); - $count = $removed = 0; - while (my ($k,$v) = each %{$spot}) { - if ($tim-$v > $self->{minspottime}*2) { - delete $spot->{$k}; - ++$removed; - } else { - ++$count; - } + + if ($self->{inrbnfilter}) { + my ($want, undef) = $self->{inrbnfilter}->it($s); + return unless $want; } - dbg "RBN:ADMIN,spot cache: $removed removed $count remain" if isdbg('rbn'); + $r->[RSpotData] = \@s; - dbg "RBN:" . join(',', "STAT", $self->{noraw}, $self->{norbn}, $self->{nospot}) if $self->{showstats}; - $self->{noraw} = $self->{norbn} = $self->{nospot} = 0; + ++$self->{queue}->{$sp};# unless @$cand>= CData; # queue the KEY (not the record) - $self->{last} = int($tim / 60) * 60; + dbg("RBN: key: '$sp' ADD RECORD call: $call qrg: $qrg origin: $origin") if isdbg('rbn'); + + push @$cand, $r; + + } else { + dbg "RBN:DATA,$line" if isdbg('rbn'); } } -# we only send to users and we send the original line (possibly with a -# Q:n in it) +# we should get the spot record minus the time, so just an array of record (arrays) sub send_dx_spot { my $self = shift; - my $line = shift; - my $mode = shift; + my $quality = shift; + my $cand = shift; + + ++$self->{norbn}; + ++$self->{norbn10}; + ++$self->{norbnhour}; + + # $r = [$origin, $qrg, $call, $mode, $s, $utz, $respot]; + + my $mode = $cand->[CData]->[RMode]; # as all the modes will be the same; my @dxchan = DXChannel::get_all(); foreach my $dxchan (@dxchan) { next unless $dxchan->is_user; my $user = $dxchan->{user}; - next unless $user->wantrbn; + next unless $user && $user->wantrbn; + # does this user want this sort of spot at all? my $want = 0; - ++$want if $user->wantbeacon && $mode =~ /^BEA|NCD/; - ++$want if $user->wantcw && $mode =~ /^CW/; - ++$want if $user->wantrtty && $mode =~ /^RTTY/; - ++$want if $user->wantpsk && $mode =~ /^PSK/; + ++$want if $user->wantbeacon && $mode =~ /^BCN|DXF/; ++$want if $user->wantcw && $mode =~ /^CW/; + ++$want if $user->wantrtty && $mode =~ /^RTT/; + ++$want if $user->wantpsk && $mode =~ /^PSK|FSK|MSK/; ++$want if $user->wantft && $mode =~ /^FT/; - ++$want unless $want; # send everything if nothing is selected. + 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", + $user->wantrbn, + $user->wantft, + $user->wantbeacon, + $user->wantcw, + $user->wantpsk, + $user->wantrtty, + )) if isdbg('rbnll'); + + # send one spot to one user out of the ones that we have + $self->dx_spot($dxchan, $quality, $cand) if $want; + } +} + +sub dx_spot +{ + my $self = shift; + my $dxchan = shift; + my $quality = shift; + my $cand = shift; + my $call = $dxchan->{call}; + my $strength = 100; # because it could if we talk about FTx + my $saver; + my %zone; + my $respot; + my $qra; + + ++$self->{nousers}->{$call}; + ++$self->{nousers10}->{$call}; + ++$self->{nousershour}->{$call}; + + my $filtered; + my $rf = $dxchan->{rbnfilter} || $dxchan->{spotsfilter}; + my $comment; + + foreach my $r (@$cand) { + # $r = [$origin, $qrg, $call, $mode, $s, $t, $utz, $respot, $qra]; + # Spot::prepare($qrg, $call, $utz, $comment, $origin); + next unless ref $r; + + $qra = $r->[RQra] if !$qra && $r->[RQra] && is_qra($r->[RQra]); + + $comment = sprintf "%-3s %2ddB $quality", $r->[RMode], $r->[RStrength]; + my $s = $r->[RSpotData]; # the prepared spot + $s->[SComment] = $comment; # apply new generated comment + + ++$zone{$s->[SZone]}; # save the spotter's zone + + # save the lowest strength one + if ($r->[RStrength] < $strength) { + $strength = $r->[RStrength]; + $saver = $s; + dbg("RBN: STRENGTH spot: $s->[SCall] qrg: $s->[SQrg] origin: $s->[SOrigin] dB: $r->[RStrength] < $strength") if isdbg 'rbnll'; + } + + if ($rf) { + my ($want, undef) = $rf->it($s); + 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'; + next unless $want; + $filtered = $s; +# last; + } + } + + if ($rf) { + $saver = $filtered; # if nothing passed the filter's lips then $saver == $filtered == undef ! + } + + if ($saver) { + my $buf; + # create a zone list of spotters + delete $zone{$saver->[SZone]}; # remove this spotter's zone (leaving all the other zones) + my $z = join ',', sort {$a <=> $b} keys %zone; + + # alter spot data accordingly + $saver->[SComment] .= " Z:$z" if $z; + + dbg("RBN: SENDING to $call spot: $saver->[SCall] qrg: $saver->[SQrg] origin: $saver->[SOrigin] $saver->[SComment]") if isdbg 'rbnll'; + if ($dxchan->{ve7cc}) { + my $call = $saver->[SOrigin]; + $saver->[SOrigin] .= '-#'; + $buf = VE7CC::dx_spot($dxchan, @$saver); + $saver->[SOrigin] = $call; + } else { + my $call = $saver->[SOrigin]; + $saver->[SOrigin] = substr($call, 0, 6); + $saver->[SOrigin] .= '-#'; + $buf = $dxchan->format_dx_spot(@$saver); + $saver->[SOrigin] = $call; + } +# $buf =~ s/^DX/RB/; + $dxchan->local_send('N', $buf); + + ++$self->{nospot}; + ++$self->{nospot10}; + ++$self->{nospothour}; + + if ($qra) { + my $user = DXUser::get_current($saver->[SCall]) || DXUser->new($saver->[SCall]); + unless ($user->qra && is_qra($user->qra)) { + $user->qra($qra); + dbg("RBN: update qra on $saver->[SCall] to $qra"); + $user->put; + } + } + } +} + +# per second +sub process +{ + foreach my $dxchan (DXChannel::get_all()) { + next unless $dxchan->is_rbn; + + # At this point we run the queue to see if anything can be sent onwards to the punter + my $now = $main::systime; + + # now run the waiting queue which just contains KEYS ($call|$qrg) + foreach my $sp (keys %{$dxchan->{queue}}) { + my $cand = $spots->{$sp}; + unless ($cand && $cand->[CTime]) { + dbg "RBN Cand $sp " . ($cand ? 'def' : 'undef') . " [CTime] " . ($cand->[CTime] ? 'def' : 'undef') . " dwell $dwelltime"; + next; + } + if ($now >= $cand->[CTime] + $dwelltime ) { + # we have a candidate, create qualitee value(s); + unless (@$cand > CData) { + dbg "RBN: QUEUE key '$sp' MISSING RECORDS, IGNORED" . dd($cand) if isdbg 'rbn'; + next; + } + dbg "RBN: QUEUE PROCESSING key: '$sp' $now >= $cand->[CTime]" if isdbg 'rbnqueue'; + my $quality = @$cand - CData; + $quality = 9 if $quality > 9; + $cand->[CQual] = $quality if $quality > $cand->[CQual]; + + my $r; + my %qrg; + foreach $r (@$cand) { + next unless ref $r; + ++$qrg{$r->[RQrg]}; + } + # determine the most likely qrg and then set it + my @deviant; + my $c = 0; + my $mv = 0; + my $qrg; + while (my ($k, $votes) = each %qrg) { + $qrg = $k, $mv = $votes if $votes > $mv; + ++$c; + } + # spit out the deviants + if ($c > 1) { + foreach $r (@$cand) { + next unless ref $r; + my $diff = nearest(.1, $qrg - $r->[RQrg]); + push @deviant, sprintf("$r->[ROrigin]:%+.1f", $diff) if $diff != 0; + $r->[RSpotData]->[SQrg] = $qrg; # set all the QRGs to the agreed value + } + } + + $qrg = sprintf "%.1f", $qrg; + $r = $cand->[CData]; + $r->[RQrg] = $qrg; + my $squality = "Q:$cand->[CQual]"; + $squality .= '*' if $c > 1; + $squality .= '+' if $r->[Respot]; + + if ($cand->[CQual] >= $minqual) { + if (isdbg('progress')) { + my $s = "RBN: SPOT key: '$sp' = $r->[RCall] on $r->[RQrg] by $r->[ROrigin] \@ $r->[RTime] $squality route: $dxchan->{call}"; + $s .= " Deviants: " . join(', ', sort @deviant) if @deviant; + dbg($s); + } + send_dx_spot($dxchan, $squality, $cand); + } elsif (isdbg('rbn')) { + my $s = "RBN: SPOT IGNORED(Q $cand->[CQual] < $minqual) key: '$sp' = $r->[RCall] on $r->[RQrg] by $r->[ROrigin] \@ $r->[RTime] $squality route: $dxchan->{call}"; + dbg($s); + } + + # clear out the data and make this now just "spotted", but no further action required until respot time + dbg "RBN: QUEUE key '$sp' cleared" if isdbg 'rbn'; + + $spots->{$sp} = [$now, $cand->[CQual]]; + delete $dxchan->{queue}->{$sp}; + } + else { + dbg sprintf("RBN: QUEUE key: '$sp' SEND time not yet reached %.1f secs left", $cand->[CTime] + $dwelltime - $now) if isdbg 'rbnqueue'; + } + } + } + +} + +sub per_minute +{ + foreach my $dxchan (DXChannel::get_all()) { + next unless $dxchan->is_rbn; + 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'); + if ($dxchan->{noraw} == 0 && $dxchan->{lasttime} > 60) { + LogDbg('RBN', "RBN: no input from $dxchan->{call}, disconnecting"); + $dxchan->disconnect; + } + $dxchan->{noraw} = $dxchan->{norbn} = $dxchan->{nospot} = 0; $dxchan->{nousers} = {}; + $runtime{$dxchan->{call}} += 60; + } + + # save the spot cache + write_cache() unless $main::systime + $startup_delay < $main::systime;; +} + +sub per_10_minute +{ + my $count = 0; + my $removed = 0; + while (my ($k,$cand) = each %{$spots}) { + next if $k eq 'VERSION'; + next if $k =~ /^O\|/; + + if ($main::systime - $cand->[CTime] > $minspottime*2) { + delete $spots->{$k}; + ++$removed; + } + else { + ++$count; + } + } + dbg "RBN:STATS spot cache remain: $count removed: $removed"; # if isdbg('rbn'); + foreach my $dxchan (DXChannel::get_all()) { + next unless $dxchan->is_rbn; + my $nq = keys %{$dxchan->{queue}}; + dbg "RBN:STATS 10-minute $dxchan->{call} queue: $nq raw: $dxchan->{noraw10} retrieved spots: $dxchan->{norbn10} delivered: $dxchan->{nospot10} after filtering to users: " . scalar keys %{$dxchan->{nousers10}}; + $dxchan->{noraw10} = $dxchan->{norbn10} = $dxchan->{nospot10} = 0; $dxchan->{nousers10} = {}; + } +} - $dxchan->send($line) if $want; +sub per_hour +{ + foreach my $dxchan (DXChannel::get_all()) { + next unless $dxchan->is_rbn; + my $nq = keys %{$dxchan->{queue}}; + dbg "RBN:STATS hour $dxchan->{call} queue: $nq raw: $dxchan->{norawhour} retrieved spots: $dxchan->{norbnhour} delivered: $dxchan->{nospothour} after filtering to users: " . scalar keys %{$dxchan->{nousershour}}; + $dxchan->{norawhour} = $dxchan->{norbnhour} = $dxchan->{nospothour} = 0; $dxchan->{nousershour} = {}; } } +sub finish +{ + write_cache(); +} + +sub write_cache +{ + my $fh = IO::File->new(">$cachefn") or confess("writing $cachefn $!"); + my $s = $json->encode($spots); + $fh->print($s); + $fh->close; +} + +sub check_cache +{ + if (-e $cachefn) { + my $mt = (stat($cachefn))[9]; + my $t = $main::systime - $mt || 1; + my $p = difft($mt, 2); + if ($t < $cache_valid) { + dbg("RBN:check_cache '$cachefn' spot cache exists, created $p ago and not too old"); + my $fh = IO::File->new($cachefn); + my $s; + if ($fh) { + local $/ = undef; + $s = <$fh>; + dbg("RBN:check_cache cache read size " . length $s); + $fh->close; + } else { + dbg("RBN:check_cache file read error $!"); + return undef; + } + if ($s) { + eval {$spots = $json->decode($s)}; + if ($spots && ref $spots) { + if (exists $spots->{VERSION} && $spots->{VERSION} == $DATA_VERSION) { + # now clean out anything that is current + while (my ($k, $cand) = each %$spots) { + next if $k eq 'VERSION'; + next if $k =~ /^O\|/; + if (@$cand > CData) { + $spots->{$k} = [$cand->[CTime], $cand->[CQual]]; + } + } + dbg("RBN:check_cache spot cache restored"); + return 1; + } + } + } + dbg("RBN::checkcache error decoding $@"); + } else { + my $d = difft($main::systime-$cache_valid); + dbg("RBN::checkcache '$cachefn' created $p ago is too old (> $d), ignored"); + } + } else { + dbg("RBN:check_cache '$cachefn' spot cache not present"); + } + + return undef; +} 1;