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