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