Added extra flags to rbn.pl
authorDirk Koopman <djk@tobit.co.uk>
Mon, 2 Jan 2017 23:10:22 +0000 (23:10 +0000)
committerDirk Koopman <djk@tobit.co.uk>
Mon, 2 Jan 2017 23:10:22 +0000 (23:10 +0000)
any of /^cw|rtty|psk|beacon/ will enable only these types of spots
stats will print a STATS,<raw RBN spots>,<deduped RBN spots>,<spots>

perl/rbn.pl

index 0c966473230459bf329032890bfe21e291b5b750..e6c65844fc40b2534578cd7ab6811be5f30143ac 100755 (executable)
@@ -12,19 +12,34 @@ use Math::Round qw(nearest);
 
 my $host = 'telnet.reversebeacon.net';
 my $port = 7000;
-my $mycall = shift or die "usage:rbn.pl <callsign> [debug] [<time between repeat spots in minutes>]\n"; 
+my $mycall = shift or die "usage:rbn.pl <callsign> [debug] [stats] [cw] [rtty] [psk] [beacon] [<time between repeat spots in minutes>]\n"; 
 
-my $minspottime = 15*60;               # minimum length of time between successive spots
+my $minspottime = 30*60;               # minimum length of time between successive spots
+my $showstats;                                 # show RBN and Spot stats
 
 my $attempts;
 my $sock;
 my $dbg;
-
+my $wantcw = 1;
+my $wantrtty = 1;
+my $wantpsk = 1;
+my $wantbeacon = 1;
+my $override; 
+       
 while (@ARGV) {
        my $arg = shift;
 
        ++$dbg if $arg =~ /^deb/i;
+       ++$showstats if $arg =~ /^stat/i;
        $minspottime = $arg * 60 if $arg =~ /^\d+$/;
+       if (!$override && $arg =~ /^cw|rtty|psk|beacon$/i) {
+               $override = 1;
+               $wantcw = $wantrtty = $wantpsk = $wantbeacon = 0;
+       }
+       ++$wantcw if $arg =~ /^cw$/i;
+       ++$wantpsk if $arg =~ /^psk$/i;
+       ++$wantrtty if $arg =~ /^rtty$/i;
+       ++$wantbeacon if $arg =~ /^beacon$/i;
 }
 
 for ($attempts = 1; $attempts <= 5; ++$attempts) {
@@ -45,11 +60,45 @@ say "admin,call sent" if $dbg;
 my %d;
 my %spot;
 
-my $last = time;
+my $last = 0;
+my $noraw = 0;
+my $norbn = 0;
+my $nospot = 0;
 
 while (<$sock>) {
        chomp;
        my $tim = time;
+       
+       # periodic clearing out of the two caches
+       if ($tim % 60 == 0 && $last != $tim) {
+               my $count = 0;
+               my $removed = 0;
+               
+               while (my ($k,$v) = each %d) {
+                       if ($tim-$v > 60) {
+                               delete $d{$k};
+                               ++$removed
+                       } else {
+                               ++$count;
+                       }
+               }
+               say "admin,rbn cache: $removed removed $count remain" if $dbg;
+               $count = $removed = 0;
+               while (my ($k,$v) = each %spot) {
+                       if ($tim-$v > $minspottime*2) {
+                               delete $spot{$k};
+                               ++$removed;
+                       } else {
+                               ++$count;
+                       }
+               }
+               say "admin,spot cache: $removed removed $count remain" if $dbg;
+
+               say join(',', "STAT", $noraw, $norbn, $nospot) if $showstats;
+               $noraw = $norbn = $nospot = 0;
+
+               $last = $tim;
+       }
 
        # parse line
        my (undef, undef, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t) = split /[:\s]+/;
@@ -59,10 +108,12 @@ while (<$sock>) {
                # This works because the skimmers are NTP controlled (or should be) and will receive
                # the spot at the same time (velocity factor of the atmosphere taken into account :-)
                my $p = "$t|$call";
+               ++$noraw;
                next if $d{$p};
 
                # new RBN input
                $d{$p} = $tim;
+               ++$norbn;
                $qrg = sprintf('%.1f', nearest(.1, $qrg));     # to nearest 100Hz (to catch the odd multiple decpl QRG [eg '7002.07']).
                say join(',', "RBN", $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t) if $dbg;
 
@@ -72,7 +123,17 @@ while (<$sock>) {
                my $nqrg = nearest(1, $qrg);  # normalised to nearest Khz
                my $sp = "$call|$nqrg";           # hopefully the skimmers will be calibrated at least this well! 
                my $ts = $spot{$sp};
+               
                if (!$ts || $tim - $ts >= $minspottime) {
+                       if ($wantbeacon && $sort =~ /^BEA/) {
+                               ;
+                       } else {
+                               next if !$wantcw  && $mode =~ /^CW/;
+                               next if !$wantrtty && $mode =~ /^RTTY/;
+                               next if !$wantpsk && $mode =~ /^PSK/;
+                       }
+
+                       ++$nospot;
                        my $tag = $ts ? "RESPOT" : "SPOT";
                        say join(',', $tag, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t);
                        $spot{$sp} = $tim;
@@ -80,33 +141,6 @@ while (<$sock>) {
        } else {
                say "data,$_" if $dbg;
        }
-
-       # periodic clearing out of the two caches
-       if ($tim > $last+60) {
-               my $count = 0;
-               my $removed = 0;
-               
-               while (my ($k,$v) = each %d) {
-                       if ($tim-$v > 60) {
-                               delete $d{$k};
-                               ++$removed
-                       } else {
-                               ++$count;
-                       }
-               }
-               say "admin,rbn cache: $removed removed $count remain" if $dbg;
-               $count = $removed = 0;
-               while (my ($k,$v) = each %spot) {
-                       if ($tim-$v > $minspottime*2) {
-                               delete $spot{$k};
-                               ++$removed;
-                       } else {
-                               ++$count;
-                       }
-               }
-               say "admin,spot cache: $removed removed $count remain" if $dbg;
-               $last = $tim;
-       }
 }