]> gb7djk.dxcluster.net Git - spider.git/blob - perl/rbn.pl
29508626b84e4921913ff873e671ac1f6e2616f7
[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 $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