add an RBN line to progress

[spider.git] / perl / rbn.pl

diff --git a/perl/rbn.pl b/perl/rbn.pl
index ee8f0ed3b2852753f01413dab09badcb25e5519c..8fb0bd5d0e1c0c177e0d728b785dc494a0ee30c4 100755 (executable)
--- a/perl/rbn.pl
+++ b/perl/rbn.pl
@@ -26,6 +26,8 @@ my $wantrtty = 1;
 my $wantpsk = 1;
 my $wantbeacon = 1;
 my $wantdx = 1;
 my $wantpsk = 1;
 my $wantbeacon = 1;
 my $wantdx = 1;

+my $wantft = 1;
+my $wantpsk = 1;

 my $wantraw = 0;
 my $showrbn;
 my $help = 0;
 my $wantraw = 0;
 my $showrbn;
 my $help = 0;


@@ -42,13 +44,15 @@ GetOptions('host=s' => \$host,
                   'repeattime|rt=i' => sub { $minspottime = $_[1] * 60 },
                   'want=s' => sub {
                           my ($name, $value) = @_;
                   'repeattime|rt=i' => sub { $minspottime = $_[1] * 60 },
                   'want=s' => sub {
                           my ($name, $value) = @_;

-                          $wantcw = $wantrtty = $wantpsk = $wantbeacon = $wantdx = 0;
+                          $wantcw = $wantrtty = $wantpsk = $wantbeacon = $wantdx = $wantft = $wantpsk = 0;

                           for (split /[:,\|]/, $value) {
                                   ++$wantcw if /^cw$/i;
                                   ++$wantpsk if /^psk$/i;
                                   ++$wantrtty if /^rtty$/i;
                           for (split /[:,\|]/, $value) {
                                   ++$wantcw if /^cw$/i;
                                   ++$wantpsk if /^psk$/i;
                                   ++$wantrtty if /^rtty$/i;

-                                  ++$wantbeacon if /^beacon$/i;
+                                  ++$wantbeacon if /^beacon/i;

                                   ++$wantdx if /^dx$/i;
                                   ++$wantdx if /^dx$/i;

+                                  ++$wantft if /^ft$/;
+                                  ++$wantft, ++$wantrtty, ++$wantpsk if /^digi/;

                           }
                   },
                   'help|?' => \$help,
                           }
                   },
                   'help|?' => \$help,


@@ -72,8 +76,10 @@ for ($attempts = 1; $attempts <= 5; ++$attempts) {
        last if $sock;
 }
 
        last if $sock;
 }
 

-die "ADMIN,Cannot connect to $host:$port after 5 attempts $!" unless $sock;
+die "ADMIN,Cannot connect to $host:$port after 5 attempts $!\n" unless $sock;

 say "ADMIN,connected" if $dbg;
 say "ADMIN,connected" if $dbg;

+$sock->timeout(0);
+

 print $sock "$mycall\r\n";
 say "ADMIN,call $mycall sent" if $dbg;
 
 print $sock "$mycall\r\n";
 say "ADMIN,call $mycall sent" if $dbg;
 


@@ -87,6 +93,8 @@ my $nospot = 0;
 
 while (<$sock>) {
        chomp;
 
 while (<$sock>) {
        chomp;

+       s/\s*$//;
+       

        my $tim = time;
 
        # parse line
        my $tim = time;
 
        # parse line


@@ -98,18 +106,14 @@ while (<$sock>) {
        }
 
        my (undef, undef, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t, $tx) = split /[:\s]+/;
        }
 
        my (undef, undef, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t, $tx) = split /[:\s]+/;

+       my $b;
+       

        if ($t || $tx) {
 
        if ($t || $tx) {
 

-               # We have an RBN data line, dedupe it very simply on time, ignore QRG completely.
-               # 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};
-

                # fix up times for things like 'NXDXF B' etc
                # fix up times for things like 'NXDXF B' etc

-               if ($tx && $t != /^\d{4}Z$/) {
+               if ($tx && $t !~ /^\d{4}Z$/) {

                        if ($tx =~ /^\d{4}Z$/) {
                        if ($tx =~ /^\d{4}Z$/) {

+                               $b = $t;

                                $t = $tx;
                        } else {
                                say "ERR,$_";
                                $t = $tx;
                        } else {
                                say "ERR,$_";


@@ -117,11 +121,49 @@ while (<$sock>) {
                        }
                }
 
                        }
                }
 

+               # We have an RBN data line, dedupe it very simply on time, ignore QRG completely.
+               # 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 and network delays
+               # carefully (not) taken into account :-)
+
+               # Note, there is no intelligence here, but there are clearly basic heuristics that could
+               # be applied at this point that reject (more likely rewrite) the call of a busted spot that would
+               # useful for a zonal hotspot requirement from the cluster node.
+
+               # In reality, this mechanism would be incorporated within the cluster code, utilising the dxqsl database,
+               # and other resources in DXSpider, thus creating a zone map for an emitted spot. This is then passed through the
+               # normal "to-user" spot system (where normal spots are sent to be displayed per user) and then be
+               # processed through the normal, per user, spot filtering system - like a regular spot.
+
+               # The key to this is deducing the true callsign by "majority voting" (the greater the number of spotters
+        # the more effective this is) together with some lexical analsys probably in conjuction with DXSpider
+               # data sources (for singleton spots) to then generate a "centre" from and to zone (whatever that will mean if it isn't the usual one)
+               # and some heuristical "Kwalitee" rating given distance from the zone centres of spotter, recipient user
+        # and spotted. A map can be generated once per user and spotter as they are essentially mostly static. 
+               # The spotted will only get a coarse position unless other info is available. Programs that parse 
+               # DX bulletins and the online data online databases could be be used and then cached. 
+
+               # Obviously users have to opt in to receiving RBN spots and other users will simply be passed over and
+               # ignored.
+
+               # Clearly this will only work in the 'mojo' branch of DXSpider where it is possible to pass off external
+               # data requests to ephemeral or semi resident forked processes that do any grunt work and the main
+               # process to just the standard "message passing" which has been shown to be able to sustain over 5000 
+               # per second (limited by the test program's output and network speed, rather than DXSpider's handling).  
+               
+               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']).
                # 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 !$wantraw && ($dbg || $showrbn);
+               if (!$wantraw && ($dbg || $showrbn)) {
+                       my $s = join(',', "RBN", $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t);
+                       $s .= ",$b" if $b;
+                       say $s;
+               }

 
                # Determine whether to "SPOT" it based on whether we have not seen it before (near this QRG) or,
                # if we have, has it been a "while" since the last time we spotted it? If it has been spotted
 
                # Determine whether to "SPOT" it based on whether we have not seen it before (near this QRG) or,
                # if we have, has it been a "while" since the last time we spotted it? If it has been spotted


@@ -129,34 +171,33 @@ 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};
                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 || ($minspottime > 0 && $tim - $ts >= $minspottime)) {
                if (!$ts || ($minspottime > 0 && $tim - $ts >= $minspottime)) {

-                       if ($wantbeacon && $sort =~ /^BEA/) {
-                               ;
-                       } else {
-                               # Haven't used a perl 'goto' like this ever!
-                               # Clearly I need to use an event driven framework :-) 
-                               goto periodic if !$wantcw  && $mode =~ /^CW/;
-                               goto periodic if !$wantrtty && $mode =~ /^RTTY/;
-                               goto periodic if !$wantpsk && $mode =~ /^PSK/;
-                               goto periodic if !$wantdx && $mode =~ /^DX/;
+                       my $want;
+
+                       ++$want if $wantbeacon && $sort =~ /^BEA|NCD/;
+                       ++$want if $wantcw && $mode =~ /^CW/;
+                       ++$want if $wantrtty && $mode =~ /^RTTY/;
+                       ++$want if $wantpsk && $mode =~ /^PSK/;
+                       ++$want if $wantdx && $mode =~ /^DX/;
+                       ++$want if $wantft && $mode =~ /^FT/;
+                       if ($want) {
+                               ++$nospot;
+                               my $tag = $ts ? "RESPOT" : "SPOT";
+                               $t .= ",$b" if $b;
+                               say join(',', $tag, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t);
+                               $spot{$sp} = $tim;

                        }
                        }

-
-                       ++$nospot;
-                       my $tag = $ts ? "RESPOT" : "SPOT";
-                       say join(',', $tag, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t);
-                       $spot{$sp} = $tim;

                }
        } else {
                say "DATA,$_" if $dbg && !$wantraw;
        }
 
                }
        } else {
                say "DATA,$_" if $dbg && !$wantraw;
        }
 

- periodic:

        # periodic clearing out of the two caches
        if (($tim % 60 == 0 && $tim > $last) || ($last && $tim >= $last + 60)) {
                my $count = 0;
                my $removed = 0;
        # periodic clearing out of the two caches
        if (($tim % 60 == 0 && $tim > $last) || ($last && $tim >= $last + 60)) {
                my $count = 0;
                my $removed = 0;

-               
+

                while (my ($k,$v) = each %d) {
                        if ($tim-$v > 60) {
                                delete $d{$k};
                while (my ($k,$v) = each %d) {
                        if ($tim-$v > 60) {
                                delete $d{$k};


@@ -192,11 +233,25 @@ __END__
 
 =head1 NAME
 
 
 =head1 NAME
 

-rbn.pl - an experimental RBN filter program that
+rbn.pl - an experimental RBN filter program 

 
 =head1 SYNOPSIS
 
 
 =head1 SYNOPSIS
 

-rbn.pl [options] <your callsign> 
+rbn.pl [options] <any callsign>
+
+We read the raw data
+from the RBN. We collect similar spots on a frequency within 100hz and try to
+deduce which if them is likely to be the true callsign. Emitted spots are cached and thereafter ignored
+for a period until it is spotted again, when it may be emitted again - but marked as a RESPOT. 
+
+This is just technology demonstrator designed to scope out the issues and make sure that the line decoding works
+in all circumstances. But even on busy weekends it seems to cope just fine deduping away within its limits.
+
+To see it work at its best, run it as: rbn.pl -stats <any callsign>
+
+Leave it running for some time, preferably several (10s of) minutes.
+You will see it slowly reduce the number of new spots until you start to see "RESPOT" lines. Reductions
+of more than one order of magnitude is normal. Particularly when there are many more spotters. 

 
 =head1 OPTIONS
 
 
 =head1 OPTIONS
 


@@ -218,10 +273,13 @@ As default, this program will connect to C<telnet.reversebeacon.net>. Use this a
 
 As default, this program will connect to port 7000. Use this argument to change that to some other port.
 
 
 As default, this program will connect to port 7000. Use this argument to change that to some other port.
 

-=item B<-want>=cw,rtty,psk,beacon,dx
+=item B<-want>=cw,rtty,dx,beacon,psk,ft,digital
+
+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
+these classes if you want specific types of spots. The class 'digital' is equivalent to [rtty,psk,ft]. The class 'beacon' includes
+NCDXF beacons. 

 
 

-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
-these classes if you want specific types of spots.
+E.g. rbn.pl -want=psk,ft,beacon g9tst

 
 =item B<-stats>
 
 
 =item B<-stats>