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