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