perl/RBN.pm

   1 #
   2 # The RBN connection system
   3 #
   4 # Copyright (c) 2020 Dirk Koopman G1TLH
   5 #
   6
   7 use warnings;
   8 use strict;
   9
  10 package RBN;
  11
  12 use 5.10.1;
  13
  14 use lib qw {.};
  15
  16 use DXDebug;
  17 use DXUtil;
  18 use DXLog;
  19 use DXUser;
  20 use DXChannel;
  21 use Math::Round qw(nearest);
  22 use Date::Parse;
  23 use Time::HiRes qw(gettimeofday);
  24 use Spot;
  25 use DXJSON;
  26 use IO::File;
  27
  28 use constant {
  29                           ROrigin => 0,
  30                           RQrg => 1,
  31                           RCall => 2,
  32                           RMode => 3,
  33                           RStrength => 4,
  34                           RTime => 5,
  35                           RUtz => 6,
  36                           Respot => 7,
  37                           RQra => 8,
  38                          };
  39
  40 # at least one whole spot per cache entry is necessary
  41 use constant {
  42                           SQrg => 0,
  43                           SCall => 1,
  44                           STime => 2,
  45                           SComment => 3,
  46                           SOrigin => 4,
  47                           SODxcc => 6,
  48                           SOItu => 8,
  49                           SOZone => 11,
  50                           SOState => 13,
  51                           SQra => 15,           # i.e. extra after the IP address
  52                          };
  53
  54
  55 # Standard Cache entries
  56 # key Spot|normalised freq
  57 use constant {
  58                           CTime => 0,           # time of latest spot in a tranch
  59                           CQual => 1,           # Qualitee
  60                           CSpot => 3,           # the Spot::Prepare data for this spot
  61                           CSkims => 3,          # the list of skimmers (hcalls) is [[...]...]
  62                          };
  63
  64
  65
  66 # key SK|<call>
  67 use constant {
  68                           SKTime =>0,           # last time seen
  69                           SKOffset => 1,
  70                           SKQual => 2,
  71                           SKSpot =>3,           # the Spot::Prepare data for this skimmer
  72                          };
  73
  74
  75 our $CACHE_VERSION = 2;
  76
  77 our @ISA = qw(DXChannel);
  78
  79 our $startup_delay = 5*60;              # don't send anything out until this timer has expired
  80                                 # this is to allow the feed to "warm up" with duplicates
  81                                 # so that the "big rush" doesn't happen.
  82
  83 our $minspottime = 60*60;               # the time between respots of a callsign - if a call is
  84                                 # still being spotted (on the same freq) and it has been
  85                                 # spotted before, it's spotted again after this time
  86                                 # until the next minspottime has passed.
  87
  88 our $beacontime = 5*60;                 # same as minspottime, but for beacons (and shorter)
  89
  90 our $dwelltime = 10;                    # the amount of time to wait for duplicates before issuing
  91                                 # a spot to the user (no doubt waiting with bated breath).
  92
  93 our $filterdef = $Spot::filterdef; # we use the same filter as the Spot system. Can't think why :-).
  94
  95 my $spots;                                              # the GLOBAL spot cache
  96
  97 my %runtime;                                    # how long each channel has been running
  98
  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
 101
 102 my $json;
 103 my $noinrush = 0;                               # override the inrushpreventor if set
 104
 105 sub init
 106 {
 107         $json = DXJSON->new;
 108         $spots = {};
 109         if (check_cache()) {
 110                 $noinrush = 1;
 111         }
 112         if (defined $DB::VERSION) {
 113                 $noinrush = 1;
 114                 $json->indent(1);
 115         }
 116 }
 117
 118 sub new
 119 {
 120         my $self = DXChannel::alloc(@_);
 121
 122         # routing, this must go out here to prevent race condx
 123         my $pkg = shift;
 124         my $call = shift;
 125
 126         $self->{last} = 0;
 127         $self->{noraw} = 0;
 128         $self->{nospot} = 0;
 129         $self->{nouser} = {};
 130         $self->{norbn} = 0;
 131         $self->{noraw10} = 0;
 132         $self->{nospot10} = 0;
 133         $self->{nouser10} = {};
 134         $self->{norbn10} = 0;
 135         $self->{nospothour} = 0;
 136         $self->{nouserhour} = {};
 137         $self->{norbnhour} = 0;
 138         $self->{norawhour} = 0;
 139         $self->{sort} = 'N';
 140         $self->{lasttime} = $main::systime;
 141         $self->{minspottime} = $minspottime;
 142         $self->{beacontime} = $beacontime;
 143         $self->{showstats} = 0;
 144         $self->{pingint} = 0;
 145         $self->{nopings} = 0;
 146
 147         return $self;
 148 }
 149
 150 sub start
 151 {
 152         my ($self, $line, $sort) = @_;
 153         my $user = $self->{user};
 154         my $call = $self->{call};
 155         my $name = $user->{name};
 156
 157         # log it
 158         my $host = $self->{conn}->peerhost;
 159         $host ||= "unknown";
 160         $self->{hostname} = $host;
 161
 162         $self->{name} = $name ? $name : $call;
 163         $self->state('prompt');         # a bit of room for further expansion, passwords etc
 164         $self->{lang} = $user->lang || $main::lang || 'en';
 165         if ($line =~ /host=/) {
 166                 my ($h) = $line =~ /host=(\d+\.\d+\.\d+\.\d+)/;
 167                 $line =~ s/\s*host=\d+\.\d+\.\d+\.\d+// if $h;
 168                 unless ($h) {
 169                         ($h) = $line =~ /host=([\da..fA..F:]+)/;
 170                         $line =~ s/\s*host=[\da..fA..F:]+// if $h;
 171                 }
 172                 if ($h) {
 173                         $h =~ s/^::ffff://;
 174                         $self->{hostname} = $h;
 175                 }
 176         }
 177         $self->{width} = 80 unless $self->{width} && $self->{width} > 80;
 178         $self->{consort} = $line;       # save the connection type
 179
 180         LogDbg('DXCommand', "$call connected from $self->{hostname}");
 181
 182         # set some necessary flags on the user if they are connecting
 183         $self->{registered} = 1;
 184         # sort out privilege reduction
 185         $self->{priv} = 0;
 186
 187         # get the filters
 188         my $nossid = $call;
 189         $nossid =~ s/-\d+$//;
 190
 191         $self->{inrbnfilter} = Filter::read_in('rbn', $call, 1)
 192                 || Filter::read_in('rbn', 'node_default', 1);
 193
 194         # clean up qra locators
 195         my $qra = $user->qra;
 196         $qra = undef if ($qra && !DXBearing::is_qra($qra));
 197         unless ($qra) {
 198                 my $lat = $user->lat;
 199                 my $long = $user->long;
 200                 $user->qra(DXBearing::lltoqra($lat, $long)) if (defined $lat && defined $long);
 201         }
 202
 203         # if we have been running and stopped for a while
 204         # if the cache is warm enough don't operate the inrush preventor
 205         $self->{inrushpreventor} = exists $runtime{$call} && $runtime{$call} > $startup_delay || $noinrush ?  0 : $main::systime + $startup_delay;
 206         dbg("RBN: noinrush: $noinrush, setting inrushpreventor on $self->{call} to $self->{inrushpreventor}");
 207 }
 208
 209 my @queue;                                              # the queue of spots ready to send
 210
 211 sub normal
 212 {
 213         my $self = shift;
 214         my $line = shift;
 215         my @ans;
 216 #       my $spots = $self->{spot};
 217
 218         # remove leading and trailing spaces
 219         chomp $line;
 220         $line =~ s/^\s*//;
 221         $line =~ s/\s*$//;
 222
 223         # add base RBN
 224
 225         my $tim = $main::systime;
 226
 227         # parse line
 228         dbg "RBN:RAW,$line" if isdbg('rbnraw');
 229         return unless $line=~/^DX\s+de/;
 230
 231         my (undef, undef, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t, $tx) = split /[:\s]+/, $line;
 232
 233         # fix up FT8 spots from 7001
 234         $t = $u, $u = '' if !$t && is_ztime($u);
 235         $t = $sort, $sort = '' if !$t && is_ztime($sort);
 236         my $qra = $spd, $spd = '' if is_qra($spd);
 237         $u = $qra if $qra;
 238
 239         # is this anything like a callsign?
 240         unless (is_callsign($call)) {
 241                 dbg("RBN: ERROR $call from $origin on $qrg is invalid, dumped");
 242                 return;
 243         }
 244
 245         $origin =~ s/\-(?:\d{1,2}\-)?\#$//; # get rid of all the crap we aren't interested in
 246
 247
 248         $sort ||= '';
 249         $tx ||= '';
 250         $qra ||= '';
 251     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');
 252
 253         ++$self->{noraw};
 254         ++$self->{noraw10};
 255         ++$self->{norawhour};
 256
 257         my $b;
 258
 259         if ($t || $tx) {
 260
 261                 # fix up times for things like 'NXDXF B' etc
 262                 if ($tx && is_ztime($t)) {
 263                         if (is_ztime($tx)) {
 264                                 $b = $t;
 265                                 $t = $tx;
 266                         } else {
 267                                 dbg "RBN:ERR,$line";
 268                                 return (0);
 269                         }
 270                 }
 271                 if ($sort && $sort eq 'NCDXF') {
 272                         $mode = 'DXF';
 273                         $t = $tx;
 274                 }
 275                 if ($sort && $sort eq 'BEACON') {
 276                         $mode = 'BCN';
 277                 }
 278                 if ($mode =~ /^PSK/) {
 279                         $mode = 'PSK';
 280                 }
 281                 if ($mode eq 'RTTY') {
 282                         $mode = 'RTT';
 283                 }
 284
 285                 # The main de-duping key is [call, $frequency], but we probe a bit around that frequency to find a
 286                 # range of concurrent frequencies that might be in play.
 287
 288                 # The key to this is deducing the true callsign by "majority voting" (the greater the number of spotters
 289         # the more effective this is) together with some lexical analsys probably in conjuction with DXSpider
 290                 # 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)
 291                 # and some heuristical "Kwalitee" rating given distance from the zone centres of spotter, recipient user
 292         # and spotted. A map can be generated once per user and spotter as they are essentially mostly static.
 293                 # The spotted will only get a coarse position unless other info is available. Programs that parse
 294                 # DX bulletins and the online data online databases could be be used and then cached.
 295
 296                 # Obviously users have to opt in to receiving RBN spots and other users will simply be passed over and
 297                 # ignored.
 298
 299                 # Clearly this will only work in the 'mojo' branch of DXSpider where it is possible to pass off external
 300                 # data requests to ephemeral or semi resident forked processes that do any grunt work and the main
 301                 # process to just the standard "message passing" which has been shown to be able to sustain over 5000
 302                 # per second (limited by the test program's output and network speed, rather than DXSpider's handling).
 303
 304                 my $nqrg = nearest(5, $qrg*10);  # normalised to nearest .5 Khz (but multipled by 10 to get an integer)
 305 #               my $nqrg = nearest_even($qrg);  # normalised to nearest Khz
 306                 my $sp = "$call|$nqrg";           # hopefully the skimmers will be calibrated at least this well!
 307                 my $spp = sprintf("$call|%d", $nqrg+1); # but, clearly, my hopes are rudely dashed
 308                 my $spm = sprintf("$call|%d", $nqrg-1); # in BOTH directions!
 309
 310                 # do we have it?
 311                 my $cand = $spots->{$sp};
 312                 $cand = $spots->{$spp}, $sp = $spp, dbg(qq{RBN: SPP using $spp for $sp}) if isdbg('rbn') && !$cand && exists $spots->{$spp};
 313                 $cand = $spots->{$spm}, $sp = $spm, dbg(qq{RBN: SPM using $spm for $sp}) if isdbg('rbn') && !$cand && exists $spots->{$spm};
 314
 315                 # if we have one and there is only one slot and that slot's time isn't expired for respot then return
 316                 my $respot = 0;
 317                 if ($cand && ref $cand) {
 318                         if (@$cand <= CEMPTY) {
 319                                 unless ($self->{minspottime} > 0 && $tim - $cand->[0] >= $self->{minspottime}) {
 320                                         dbg("RBN: key: '$sp' call: $call qrg: $qrg DUPE \@ ". atime(int $cand->[0])) if isdbg('rbn');
 321                                         return;
 322                                 }
 323
 324                                 dbg("RBN: key: '$sp' RESPOTTING call: $call qrg: $qrg last seen \@ ". atime(int $cand->[0])) if isdbg('rbn');
 325                                 undef $cand;    # it's about to be recreated (in one place)
 326                                 ++$respot;
 327                         }
 328
 329                         # otherwise we have a spot being built up at the moment
 330                 } elsif ($cand) {
 331                         dbg("RBN: key '$sp' = '$cand' not ref");
 332                         return;
 333                 }
 334
 335                 # here we either have an existing spot record buildup on the go, or we need to create the first one
 336                 unless ($cand) {
 337                         $spots->{$sp} = $cand = [$main::systime, 0, 0];
 338                         dbg("RBN: key: '$sp' call: $call qrg: $qrg NEW" . ($respot ? ' RESPOT' : '')) if isdbg('rbn');
 339                 }
 340
 341                 # add me to the display queue unless we are waiting for initial in rush to finish
 342                 return unless $noinrush || $self->{inrushpreventor} < $main::systime;
 343
 344                 # build up a new record and store it in the buildup
 345                 # deal with the unix time
 346                 my ($hh,$mm) = $t =~ /(\d\d)(\d\d)Z$/;
 347                 my $utz = $hh*3600 + $mm*60 + $main::systime_daystart; # possible issue with late spot from previous day
 348                 $utz -= 86400 if $utz > $tim+3600;                                         # too far ahead, drag it back one day
 349
 350                 # create record and add into the buildup
 351                 my $r = [$origin, nearest(.1, $qrg), $call, $mode, $s, $t, $utz, $respot, $u];
 352                 unless ($cand->[CSpot]) {
 353                         my @s = Spot::prepare($r->[RQrg], $r->[RCall], $r->[RUtz], '', $r->[ROrigin]);
 354                         if ($s[5] == 666) {
 355                                 dbg("RBN: ERROR invalid prefix/callsign $call from $origin-# on $qrg, dumped");
 356                                 return;
 357                         }
 358                         $cand->[CSpot] = \@s;
 359                 }
 360
 361                 if ($self->{inrbnfilter}) {
 362                         my ($want, undef) = $self->{inrbnfilter}->it($s);
 363                         return unless $want;
 364                 }
 365
 366                 # add/set up the skimmer record
 367                 my $skimkey = "SK|$origin";
 368                 my $skim = $spots->{$skimkey};
 369                 unless ($skim) {
 370                         my $ur = DXUser::get($origin);
 371                         $spots->{$skimkey} = [$main::systime, 0, 0, $s->[SODxcc], $s->[SOItu], $s->[SOZone], $s->[SOState], ($ur ? $ur->qra : undef) ];
 372                 }
 373
 374
 375
 376                 push @{$self->{queue}}, $sp if @$cand == 1; # queue the KEY (not the record)
 377
 378                 dbg("RBN: key: '$sp' ADD RECORD call: $call qrg: $qrg origin: $origin") if isdbg('rbn');
 379
 380                 push @$cand, $r;
 381
 382                 # At this point we run the queue to see if anything can be sent onwards to the punter
 383                 my $now = $main::systime;
 384
 385                 # now run the waiting queue which just contains KEYS ($call|$qrg)
 386                 foreach $sp (@{$self->{queue}}) {
 387                         my $cand = $spots->{$sp};
 388                         unless ($cand && $cand->[0]) {
 389                                 dbg "RBN Cand " . ($cand ? 'def' : 'undef') . " [0] " . ($cand->[0] ? 'def' : 'undef') . " dwell $dwelltime";
 390                                 next;
 391                         }
 392                         if ($now >= $cand->[CTime] + $dwelltime ) {
 393                                 # we have a candidate, create qualitee value(s);
 394                                 unless (@$cand > CEMPTY) {
 395                                         dbg "RBN: QUEUE key '$sp' MISSING RECORDS " . dd($cand) if isdbg 'rbn';
 396                                         shift @{$self->{queue}};
 397                                         next;
 398                                 }
 399                                 my $savedtime = shift @$cand; # save the start time
 400                                 my $r = $cand->[0];
 401                                 my $quality = @$cand;
 402                                 $quality = 9 if $quality > 9;
 403                                 $quality = "Q:$quality";
 404                                 if (isdbg('progress')) {
 405                                         my $s = "RBN: SPOT key: '$sp' = $r->[RCall] on $r->[RQrg] by $r->[ROrigin] \@ $r->[RTime] $quality";
 406                                         $s .=  " route: $self->{call}";
 407                                         dbg($s);
 408                                 }
 409
 410                                 send_dx_spot($self, $quality, $cand);
 411
 412                                 # clear out the data and make this now just "spotted", but no further action required until respot time
 413                                 dbg "RBN: QUEUE key '$sp' cleared" if isdbg 'rbn';
 414
 415                                 $spots->{$sp} = [$savedtime];
 416                                 shift @{$self->{queue}};
 417                         } else {
 418                                 dbg sprintf("RBN: QUEUE key: '$sp' SEND time not yet reached %.1f secs left", $cand->[0] + $dwelltime - $now) if isdbg 'rbnqueue';
 419                         }
 420                 }
 421         } else {
 422                 dbg "RBN:DATA,$line" if isdbg('rbn');
 423         }
 424 }
 425
 426 # we should get the spot record minus the time, so just an array of record (arrays)
 427 sub send_dx_spot
 428 {
 429         my $self = shift;
 430         my $quality = shift;
 431         my $cand = shift;
 432
 433         ++$self->{norbn};
 434         ++$self->{norbn10};
 435         ++$self->{norbnhour};
 436
 437         # $r = [$origin, $qrg, $call, $mode, $s, $utz, $respot];
 438
 439         my $mode = $cand->[0]->[3]; # as all the modes will be the same;
 440
 441         my @dxchan = DXChannel::get_all();
 442
 443         foreach my $dxchan (@dxchan) {
 444                 next unless $dxchan->is_user;
 445                 my $user = $dxchan->{user};
 446                 next unless $user &&  $user->wantrbn;
 447
 448                 # does this user want this sort of spot at all?
 449                 my $want = 0;
 450                 ++$want if $user->wantbeacon && $mode =~ /^BCN|DXF/;
 451                 ++$want if $user->wantcw && $mode =~ /^CW/;
 452                 ++$want if $user->wantrtty && $mode =~ /^RTT/;
 453                 ++$want if $user->wantpsk && $mode =~ /^PSK|FSK|MSK/;
 454                 ++$want if $user->wantft && $mode =~ /^FT/;
 455
 456                 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",
 457                                         $user->wantrbn,
 458                                         $user->wantft,
 459                                         $user->wantbeacon,
 460                                         $user->wantcw,
 461                                         $user->wantpsk,
 462                                         $user->wantrtty,
 463                                    )) if isdbg('rbnll');
 464
 465                 # send one spot to one user out of the ones that we have
 466                 $self->dx_spot($dxchan, $quality, $cand) if $want;
 467         }
 468 }
 469
 470 sub dx_spot
 471 {
 472         my $self = shift;
 473         my $dxchan = shift;
 474         my $quality = shift;
 475         my $cand = shift;
 476         my $call = $dxchan->{call};
 477
 478
 479         my $strength = 100;             # because it could if we talk about FTx
 480         my $saver;
 481
 482         my %zone;
 483         my %qrg;
 484         my $respot;
 485         my $qra;
 486
 487         ++$self->{nousers}->{$call};
 488         ++$self->{nousers10}->{$call};
 489         ++$self->{nousershour}->{$call};
 490
 491         my $filtered;
 492         my $rf = $dxchan->{rbnfilter} || $dxchan->{spotsfilter};
 493         foreach my $r (@$cand) {
 494                 # $r = [$origin, $qrg, $call, $mode, $s, $t, $utz, $respot, $qra];
 495                 # Spot::prepare($qrg, $call, $utz, $comment, $origin);
 496
 497                 my $comment = sprintf "%-3s %2ddB $quality", $r->[RMode], $r->[RStrength];
 498                 $respot = 1 if $r->[Respot];
 499                 $qra = $r->[RQra] if !$qra && $r->[RQra] && is_qra($r->[RQra]);
 500
 501                 my $s = $r->[RSpotData];                # the prepared spot
 502                 $s->[SComment] = $comment;              # apply new generated comment
 503
 504
 505                 ++$zone{$s->[SZone]};           # save the spotter's zone
 506                 ++$qrg{$s->[SQrg]};             # and the qrg
 507
 508
 509                 # save the lowest strength one
 510                 if ($r->[RStrength] < $strength) {
 511                         $strength = $r->[RStrength];
 512                         $saver = $s;
 513                         dbg("RBN: STRENGTH spot: $s->[SCall] qrg: $s->[SQrg] origin: $s->[SOrigin] dB: $r->[RStrength] < $strength") if isdbg 'rbnll';
 514                 }
 515
 516                 if ($rf && !$want) {
 517                         my ($want, undef) = $rf->it($s);
 518                         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';
 519                         next unless $want;
 520                         $filtered = $s;
 521 #                       last;
 522                 }
 523         }
 524
 525         if ($rf) {
 526                 $saver = $filtered;             # if nothing passed the filter's lips then $saver == $filtered == undef !
 527         }
 528
 529         if ($saver) {
 530                 my $buf;
 531                 # create a zone list of spotters
 532                 delete $zone{$saver->[SZone]};  # remove this spotter's zone (leaving all the other zones)
 533                 my $z = join ',', sort {$a <=> $b} keys %zone;
 534
 535                 # determine the most likely qrg and then set it
 536                 my $mv = 0;
 537                 my $fk;
 538                 my $c = 0;
 539                 while (my ($k, $v) = each %qrg) {
 540                         $fk = $k, $mv = $v if $v > $mv;
 541                         ++$c;
 542                 }
 543                 $saver->[SQrg] = $fk;
 544                 $saver->[SComment] .= '*' if $c > 1;
 545                 $saver->[SComment] .= '+' if $respot;
 546                 $saver->[SComment] .= " Z:$z" if $z;
 547
 548                 dbg("RBN: SENDING to $call spot: $saver->[SCall] qrg: $saver->[SQrg] origin: $saver->[SOrigin] $saver->[SComment]") if isdbg 'rbnll';
 549                 if ($dxchan->{ve7cc}) {
 550                         my $call = $saver->[SOrigin];
 551                         $saver->[SOrigin] .= '-#';
 552                         $buf = VE7CC::dx_spot($dxchan, @$saver);
 553                         $saver->[SOrigin] = $call;
 554                 } else {
 555                         my $call = $saver->[SOrigin];
 556                         $saver->[SOrigin] = substr($call, 0, 6);
 557                         $saver->[SOrigin] .= '-#';
 558                         $buf = $dxchan->format_dx_spot(@$saver);
 559                         $saver->[SOrigin] = $call;
 560                 }
 561 #               $buf =~ s/^DX/RB/;
 562                 $dxchan->local_send('N', $buf);
 563
 564                 ++$self->{nospot};
 565                 ++$self->{nospot10};
 566                 ++$self->{nospothour};
 567
 568                 if ($qra) {
 569                         my $user = DXUser::get_current($saver->[SCall]) || DXUser->new($saver->[SCall]);
 570                         unless ($user->qra && is_qra($user->qra)) {
 571                                 $user->qra($qra);
 572                                 dbg("RBN: update qra on $saver->[SCall] to $qra");
 573                                 $user->put;
 574                         }
 575                 }
 576         }
 577 }
 578
 579
 580 sub per_minute
 581 {
 582         foreach my $dxchan (DXChannel::get_all()) {
 583                 next unless $dxchan->is_rbn;
 584                 dbg "RBN:STATS minute $dxchan->{call} raw: $dxchan->{noraw} sent: $dxchan->{norbn} delivered: $dxchan->{nospot} users: " . scalar keys %{$dxchan->{nousers}} if isdbg('rbnstats');
 585                 if ($dxchan->{noraw} == 0 && $dxchan->{lasttime} > 60) {
 586                         LogDbg('RBN', "RBN: no input from $dxchan->{call}, disconnecting");
 587                         $dxchan->disconnect;
 588                 }
 589                 $dxchan->{noraw} = $dxchan->{norbn} = $dxchan->{nospot} = 0; $dxchan->{nousers} = {};
 590                 $runtime{$dxchan->{call}} += 60;
 591         }
 592
 593         # save the spot cache
 594         write_cache() unless $main::systime + $startup_delay < $main::systime;;
 595 }
 596
 597 sub per_10_minute
 598 {
 599         my $count = 0;
 600         my $removed = 0;
 601         while (my ($k,$v) = each %{$spots}) {
 602                 if ($main::systime - $v->[0] > $minspottime*2) {
 603                         delete $spots->{$k};
 604                         ++$removed;
 605                 }
 606                 else {
 607                         ++$count;
 608                 }
 609         }
 610         dbg "RBN:STATS spot cache remain: $count removed: $removed"; # if isdbg('rbn');
 611         foreach my $dxchan (DXChannel::get_all()) {
 612                 next unless $dxchan->is_rbn;
 613                 dbg "RBN:STATS 10-minute $dxchan->{call} raw: $dxchan->{noraw10} sent: $dxchan->{norbn10} delivered: $dxchan->{nospot10} users: " . scalar keys %{$dxchan->{nousers10}};
 614                 $dxchan->{noraw10} = $dxchan->{norbn10} = $dxchan->{nospot10} = 0; $dxchan->{nousers10} = {};
 615         }
 616 }
 617
 618 sub per_hour
 619 {
 620         foreach my $dxchan (DXChannel::get_all()) {
 621                 next unless $dxchan->is_rbn;
 622                 dbg "RBN:STATS hour $dxchan->{call} raw: $dxchan->{norawhour} sent: $dxchan->{norbnhour} delivered: $dxchan->{nospothour} users: " . scalar keys %{$dxchan->{nousershour}};
 623                 $dxchan->{norawhour} = $dxchan->{norbnhour} = $dxchan->{nospothour} = 0; $dxchan->{nousershour} = {};
 624         }
 625 }
 626
 627 sub finish
 628 {
 629         write_cache();
 630 }
 631
 632 sub write_cache
 633 {
 634         my $fh = IO::File->new(">$cachefn") or confess("writing $cachefn $!");
 635         $spots->{version} = $CACHE_VERSION;
 636         my $s = $json->encode($spots);
 637         $fh->print($s);
 638         $fh->close;
 639 }
 640
 641 sub check_cache
 642 {
 643         if (-e $cachefn) {
 644                 my $mt = (stat($cachefn))[9];
 645                 my $t = $main::systime - $mt || 1;
 646                 my $p = difft($mt);
 647                 if ($t < $cache_valid) {
 648                         dbg("RBN:check_cache '$cachefn' spot cache exists, created $p ago and not too old");
 649                         my $fh = IO::File->new($cachefn);
 650                         my $s;
 651                         if ($fh) {
 652                                 local $/ = undef;
 653                                 $s = <$fh>;
 654                                 dbg("RBN:check_cache cache read size " . length $s);
 655                                 $fh->close;
 656                         } else {
 657                                 dbg("RBN:check_cache file read error $!");
 658                                 return undef;
 659                         }
 660                         if ($s) {
 661                                 eval {$spots = $json->decode($s)};
 662                                 if ($spots && ref $spots) {
 663                                         my $version = $spots->{version} || 0;
 664                                         unless ($version != $CACHE_VERSION) {
 665                                                 # wrong version number
 666                                                 dbg("RBN:check_cache version number mismatch got: $version want: $CACHE_VERSION, reseting");
 667                                                 $spots = {};
 668                                                 return undef;
 669                                         }
 670                                         dbg("RBN:check_cache spot cache restored");
 671                                         return 1;
 672                                 }
 673                         }
 674                         dbg("RBN::checkcache error decoding $@");
 675                 } else {
 676                         my $d = difft($main::systime-$cache_valid);
 677                         dbg("RBN::checkcache '$cachefn' created $p ago is too old (> $d), ignored");
 678                 }
 679         } else {
 680                 dbg("RBN:check_cache '$cachefn' spot cache not present");
 681         }
 682
 683         return undef;
 684 }
 685
 686 1;