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