]> www.dxcluster.org Git - spider.git/blob - perl/rbn.pl
Merge branch 'mojo' of ssh://server/scm/spider into mojo
[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 $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