perl/rbn.pl

   1 #!/usr/bin/perl
   2 #
   3 # An RBN deduping filter
   4 #
   5 # Copyright (c) 2017 Dirk Koopman G1TLH
   6 #
   7
   8 use strict;
   9 use 5.10.1;
  10 use IO::Socket::IP -register;
  11 use Math::Round qw(nearest);
  12
  13 my $host = 'telnet.reversebeacon.net';
  14 my $port = 7000;
  15 my $mycall = shift or die "usage:rbn.pl <callsign> [debug] [stats] [cw] [rtty] [psk] [beacon] [<time between repeat spots in minutes>] [rbn]\n";
  16
  17 my $minspottime = 30*60;                # minimum length of time between successive spots
  18 my $showstats;                                  # show RBN and Spot stats
  19
  20 my $attempts;
  21 my $sock;
  22 my $dbg;
  23 my $wantcw = 1;
  24 my $wantrtty = 1;
  25 my $wantpsk = 1;
  26 my $wantbeacon = 1;
  27 my $override;
  28 my $showrbn;
  29
  30 while (@ARGV) {
  31         my $arg = shift;
  32
  33         ++$dbg if $arg =~ /^deb/i;
  34         ++$showstats if $arg =~ /^stat/i;
  35         ++$showrbn if $arg =~ /^rbn/i;
  36         $minspottime = $arg * 60 if $arg =~ /^\d+$/;
  37         if (!$override && $arg =~ /^cw|rtty|psk|beacon$/i) {
  38                 $override = 1;
  39                 $wantcw = $wantrtty = $wantpsk = $wantbeacon = 0;
  40         }
  41         ++$wantcw if $arg =~ /^cw$/i;
  42         ++$wantpsk if $arg =~ /^psk$/i;
  43         ++$wantrtty if $arg =~ /^rtty$/i;
  44         ++$wantbeacon if $arg =~ /^beacon$/i;
  45 }
  46
  47 for ($attempts = 1; $attempts <= 5; ++$attempts) {
  48         say "admin,connecting to $host $port.. (attempt $attempts) " if $dbg;
  49         $sock = IO::Socket::IP->new(
  50                                                                 PeerHost => $host,
  51                                                                 PeerPort => $port,
  52                                                                 Timeout => 2,
  53                                                            );
  54         last if $sock;
  55 }
  56
  57 die "admin,Cannot connect to $host:$port after 5 attempts $!" unless $sock;
  58 say "admin,connected" if $dbg;
  59 print $sock "$mycall\r\n";
  60 say "admin,call sent" if $dbg;
  61
  62 my %d;
  63 my %spot;
  64
  65 my $last = 0;
  66 my $noraw = 0;
  67 my $norbn = 0;
  68 my $nospot = 0;
  69
  70 while (<$sock>) {
  71         chomp;
  72         my $tim = time;
  73
  74         # parse line
  75         my (undef, undef, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t) = split /[:\s]+/;
  76         if ($t) {
  77
  78                 # We have an RBN data line, dedupe it very simply on time, ignore QRG completely.
  79                 # This works because the skimmers are NTP controlled (or should be) and will receive
  80                 # the spot at the same time (velocity factor of the atmosphere taken into account :-)
  81                 my $p = "$t|$call";
  82                 ++$noraw;
  83                 next if $d{$p};
  84
  85                 # new RBN input
  86                 $d{$p} = $tim;
  87                 ++$norbn;
  88                 $qrg = sprintf('%.1f', nearest(.1, $qrg));     # to nearest 100Hz (to catch the odd multiple decpl QRG [eg '7002.07']).
  89                 say join(',', "RBN", $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t) if $dbg || $showrbn;
  90
  91                 # Determine whether to "SPOT" it based on whether we have not seen it before (near this QRG) or,
  92                 # if we have, has it been a "while" since the last time we spotted it? If it has been spotted
  93                 # before then "RESPOT" it.
  94                 my $nqrg = nearest(1, $qrg);  # normalised to nearest Khz
  95                 my $sp = "$call|$nqrg";           # hopefully the skimmers will be calibrated at least this well!
  96                 my $ts = $spot{$sp};
  97
  98                 if (!$ts || $tim - $ts >= $minspottime) {
  99                         if ($wantbeacon && $sort =~ /^BEA/) {
 100                                 ;
 101                         } else {
 102                                 # Haven't used a perl 'goto' like this ever!
 103                                 # Clearly I need to use an event driven framework :-)
 104                                 goto periodic if !$wantcw  && $mode =~ /^CW/;
 105                                 goto periodic if !$wantrtty && $mode =~ /^RTTY/;
 106                                 goto periodic if !$wantpsk && $mode =~ /^PSK/;
 107                         }
 108
 109                         ++$nospot;
 110                         my $tag = $ts ? "RESPOT" : "SPOT";
 111                         say join(',', $tag, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t);
 112                         $spot{$sp} = $tim;
 113                 }
 114         } else {
 115                 say "data,$_" if $dbg;
 116         }
 117
 118  periodic:
 119         # periodic clearing out of the two caches
 120         if (($tim % 60 == 0 && $tim > $last) || ($last && $tim >= $last + 60)) {
 121                 my $count = 0;
 122                 my $removed = 0;
 123
 124                 while (my ($k,$v) = each %d) {
 125                         if ($tim-$v > 60) {
 126                                 delete $d{$k};
 127                                 ++$removed
 128                         } else {
 129                                 ++$count;
 130                         }
 131                 }
 132                 say "admin,rbn cache: $removed removed $count remain" if $dbg;
 133                 $count = $removed = 0;
 134                 while (my ($k,$v) = each %spot) {
 135                         if ($tim-$v > $minspottime*2) {
 136                                 delete $spot{$k};
 137                                 ++$removed;
 138                         } else {
 139                                 ++$count;
 140                         }
 141                 }
 142                 say "admin,spot cache: $removed removed $count remain" if $dbg;
 143
 144                 say join(',', "STAT", $noraw, $norbn, $nospot) if $showstats;
 145                 $noraw = $norbn = $nospot = 0;
 146
 147                 $last = int($tim / 60) * 60;
 148         }
 149 }
 150
 151
 152 close $sock;
 153 exit 0;