RBN now with basic spots

diff --git a/cmd/set/wantrbn.pl b/cmd/set/wantrbn.pl
new file mode 100644 (file)
index 0000000..f4aa86e
--- /dev/null
+++ b/cmd/set/wantrbn.pl
@@ -0,0 +1,27 @@
+#
+# set the want rbn (at all)
+#
+# Copyright (c) 2020 - Dirk Koopman
+#
+#
+#
+
+my ($self, $line) = @_;
+my @args = split /\s+/, $line;
+my $call;
+my @out;
+
+@args = $self->call if (!@args || $self->priv < 9);
+
+foreach $call (@args) {
+       $call = uc $call;
+       my $user = DXUser::get_current($call);
+       if ($user) {
+               $user->wantrbn(1);
+               $user->put;
+               push @out, $self->msg('wante', 'RBN', $call);
+       } else {
+               push @out, $self->msg('e3', "Set wantrbn", $call);
+       }
+}
+return (1, @out);

diff --git a/cmd/show/debug_ring.pl b/cmd/show/debug_ring.pl
index 9513b9655078aa58a089edfabf913ff0173ad62d..a8a2900eb224f0729a188b26ac047114e6f41f33 100644 (file)
--- a/cmd/show/debug_ring.pl
+++ b/cmd/show/debug_ring.pl
@@ -18,6 +18,5 @@ for (@args) {
 }
 my $lines = DXDebug::dbgprintring($n);
 DXDebug::dbgclearring() if $doclear;
-dge;
 
 return (1, qq{Contents of $lines lines of debug ring buffer logged. View with watchdbg.});

diff --git a/cmd/unset/wantrbn.pl b/cmd/unset/wantrbn.pl
new file mode 100644 (file)
index 0000000..33a2dcc
--- /dev/null
+++ b/cmd/unset/wantrbn.pl
@@ -0,0 +1,27 @@
+#
+# set the want rbn (at all)
+#
+# Copyright (c) 2020 - Dirk Koopman
+#
+#
+#
+
+my ($self, $line) = @_;
+my @args = split /\s+/, $line;
+my $call;
+my @out;
+
+@args = $self->call if (!@args || $self->priv < 9);
+
+foreach $call (@args) {
+       $call = uc $call;
+       my $user = DXUser::get_current($call);
+       if ($user) {
+               $user->wantrbn(0);
+               $user->put;
+               push @out, $self->msg('wantd', 'RBN', $call);
+       } else {
+               push @out, $self->msg('e3', "Unset wantrbn", $call);
+       }
+}
+return (1, @out);

diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index 73102ff461503f1cc904b60f03cb3045d4a5eac0..10466b0f1e2be9b975cf09557179504bff97d8a6 100644 (file)
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -62,9 +62,6 @@ $count = 0;
                  here => '0,Here?,yesno',
                  conf => '0,In Conference?,yesno',
                  dx => '0,DX Spots,yesno',
-                 rbn => '0,RBN Spots,yesno',
-                 ft => '0,(RBN) FT4/8 Spots,yesno',
-                 cw => '0,RBN CW Spots,yesno',
                  redirect => '0,Redirect messages to',
                  lang => '0,Language',
                  func => '5,Function',

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index a75bf157a699b2ae16a0078903858ba4df8453bb..8bb6659e5f0f7fb70e849fb30da9b9150b94e6a9 100644 (file)
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -139,9 +139,6 @@ sub start
        $self->{here} = 1;
        $self->{prompt} = $user->prompt if $user->prompt;
        $self->{lastmsgpoll} = 0;
-       $self->{rbn} = $user->wantrbn;
-       $self->{ft} = $user->wantft;
-       $self->{cw} = $user->wantcw;
 
        # sort out new dx spot stuff
        $user->wantdxcq(0) unless defined $user->{wantdxcq};

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index aae3cc77259436ffc0fb75eb5fa6651a48f2e6bc..b5606eff609d9d61896f2b8558a1bb0444efef91 100644 (file)
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -561,6 +561,7 @@ sub send_dx_spot
        foreach $dxchan (@dxchan) {
                next if $dxchan == $main::me;
                next if $dxchan == $self && $self->is_node;
+               next if $dxchan->is_rbn;
                if ($line =~ /PC61/ && !($dxchan->is_spider || $dxchan->is_user)) {
                        unless ($pc11) {
                                my @f = split /\^/, $line;
@@ -621,6 +622,7 @@ sub send_wwv_spot
        foreach $dxchan (@dxchan) {
                next if $dxchan == $main::me;
                next if $dxchan == $self && $self->is_node;
+               next if $dxchan->is_rbn;
                my $routeit;
                my ($filter, $hops);
 
@@ -655,6 +657,7 @@ sub send_wcy_spot
        foreach $dxchan (@dxchan) {
                next if $dxchan == $main::me;
                next if $dxchan == $self;
+               next if $dxchan->is_rbn;
 
                $dxchan->wcy($line, $self->{isolate}, @_, $self->{call}, @dxcc);
        }
@@ -738,6 +741,7 @@ sub send_announce
                next if $dxchan == $self && $self->is_node;
                next if $from_pc9x && $dxchan->{do_pc9x};
                next if $target eq 'LOCAL' && $dxchan->is_node;
+               next if $dxchan->is_rbn;
                $dxchan->announce($line, $self->{isolate}, $to, $target, $text, @_, $self->{call},
                                                  @a[0..2], @b[0..2]);
        }
@@ -810,6 +814,7 @@ sub send_chat
                        next unless $dxchan->is_spider && $dxchan->do_pc9x;
                        next if $target eq 'LOCAL';
                }
+               next if $dxchan->is_rbn;
 
                $dxchan->chat($line, $self->{isolate}, $target, $_[1],
                                          $text, @_, $self->{call}, @a[0..2], @b[0..2]);

diff --git a/perl/DXUser.pm b/perl/DXUser.pm
index 1fc8dd8671de0c12bed3f416366f18eb7259b18e..b33f882384e63d161a18ecd0a8cfecca2f3b4837 100644 (file)
--- a/perl/DXUser.pm
+++ b/perl/DXUser.pm
@@ -84,8 +84,11 @@ our $maxconnlist = 3;                        # remember this many connection time (duration) [start,
                  wantgtk => '0,Want GTK interface,yesno',
                  wantpc9x => '0,Want PC9X interface,yesno',
                  wantrbn => '0,Want RBN spots,yesno',
-                 wantft => '0,Want FT4/8 spots,yesno',
-                 wantcw => '0,Want (RBN) CW spots,yesno',
+                 wantft => '0,Want RBN FT4/8,yesno',
+                 wantcw => '0,Want RBN CW,yesno',
+                 wantrtty => '0,Want RBN RTTY,yesno',
+                 wantpsk => '0,Want RBN PSK,yesno',
+                 wantbeacon => '0,Want (RBN) Beacon,yesno',
                  lastoper => '9,Last for/oper,cldatetime',
                  nothere => '0,Not Here Text',
                  registered => '9,Registered?,yesno',

diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm
index 91c636910bc5a0fcba3986a7bf84498829172d18..e77eb2947d80f8db249dc109c984ff070243b8cf 100644 (file)
--- a/perl/DXUtil.pm
+++ b/perl/DXUtil.pm
@@ -27,7 +27,7 @@ require Exporter;
              print_all_fields cltounix unpad is_callsign is_latlong
                         is_qra is_freq is_digits is_pctext is_pcflag insertitem deleteitem
                         is_prefix dd is_ipaddr $pi $d2r $r2d localdata localdata_mv
-                        diffms _diffms difft parraydifft
+                        diffms _diffms difft parraydifft is_ztime
             );
 
 
@@ -444,6 +444,12 @@ sub is_ipaddr
     return $_[0] =~ /^\d+\.\d+\.\d+\.\d+$/ || $_[0] =~ /^[0-9a-f:,]+$/;
 }
 
+# is it a zulu time hhmmZ
+sub is_ztime
+{
+       return $_[0] =~ /^(?:(?:2[0-3])|(?:[01][0-9]))[0-5][0-9]Z$/;
+}
+
 # insert an item into a list if it isn't already there returns 1 if there 0 if not
 sub insertitem
 {

diff --git a/perl/Messages b/perl/Messages
index 96167a7ea0db6d00476f8ca7ddaffac12ac37a3c..4efde147e5556d1d9702a2bc2d2dd7a83f0443b3 100644 (file)
--- a/perl/Messages
+++ b/perl/Messages
@@ -342,6 +342,8 @@ package DXM;
                                usernf => '*** User record for $_[0] not found ***',
                                usstates => 'US State display enabled for $_[0]',
                                usstateu => 'US State display disabled for $_[0]',
+                               wante => 'Want $_[0] enabled for $_[1]',
+                               wantd => 'Want $_[0] disabled for $_[1]',
                                wcy1 => '$_[0] is missing or out of range',
                                wcy2 => 'Duplicate WCY',
                                wcy3 => 'Date        Hour   SFI   A   K Exp.K   R SA    GMF   Aurora   Logger',

diff --git a/perl/Msg.pm b/perl/Msg.pm
index 9b7ce76fd9e32091f9b7b858f252b6f4185e7fab..81c2e40a0090aa09ecdeba30e94dd01ae6cd70a6 100644 (file)
--- a/perl/Msg.pm
+++ b/perl/Msg.pm
@@ -257,7 +257,7 @@ sub disconnect
        my ($pkg, $fn, $line) = caller if $dbg;
 
        if ($count >= 2) {
-               dbg((ref $conn) . "::disconnect on call $conn->{call} attempt $conn->{disconnecting} called from ${pkg}::${fn} line $line FORCING CLOSE ") if $dbg;
+               dbgtrace((ref $conn) . "::disconnect on call $conn->{call} attempt $conn->{disconnecting} called from ${pkg}::${fn} line $line FORCING CLOSE ") if $dbg;
                _close_it($conn);
                return;
        }
@@ -553,8 +553,7 @@ sub DESTROY
 
        if (isdbg('connll')) {
                my ($pkg, $fn, $line) = caller;
-               dbg((ref $conn) . "::DESTROY on call $call called from ${pkg}::${fn} line $line ");
-               
+               dbgtrace((ref $conn) . "::DESTROY on call $call called from ${pkg}::${fn} line $line ");
        }
 
        my $call = $conn->{call} || 'unallocated';

diff --git a/perl/RBN.pm b/perl/RBN.pm
index b6c0fef08d9901e5eb4c78d67431d4bbdc2dbaef..9687b18f6f2741ac15931eae6a0fda7e36b5b91e 100644 (file)
--- a/perl/RBN.pm
+++ b/perl/RBN.pm
@@ -120,17 +120,27 @@ sub normal
        # parse line
        dbg "RBN:RAW,$line" if isdbg('rbnraw');
 
-       my ($origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t, $tx) = split /[:\s]+/, $line;
-       $tx ||= '';
-       dbg qq{0:$origin 1:$qrg 2:$call 3:$mode 4:$s 5:m 6:$spd 7:$u 8:$sort 9:$t 10:$tx} if $line =~ /DX/;
+       my (undef, undef, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t, $tx) = split /[:\s]+/, $line;
 
+       # fix up FT8 spots from 7001
+       $t = $u, $u = '' if !$t && is_ztime($u);
+       $t = $sort, $sort = '' if !$t && is_ztime($sort);
+       my $qra = $spd, $spd = '' if is_qra($spd);
+       $u = $qra if $qra;
+       
+#      no warnings qw(uninitialized);
+       
+#      dbg qq{or:$origin qr:$qrg ca:$call mo:$mode s:$s m:$m sp:$spd u:$u sort:$sort t:$t tx:$tx qra:$qra} if $line =~ /DX/;
+
+#      use warnings;
+       
        my $b;
        
        if ($t || $tx) {
 
                # fix up times for things like 'NXDXF B' etc
-               if ($tx && $t !~ /^\d{4}Z$/) {
-                       if ($tx =~ /^\d{4}Z$/) {
+               if ($tx && is_ztime($t)) {
+                       if (is_ztime($tx)) {
                                $b = $t;
                                $t = $tx;
                        } else {
@@ -138,7 +148,7 @@ sub normal
                                return (0);
                        }
                }
-
+               
                # 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
@@ -194,7 +204,11 @@ sub normal
                        ++$self->{nospot};
                        my $tag = $ts ? "RESPOT" : "SPOT";
                        $t .= ",$b" if $b;
+                       $sort ||= '';
                        dbg "RBN:" . join(',', $tag, $origin, $qrg, $call, $mode, $s, $m, $spd, $u, $sort, $t);
+
+                       send_dx_spot($self, $line, $mode);
+                       
                        $spot->{$sp} = $tim;
                }
        } else {
@@ -233,7 +247,34 @@ sub normal
        }
 }
 
+# we only send to users and we send the original line (possibly with a
+# Q:n in it)
+sub send_dx_spot
+{
+       my $self = shift;
+       my $line = shift;
+       my $mode = shift;
+       
+       my @dxchan = DXChannel::get_all();
+
+       foreach my $dxchan (@dxchan) {
+               next unless $dxchan->is_user;
+               my $user = $dxchan->{user};
+               next unless $user->wantrbn;
 
+               my $want = 0;
+               ++$want if $user->wantbeacon && $mode =~ /^BEA|NCD/;
+               ++$want if $user->wantcw && $mode =~ /^CW/;
+               ++$want if $user->wantrtty && $mode =~ /^RTTY/;
+               ++$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.
+
+               $dxchan->send($line) if $want;
+       }
+}
 
 
 1;

diff --git a/perl/cluster.pl b/perl/cluster.pl
index d3b24ba9838740fde1d5014a0859f56bcfc69970..ebebcccc9ededbb062e9ec0e08eae71318249064 100755 (executable)
--- a/perl/cluster.pl
+++ b/perl/cluster.pl
@@ -31,6 +31,7 @@ $yes = 'Yes';                                 # visual representation of yes
 $no = 'No';                                            # ditto for no
 $user_interval = 11*60;                        # the interval between unsolicited prompts if no traffic
 
+
 # make sure that modules are searched in the order local then perl
 BEGIN {
        umask 002;
@@ -90,12 +91,11 @@ use DXVars;
 use SysVar;
 
 # order here is important - DXDebug snarfs Carp et al so that Mojo errors go into the debug log
-use DXDebug;
 use Mojolicious 7.26;
 use Mojo::IOLoop;
-
 $DOWARN = 1;
 
+use DXDebug;
 use Msg;
 use IntMsg;
 use Internet;
@@ -568,14 +568,14 @@ sub setup_start
                my $oldsort = $ref->sort;
                if ($oldsort ne 'S') {
                        $ref->sort('S');
-                       dbg "Resetting node type from $oldsort -> DXSpider ('S')";
+                       dbg("Resetting node type from $oldsort -> DXSpider ('S')");
                }
                $ref = DXUser::get($myalias);
                die "$myalias missing, run the create_sysop.pl script and please RTFM" unless $ref && $ref->priv == 9;
                $oldsort = $ref->sort;
                if ($oldsort ne 'U') {
                        $ref->sort('U');
-                       dbg "Resetting sysop user type from $oldsort -> User ('U')";
+                       dbg("Resetting sysop user type from $oldsort -> User ('U')");
                }
        }