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 use Getopt::Long;
  13 use Pod::Usage;
  14
  15 my $host = 'telnet.reversebeacon.net';
  16 my $port = 7000;
  17
  18 my $minspottime = 60*60;                # minimum length of time between successive identical spots
  19 my $showstats;                                  # show RBN and Spot stats
  20
  21 my $attempts;
  22 my $sock;
  23 my $dbg;
  24 my $wantcw = 1;
  25 my $wantrtty = 1;
  26 my $wantpsk = 1;
  27 my $wantbeacon = 1;
  28 my $wantdx = 1;
  29 my $wantraw = 0;
  30 my $showrbn;
  31 my $help = 0;
  32 my $man = 0;
  33 my $mycall;
  34
  35 #Getopt::Long::Configure( qw(auto_abbrev) );
  36 GetOptions('host=s' => \$host,
  37                    'port=i' => \$port,
  38                    'debug' => \$dbg,
  39                    'rbn' => \$showrbn,
  40                    'stats' => \$showstats,
  41                    'raw' => \$wantraw,
  42                    'repeattime|rt=i' => sub { $minspottime = $_[1] * 60 },
  43                    'want=s' => sub {
  44                            my ($name, $value) = @_;
  45                            $wantcw = $wantrtty = $wantpsk = $wantbeacon = $wantdx = 0;
  46                            for (split /[:,\|]/, $value) {
  47                                    ++$wantcw if /^cw$/i;
  48                                    ++$wantpsk if /^psk$/i;
  49                                    ++$wantrtty if /^rtty$/i;
  50                                    ++$wantbeacon if /^beacon$/i;
  51                                    ++$wantdx if /^dx$/i;
  52                            }
  53                    },
  54                    'help|?' => \$help,
  55                    'man' => \$man,
  56                    '<>' => sub { $mycall = shift },
  57                   ) or pod2usage(2);
  58
  59 $mycall ||= shift;
  60
  61 pod2usage(1) if $help || !$mycall;
  62 pod2usage(-exitval => 0, -verbose => 2) if $man;
  63
  64
  65 for ($attempts = 1; $attempts <= 5; ++$attempts) {
  66         say "ADMIN,connecting to $host $port.. (attempt $attempts) " if $dbg;
  67         $sock = IO::Socket::IP->new(
  68                                                                 PeerHost => $host,
  69                                                                 PeerPort => $port,
  70                                                                 Timeout => 2,
  71                                                            );
  72         last if $sock;
  73 }
  74
  75 die "ADMIN,Cannot connect to $host:$port after 5 attempts $!" unless $sock;
  76 say "ADMIN,connected" if $dbg;
  77 print $sock "$mycall\r\n";
  78 say "ADMIN,call sent" if $dbg;
  79
  80 my %d;
  81 my %spot;
  82
  83 my $last = 0;
  84 my $noraw = 0;
  85 my $norbn = 0;
  86 my $nospot = 0;
  87
  88 while (<$sock>) {
  89         chomp;
  90         my $tim = time;
  91
  92         # parse line
  93         say "RAW,$_" if $wantraw;
  94
  95         my (undef, undef, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t, $tx) = split /[:\s]+/;
  96         if ($t || $tx) {
  97
  98                 # We have an RBN data line, dedupe it very simply on time, ignore QRG completely.
  99                 # This works because the skimmers are NTP controlled (or should be) and will receive
 100                 # the spot at the same time (velocity factor of the atmosphere taken into account :-)
 101                 my $p = "$t|$call";
 102                 ++$noraw;
 103                 next if $d{$p};
 104
 105                 # fix up times for things like 'NXDXF B' etc
 106                 if ($tx && $t != /^\d{4}Z$/) {
 107                         if ($tx =~ /^\d{4}Z$/) {
 108                                 $t = $tx;
 109                         } else {
 110                                 say "ERR,$_";
 111                                 next;
 112                         }
 113                 }
 114
 115                 # new RBN input
 116                 $d{$p} = $tim;
 117                 ++$norbn;
 118                 $qrg = sprintf('%.1f', nearest(.1, $qrg));     # to nearest 100Hz (to catch the odd multiple decpl QRG [eg '7002.07']).
 119                 say join(',', "RBN", $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t) if !$wantraw && ($dbg || $showrbn);
 120
 121                 # Determine whether to "SPOT" it based on whether we have not seen it before (near this QRG) or,
 122                 # if we have, has it been a "while" since the last time we spotted it? If it has been spotted
 123                 # before then "RESPOT" it.
 124                 my $nqrg = nearest(1, $qrg);  # normalised to nearest Khz
 125                 my $sp = "$call|$nqrg";           # hopefully the skimmers will be calibrated at least this well!
 126                 my $ts = $spot{$sp};
 127
 128                 if (!$ts || ($minspottime > 0 && $tim - $ts >= $minspottime)) {
 129                         if ($wantbeacon && $sort =~ /^BEA/) {
 130                                 ;
 131                         } else {
 132                                 # Haven't used a perl 'goto' like this ever!
 133                                 # Clearly I need to use an event driven framework :-)
 134                                 goto periodic if !$wantcw  && $mode =~ /^CW/;
 135                                 goto periodic if !$wantrtty && $mode =~ /^RTTY/;
 136                                 goto periodic if !$wantpsk && $mode =~ /^PSK/;
 137                                 goto periodic if !$wantdx && $mode =~ /^DX/;
 138                         }
 139
 140                         ++$nospot;
 141                         my $tag = $ts ? "RESPOT" : "SPOT";
 142                         say join(',', $tag, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t);
 143                         $spot{$sp} = $tim;
 144                 }
 145         } else {
 146                 say "DATA,$_" if $dbg && !$wantraw;
 147         }
 148
 149  periodic:
 150         # periodic clearing out of the two caches
 151         if (($tim % 60 == 0 && $tim > $last) || ($last && $tim >= $last + 60)) {
 152                 my $count = 0;
 153                 my $removed = 0;
 154
 155                 while (my ($k,$v) = each %d) {
 156                         if ($tim-$v > 60) {
 157                                 delete $d{$k};
 158                                 ++$removed
 159                         } else {
 160                                 ++$count;
 161                         }
 162                 }
 163                 say "ADMIN,rbn cache: $removed removed $count remain" if $dbg;
 164                 $count = $removed = 0;
 165                 while (my ($k,$v) = each %spot) {
 166                         if ($tim-$v > $minspottime*2) {
 167                                 delete $spot{$k};
 168                                 ++$removed;
 169                         } else {
 170                                 ++$count;
 171                         }
 172                 }
 173                 say "ADMIN,spot cache: $removed removed $count remain" if $dbg;
 174
 175                 say join(',', "STAT", $noraw, $norbn, $nospot) if $showstats;
 176                 $noraw = $norbn = $nospot = 0;
 177
 178                 $last = int($tim / 60) * 60;
 179         }
 180 }
 181
 182
 183 close $sock;
 184 exit 0;
 185
 186 __END__
 187
 188 =head1 NAME
 189
 190 rbn.pl - an experimental RBN filter program that
 191
 192 =head1 SYNOPSIS
 193
 194 rbn.pl [options] <your callsign>
 195
 196 =head1 OPTIONS
 197
 198 =over 8
 199
 200 =item B<-help>
 201
 202 Print a brief help message and exits.
 203
 204 =item B<-man>
 205
 206 Prints the manual page and exits.
 207
 208 =item B<-host>=telnet.reversebeacon.net
 209
 210 As default, this program will connect to C<telnet.reversebeacon.net>. Use this argument to change that.
 211
 212 =item B<-port>=7000
 213
 214 As default, this program will connect to port 7000. Use this argument to change that to some other port.
 215
 216 =item B<-want>=cw,rtty,psk,beacon,dx
 217
 218 The program will print all spots in all classes in the 'mode' column [cw, rtty, psk, beacon, dx]. You can choose one or more of
 219 these classes if you want specific types of spots.
 220
 221 =item B<-stats>
 222
 223 Print a comma separated line of statistics once a minute which consists of:
 224
 225 STAT,E<lt>raw RBN spotsE<gt>,E<lt>de-duped RBN spotsE<gt>,E<lt>new spotsE<gt>
 226
 227 =item B<-repeattime=60>
 228
 229 A cache of callsigns and QRGs is kept. If a SPOT comes in after B<repeattime> minutes then it re-emitted
 230 but with a RESPOT tag instead. Set this argument to 0 (or less) if you do not want any repeats.
 231
 232 =item B<-rbn>
 233
 234 Show the de-duplicated RBN lines as they come in.
 235
 236 =item B<-raw>
 237
 238 Show the raw RBN lines as they come in.
 239
 240 =back
 241
 242 =head1 DESCRIPTION
 243
 244 B<This program> connects (as default) to RBN C<telnet.reversebeacon.net:7000> and parses the raw output
 245 which it deduplicates and then outputs unique spots. It is possible to select one or more types of spot.
 246
 247 The output is the RBN spot line which has been separated out into a comma separated list. One line per spot.
 248
 249 Like this:
 250
 251   SPOT,DK3UA-#,3560.0,DL6ZB,CW,27,dB,26,WPM,CQ,2152Z
 252   SPOT,WB6BEE-#,14063.0,KD6SX,CW,24,dB,15,WPM,CQ,2152Z
 253   RESPOT,S50ARX-#,1811.5,OM0CS,CW,37,dB,19,WPM,CQ,2152Z
 254   SPOT,DF4UE-#,3505.0,TA1PT,CW,11,dB,23,WPM,CQ,2152Z
 255   SPOT,AA4VV-#,14031.0,TF3Y,CW,16,dB,22,WPM,CQ,2152Z
 256   SPOT,SK3W-#,3600.0,OK0EN,CW,13,dB,11,WPM,BEACON,2152Z
 257   STAT,263,64,27
 258
 259 If the -raw flag is set then these lines will be interspersed with the raw line from the RBN source, prefixed
 260 with "RAW,". For example:
 261
 262   RAW,DX de PJ2A-#:    14025.4  IP0TRC         CW    16 dB  31 WPM  CQ      1307Z
 263   RAW,DX de PJ2A-#:    10118.9  K1JD           CW     2 dB  28 WPM  CQ      1307Z
 264   RAW,DX de K2PO-#:     1823.4  HL5IV          CW     8 dB  22 WPM  CQ      1307Z
 265   SPOT,K2PO-#,1823.4,HL5IV,CW,8,dB,22,WPM,CQ,1307Z
 266   RAW,DX de LZ7AA-#:   14036.6  HA8GZ          CW     7 dB  27 WPM  CQ      1307Z
 267   RAW,DX de DF4UE-#:   14012.0  R7KM           CW    32 dB  33 WPM  CQ      1307Z
 268   RAW,DX de G7SOZ-#:   14012.2  R7KM           CW    17 dB  31 WPM  CQ      1307Z
 269
 270
 271 =cut
 272