mirror of
git://scm.dxcluster.org/scm/spider
synced 2024-09-21 07:47:10 +00:00
RBN now with basic spots
This commit is contained in:
parent
ed4c2b52be
commit
d40358b98c
27
cmd/set/wantrbn.pl
Normal file
27
cmd/set/wantrbn.pl
Normal file
@ -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);
|
@ -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.});
|
||||
|
27
cmd/unset/wantrbn.pl
Normal file
27
cmd/unset/wantrbn.pl
Normal file
@ -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);
|
@ -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',
|
||||
|
@ -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};
|
||||
|
@ -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]);
|
||||
|
@ -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',
|
||||
|
@ -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
|
||||
{
|
||||
|
@ -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',
|
||||
|
@ -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';
|
||||
|
53
perl/RBN.pm
53
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;
|
||||
|
@ -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')");
|
||||
}
|
||||
}
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user