Latest version of RBN code
authorDirk Koopman <djk@tobit.co.uk>
Thu, 11 Jun 2020 00:18:03 +0000 (01:18 +0100)
committerDirk Koopman <djk@tobit.co.uk>
Thu, 11 Jun 2020 00:18:03 +0000 (01:18 +0100)
cmd/show/prefix.pl
perl/DXUser.pm
perl/RBN.pm

index 1689d63a9d213ad01916f8063cf66b5e4704b7f6..0d46bb6a2cb4bccf4c5aa8d0c5000c00c926358f 100644 (file)
@@ -20,12 +20,13 @@ foreach $l (@list) {
        my $pre = shift @ans;
        my $a;
        foreach $a (@ans) {
-               push @out, sprintf "%s DXCC: %d ITU: %d CQ: %d LL: %s %s (%s, %s)", uc $l, $a->dxcc, $a->itu, $a->cq, slat($a->lat), slong($a->long), $pre, $a->name;
+               push @out, substr(sprintf("%s CC: %d IZ: %d CZ: %d LL: %s %s %4.4s (%s, %s", uc $l, $a->dxcc, $a->itu, $a->cq, slat($a->lat), slong($a->long), $a->qra, $pre, $a->name), 0, 78) . ')';
                $l = " " x length $l;
        }
        if ($USDB::present && $ans[0]->state) {
                push @out, sprintf "%s City: %s State: %s", $l, join (' ', map {ucfirst} split(/\s+/, lc $ans[0]->city)), $ans[0]->state;
        }
+       
 }
 
 return (1, @out);
index 5d212b078e220388de8b4bbef8e23b9a10e9d240..0b72a680f363a4bbcf45f6912217c110ccec5f6b 100644 (file)
@@ -101,6 +101,7 @@ our $maxconnlist = 3;                       # remember this many connection time (duration) [start,
                  maxconnect => '1,Max Connections',
                  startt => '0,Start Time,cldatetime',
                  connlist => '1,Connections,parraydifft',
+                 width => '0,Preferred Width'
                 );
 
 #no strict;
@@ -539,10 +540,10 @@ print "There are $count user records and $err errors\n";
                                my $eval = $val;
                                my $ekey = $key;
                                $eval =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg; 
-                               $ekey =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg; 
-                               LogDbg('DXCommand', "Export Error1: $ekey\t$eval");
+                               $ekey =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg;
+                               LogDbg('DXCommand', "Export Error1: invalid call '$key' => '$val'");
                                eval {$dbm->del($key)};
-                               dbg(carp("Export Error1: $ekey\t$eval\n$@")) if $@;
+                           dbg(carp("Export Error1: delete $key => '$val' $@")) if $@;
                                ++$err;
                                next;
                        }
@@ -553,7 +554,7 @@ print "There are $count user records and $err errors\n";
                                if ($ref->is_user && !$ref->{priv} && $main::systime > $t + $tooold) {
                                        unless ($ref->{lat} && $ref->{long} || $ref->{qth} || $ref->{qra}) {
                                                eval {$dbm->del($key)};
-                                               dbg(carp("Export Error2: $key\t$val\n$@")) if $@;
+                                               dbg(carp("Export Error2: delete '$key' => '$val' $@")) if $@;
                                                LogDbg('DXCommand', "$ref->{call} deleted, too old");
                                                $del++;
                                                next;
@@ -563,9 +564,9 @@ print "There are $count user records and $err errors\n";
                                print $fh "$key\t" . $ref->asc_encode($basic_info_only) . "\n";
                                ++$count;
                        } else {
-                               LogDbg('DXCommand', "Export Error3: $key\t" . carp($val) ."\n$@");
+                               LogDbg('DXCommand', "Export Error3: '$key'\t" . carp($val) ."\n$@");
                                eval {$dbm->del($key)};
-                               dbg(carp("Export Error3: $key\t$val\n$@")) if $@;
+                               dbg(carp("Export Error3: delete '$key' => '$val' $@")) if $@;
                                ++$err;
                        }
                } 
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;