From: Dirk Koopman <djk@tobit.co.uk>
Date: Wed, 27 May 2020 23:35:42 +0000 (+0100)
Subject: RBN now with basic spots
X-Git-Url: http://scm.dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=d40358b98c4f3fe24890369543dd7768c99da962;p=spider.git

RBN now with basic spots
---

diff --git a/cmd/set/wantrbn.pl b/cmd/set/wantrbn.pl
new file mode 100644
index 00000000..f4aa86e2
--- /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 9513b965..a8a2900e 100644
--- 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
index 00000000..33a2dccf
--- /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 73102ff4..10466b0f 100644
--- 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 a75bf157..8bb6659e 100644
--- 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 aae3cc77..b5606eff 100644
--- 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 1fc8dd86..b33f8823 100644
--- 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 91c63691..e77eb294 100644
--- 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 96167a7e..4efde147 100644
--- 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 9b7ce76f..81c2e40a 100644
--- 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 b6c0fef0..9687b18f 100644
--- 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 d3b24ba9..ebebcccc 100755
--- 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')");
 		}
 	}