Latest version of RBN code
[spider.git] / perl / RBN.pm
index ba81f735a79ec0f10858eaa19e58e6e2636741c9..492b1ac5331d68cddae9939c37e380595537ad45 100644 (file)
@@ -18,10 +18,11 @@ use DXUser;
 use DXChannel;
 use Math::Round qw(nearest);
 use Date::Parse;
+use Time::HiRes qw(clock_gettime CLOCK_REALTIME);
 
 our @ISA = qw(DXChannel);
 
-our $startup_delay =3*60;              # don't send anything out until this timer has expired
+our $startup_delay =0;#3*60;           # don't send anything out until this timer has expired
                                 # this is to allow the feed to "warm up" with duplicates
                                 # so that the "big rush" doesn't happen. 
 
@@ -30,25 +31,9 @@ our $minspottime = 60*60;            # the time between respots of a callsign - if a call
                                 # spotted before, it's spotted again after this time
                                 # until the next minspottime has passed.
 
-our %hfitu = (
-                         1 => [1, 2,],
-                         2 => [1, 2, 3,],
-                         3 => [2,3, 4,],
-                         4 => [3,4, 9,],
-#                        5 => [0],
-                         6 => [7],
-                         7 => [7, 6, 8, 10],
-                         8 => [7, 8, 9],
-                         9 => [8, 9],
-                         10 => [10],
-                         11 => [11],
-                         12 => [12, 13],
-                         13 => [12, 13],
-                         14 => [14, 15],
-                         15 => [15, 14],
-                         16 => [16],
-                         17 => [17],
-                        );
+our $dwelltime = 6;                    # the amount of time to wait for duplicates before issuing
+                                # a spot to the user (no doubt waiting with bated breath).
+
 
 sub new 
 {
@@ -130,13 +115,14 @@ sub start
        $self->{inrushpreventor} = $main::systime + $startup_delay;
 }
 
+my @queue;                                             # the queue of spots ready to send
+
 sub normal
 {
        my $self = shift;
        my $line = shift;
        my @ans;
-       my $d = $self->{d};
-       my $spot = $self->{spot};
+       my $spots = $self->{spot};
        
        # save this for them's that need it
        my $rawline = $line;
@@ -186,11 +172,17 @@ sub normal
                        }
                }
                if ($sort && $sort eq 'NCDXF') {
-                       $mode = $sort;
+                       $mode = 'DXF';
                        $t = $tx;
                }
                if ($sort && $sort eq 'BEACON') {
-                       $mode = 'BECON';
+                       $mode = 'BCN';
+               }
+               if ($mode =~ /^PSK/) {
+                       $mode = 'PSK';
+               }
+               if ($mode eq 'RTTY') {
+                       $mode = 'RTT';
                }
                
                # We have an RBN data line, dedupe it very simply on time, ignore QRG completely.
@@ -221,97 +213,123 @@ sub normal
                # 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";
-               ++$self->{noraw};
-               return if $d->{$p};
-
-               # new RBN input
-               $d->{$p} = $tim;
-               ++$self->{norbn};
-               $qrg = sprintf('%.1f', nearest(.1, $qrg));     # to nearest 100Hz (to catch the odd multiple decpl QRG [eg '7002.07']).
-               if (isdbg('rbnraw')) {
-                       my $ss = join(',', "RBN", $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t);
-                       $ss .= ",$b" if $b;
-                       dbg "RBNRAW:$ss";
-               }
+               # per second (limited by the test program's output and network speed, rather than DXSpider's handling).
 
-               # 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
-               # before then "RESPOT" it.
-               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(.5, $qrg);  # normalised to nearest Khz
+               my $sp = "$call|$nqrg";           # hopefully the skimmers will be calibrated at least this well!
 
-               if (!$ts || ($self->{minspottime} > 0 && $tim - $ts >= $self->{minspottime})) {
-                       ++$self->{nospot};
-                       my $tag = $ts ? "RESPOT" : "SPOT";
-                       $t .= ",$b" if $b;
-
-                       my ($hh,$mm) = $t =~ /(\d\d)(\d\d)Z$/;
-                       my $utz = str2time(sprintf('%02d:%02dZ', $hh, $mm));
-                       dbg "RBN:" . join(',', $tag, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t) if dbg('rbn');
+               # do we have it?
+               my $spot = $spots->{$sp};
 
+               # if we have one and there is only one slot and that slot's time isn't expired for respot then return
+               my $respot = 0;
+               if ($spot && @$spot == 1) {
+                       unless ($self->{minspottime} > 0 && $tim - $spot->[0] >= $self->{minspottime}) {
+                               dbg("RBN: key: '$sp' call: $call qrg: $qrg DUPE \@ ". atime(int $spot->[0])) if isdbg('rbn');
+                               return;
+                       }
+                       dbg("RBN: key: '$sp' RESPOTTING call: $call qrg: $qrg last seen \@ ". atime(int $spot->[0])) if isdbg('rbn');
+                       ++$respot;
+               }
 
-                       my @s = Spot::prepare($qrg, $call, $utz, sprintf("%-5s%3d $m", $mode, $s), $origin);
+               # here we either have an existing spot record buildup on the go, or we need to create the first one
+               unless ($spot) {
+                       $spot = [clock_gettime(CLOCK_REALTIME)];
+                       $spots->{$sp} = $spot;
+                       dbg("RBN: key: '$sp' call: $call qrg: $qrg NEW") if isdbg('rbn');
+               }
 
-                       if (isdbg('progress')) {
-                               my $d = ztime($s[2]);
-                               my $s = "RBN: $s[1] on $s[0] \@ $d by $s[4]";
-                               $s .= $s[3] ? " '$s[3]'" : q{ ''};
-                               $s .=  " route: $self->{call}";
-                               dbg($s);
+               # add me to the display queue unless we are waiting for initial in rush to finish
+               return unless $self->{inrushpreventor} < $main::systime;
+               push @queue, $sp if @$spot == 1; # queue the KEY (not the record)
+
+               # build up a new record and store it in the buildup
+               # deal with the unix time
+               my ($hh,$mm) = $t =~ /(\d\d)(\d\d)Z$/;
+               my $utz = $hh*3600 + $mm*60 + $main::systime_daystart; # possible issue with late spot from previous day
+               $utz -= 86400 if $utz > $tim+3600;                                         # too far ahead, drag it back one day
+
+               # create record and add into the buildup
+               my $r = [$origin, nearest(.1, $qrg), $call, $mode, $s, $t, $utz, $respot];
+               dbg("RBN: key: '$sp' ADD RECORD call: $call qrg: $qrg origin: $origin") if isdbg('rbn');
+
+               push @$spot, $r;
+
+               # At this point we run the queue to see if anything can be sent onwards to the punter
+               my $now = clock_gettime(CLOCK_REALTIME);
+
+               # now run the waiting queue which just contains KEYS ($call|$qrg)
+               foreach $sp (@queue) {
+                       my $cand = $spots->{$sp};
+                       if ($now >= $cand->[0]+$dwelltime ) {
+                               # we have a candidate, create qualitee value(s);
+                               unless (@$cand > 1) {
+                                       dbg "RBN: QUEUE key '$sp' MISSING RECORDS " . dd($cand) if isdbg 'rbn';
+                                       shift @queue;
+                                       next;
+                               }
+                               my $savedtime = shift @$cand; # save the start time
+                               my $r = $cand->[0];
+                               my $quality = @$cand;
+                               $quality = 9 if $quality > 9;
+                               $quality = "Q:$quality";
+                               if (isdbg('progress')) {
+                                       my $s = "RBN: SPOT key: '$sp' = $r->[2] on $r->[1] \@ $r->[5] $quality";
+                                       $s .=  " route: $self->{call}";
+                                       dbg($s);
+                               }
+                               
+                               send_dx_spot($self, $quality, $cand);
+                               
+                               # clear out the data and make this now just "spotted", but no further action required until respot time
+                               dbg "RBN: QUEUE key '$sp' cleared" if isdbg 'rbn';
+                               $spots->{$sp} = [$savedtime];
+                               shift @queue;
+                       } else {
+                               dbg sprintf("RBN: QUEUE key: '$sp' SEND time not yet reached %.1f secs left", $spot->[0] + $dwelltime - $now) if isdbg 'rbnqueue'; 
                        }
-                       
-                       send_dx_spot($self, $line, $mode, \@s) unless $self->{inrushpreventor} > $main::systime;
-
-                       $spot->{$sp} = $tim;
                }
+               
+
        } else {
                dbg "RBN:DATA,$line" if isdbg('rbn');
        }
 
-       # periodic clearing out of the two caches
+       #       # periodic clearing out of the two caches
        if (($tim % 60 == 0 && $tim > $self->{last}) || ($self->{last} && $tim >= $self->{last} + 60)) {
                my $count = 0;
                my $removed = 0;
-
-               while (my ($k,$v) = each %{$d}) {
-                       if ($tim-$v > 60) {
-                               delete $d->{$k};
-                               ++$removed
-                       } else {
-                               ++$count;
-                       }
-               }
-               dbg "RBN:ADMIN,rbn cache: $removed removed $count remain" if isdbg('rbn');
-               $count = $removed = 0;
-               while (my ($k,$v) = each %{$spot}) {
-                       if ($tim-$v > $self->{minspottime}*2) {
-                               delete $spot->{$k};
+               while (my ($k,$v) = each %{$spots}) {
+                       if ($tim - $v->[0] > $self->{minspottime}*2) {
+                               delete $spots->{$k};
                                ++$removed;
-                       } else {
+                       }
+                       else {
                                ++$count;
                        }
                }
-               dbg "RBN:ADMIN,spot cache: $removed removed $count remain" if isdbg('rbn');
-
+               dbg "RBN:ADMIN,spot cache: $removed removed $count remain"; # if isdbg('rbn');
                dbg "RBN:" . join(',', "STAT", $self->{noraw}, $self->{norbn}, $self->{nospot}) if $self->{showstats};
                $self->{noraw} = $self->{norbn} = $self->{nospot} = 0;
-
                $self->{last} = int($tim / 60) * 60;
        }
 }
 
-# we only send to users and we send the original line (possibly with a
-# Q:n in it)
+
+
+#      }
+# }
+
+# we should get the spot record minus the time, so just an array of record (arrays)
 sub send_dx_spot
 {
        my $self = shift;
-       my $line = shift;
-       my $mode = shift;
-       my $sref = shift;
+       my $quality = shift;
+       my $spot = shift;
+
+       # $r = [$origin, $qrg, $call, $mode, $s, $utz, $respot];
+
+       my $mode = $spot->[0]->[3]; # as all the modes will be the same;
        
        my @dxchan = DXChannel::get_all();
 
@@ -320,18 +338,20 @@ sub send_dx_spot
                my $user = $dxchan->{user};
                next unless $user &&  $user->wantrbn;
 
+               # does this user want this sort of spot at all?
                my $want = 0;
-               ++$want if $user->wantbeacon && $mode =~ /^BEA|NCD/;
+               ++$want if $user->wantbeacon && $mode =~ /^BCN|DXF/;
                ++$want if $user->wantcw && $mode =~ /^CW/;
-               ++$want if $user->wantrtty && $mode =~ /^RTTY/;
+               ++$want if $user->wantrtty && $mode =~ /^RTT/;
                ++$want if $user->wantpsk && $mode =~ /^PSK/;
                ++$want if $user->wantcw && $mode =~ /^CW/;
                ++$want if $user->wantft && $mode =~ /^FT/;
-
                ++$want unless $want;   # send everything if nothing is selected.
 
-               
-               $self->dx_spot($dxchan, $sref) if $want;
+               next unless $want;
+
+               # send one spot to one user out of the ones that we have
+               $self->dx_spot($dxchan, $quality, $spot) if $want;
        }
 }
 
@@ -339,51 +359,56 @@ sub dx_spot
 {
        my $self = shift;
        my $dxchan = shift;
-       my $sref = shift;
-       
-#      return unless $dxchan->{rbn};
+       my $quality = shift;
+       my $spot = shift;
 
-       my ($filter, $hops);
+       my $strength = 100;             # because it could if we talk about FTx
+       my $saver;
 
-       if ($dxchan->{rbnfilter}) {
-               ($filter, $hops) = $dxchan->{rbnfilter}->it($sref);
-               return unless $filter;
-       } elsif ($self->{rbnfilter}) {
-               ($filter, $hops) = $self->{rbnfilter}->it($sref);
-               return unless $filter;
-       }
+       my %zone;
+       
+       foreach my $r (@$spot) {
+               # $r = [$origin, $qrg, $call, $mode, $s, $t, $utz, $respot];
+               # Spot::prepare($qrg, $call, $utz, $comment, $origin);
 
-#      dbg('RBN::dx_spot spot: "' . join('","', @$sref) . '"') if isdbg('rbn');
+               my $comment = sprintf "%-3s %2ddB $quality", $r->[3], $r->[4];
+               my @s =  Spot::prepare($r->[1], $r->[2], $r->[6], $comment, $r->[0]);
 
-       my $buf;
-       if ($self->{ve7cc}) {
-               $buf = VE7CC::dx_spot($dxchan, @$sref);
-       } else {
-               $buf = $self->format_dx_spot(@$sref);
-               $buf =~ s/\%5E/^/g;
-       }
-       $dxchan->local_send('N', $buf);
-}
-
-sub format_dx_spot
-{
-       my $self = shift;
+               ++$zone{$s[11]};                # save the spotter's zone
+               
+               # save the highest strength one
+               if ($r->[4] < $strength) {
+                       $strength = $r->[4];
+                       $saver = \@s;
+                       dbg("RBN: STRENGTH call: $s[1] qrg: $s[0] origin: $s[4] dB: $r->[4]") if isdbg 'rbn';
+               }
+               my $filter = 0;
+
+               if ($dxchan->{rbnfilter}) {
+                       ($filter, undef) = $dxchan->{rbnfilter}->it(\@s);
+                       next unless $filter;
+                       $saver = \@s;
+                       dbg("RBN: FILTERED call: $s[1] qrg: $s[0] origin: $s[4] dB: $r->[4]") if isdbg 'rbn';
+                       last;
+               }
 
-       my $t = ztime($_[2]);
-       my $clth = $self->{consort} eq 'local' ? 29 : 30;
-       my $comment = $_[3] || '';
-       my $loc = '';
-       my $ref = DXUser::get_current($_[1]);
-       if ($ref && $ref->qra) {
-               $loc = ' ' . substr($ref->qra, 0, 4);
        }
-       $comment .= ' ' x ($clth - (length($comment)+length($loc)+1));
-       $comment .= $loc;
-       $loc = '';
-       my $ref = DXUser::get_current($_[4]);
-       if ($ref && $ref->qra) {
-               $loc = ' ' . substr($ref->qra, 0, 4);
+
+       if ($saver) {
+               my $buf;
+               delete $zone{$saver->[11]};  # remove this spotter's zone (leaving all the other zones)
+               my $z = join ',', sort {$a <=> $b} keys %zone;
+               $saver->[3] .= " Z:$z" if length $z;
+               dbg("RBN: SENDING call: $saver->[1] qrg: $saver->[0] origin: $saver->[4] $saver->[3]") if isdbg 'rbn';
+               if ($dxchan->{ve7cc}) {
+                       $buf = VE7CC::dx_spot($dxchan, @$saver);
+               } else {
+                       $buf = $dxchan->format_dx_spot(@$saver);
+               }
+               $buf =~ s/^DX/RB/;
+               $dxchan->local_send('N', $buf);
        }
-       return sprintf "RB de %-7.7s%11.1f  %-12.12s %-s $t$loc", "$_[4]:", $_[0], $_[1], $comment;
 }
+
 1;