From 1b28f13d136ceecc638e66fa427f226bdca83346 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Sat, 20 Jun 2020 23:04:10 +0100 Subject: [PATCH] add RBN filtering --- cmd/accept/rbn.pl | 14 ++++++++++++++ cmd/clear/rbn.pl | 38 ++++++++++++++++++++++++++++++++++++++ cmd/reject/rbn.pl | 14 ++++++++++++++ cmd/show/filter.pl | 2 +- perl/DXChannel.pm | 9 +++------ perl/DXCommandmode.pm | 3 +++ perl/Filter.pm | 9 ++++++--- perl/RBN.pm | 19 +++++++++++-------- 8 files changed, 90 insertions(+), 18 deletions(-) create mode 100644 cmd/accept/rbn.pl create mode 100644 cmd/clear/rbn.pl create mode 100644 cmd/reject/rbn.pl diff --git a/cmd/accept/rbn.pl b/cmd/accept/rbn.pl new file mode 100644 index 00000000..69b39e6b --- /dev/null +++ b/cmd/accept/rbn.pl @@ -0,0 +1,14 @@ +# +# accept/reject filter commands +# +# Copyright (c) 2000 Dirk Koopman G1TLH +# +# +# + +my ($self, $line) = @_; +my $type = 'accept'; +my $sort = 'rbn'; + +my ($r, $filter, $fno) = $RBN::filterdef->cmd($self, $sort, $type, $line); +return (1, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); diff --git a/cmd/clear/rbn.pl b/cmd/clear/rbn.pl new file mode 100644 index 00000000..4a7222b8 --- /dev/null +++ b/cmd/clear/rbn.pl @@ -0,0 +1,38 @@ +# +# clear filters commands +# +# Copyright (c) 2000 Dirk Koopman G1TLH +# +# +# +my ($self, $line) = @_; +my @f = split /\s+/, $line; +my @out; +my $dxchan = $self; +my $sort = 'rbn'; +my $flag; +my $fno = 1; +my $call = $dxchan->call; +my $f; + +if ($self->priv >= 8) { + if (@f && is_callsign(uc $f[0])) { + $f = uc shift @f; + my $uref = DXUser::get($f); + $call = $uref->call if $uref; + } elsif (@f && lc $f[0] eq 'node_default' || lc $f[0] eq 'user_default') { + $call = lc shift @f; + } + if (@f && $f[0] eq 'input') { + shift @f; + $flag = 'in'; + } +} + +$fno = shift @f if @f && $f[0] =~ /^\d|all$/; + +my $filter = Filter::read_in($sort, $call, $flag); +Filter::delete($sort, $call, $flag, $fno); +$flag = $flag ? "input " : ""; +push @out, $self->msg('filter4', $flag, $sort, $fno, $call); +return (1, @out); diff --git a/cmd/reject/rbn.pl b/cmd/reject/rbn.pl new file mode 100644 index 00000000..de1ebd20 --- /dev/null +++ b/cmd/reject/rbn.pl @@ -0,0 +1,14 @@ +# +# accept/reject filter commands +# +# Copyright (c) 2000 Dirk Koopman G1TLH +# +# +# + +my ($self, $line) = @_; +my $type = 'reject'; +my $sort = 'rbn'; + +my ($r, $filter, $fno) = $RBN::filterdef->cmd($self, $sort, $type, $line); +return (0, $r ? $filter : $self->msg('filter1', $fno, $filter->{name})); diff --git a/cmd/show/filter.pl b/cmd/show/filter.pl index f3aab016..ccfbc485 100644 --- a/cmd/show/filter.pl +++ b/cmd/show/filter.pl @@ -24,7 +24,7 @@ my @in; if (@f) { push @in, @f; } else { - push @in, qw(route ann spots wcy wwv); + push @in, qw(route ann spots wcy wwv rbn); } my $sort; diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index 10466b0f..c35d21ca 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -80,12 +80,14 @@ $count = 0; wcyfilter => '5,WCY Filt-out', spotsfilter => '5,Spot Filt-out', routefilter => '5,Route Filt-out', + rbnfilter => '5,RBN Filt-out', pc92filter => '5,PC92 Route Filt-out', inannfilter => '5,Ann Filt-inp', inwwvfilter => '5,WWV Filt-inp', inwcyfilter => '5,WCY Filt-inp', inspotsfilter => '5,Spot Filt-inp', inroutefilter => '5,Route Filt-inp', + inrbnfilter => '5,RBN Filt-inp', inpc92filter => '5,PC92 Route Filt-inp', passwd => '9,Passwd List,yesno', pingint => '5,Ping Interval ', @@ -676,12 +678,7 @@ sub broadcast_list if ($sort eq 'dx') { next unless $dxchan->{dx}; - ($filter) = $dxchan->{spotsfilter}->it(@{$fref}) if ref $fref; - next unless $filter; - } - if ($sort eq 'rbn') { - next unless $dxchan->{dx}; # this is deliberate! - ($filter) = $dxchan->{spotsfilter}->it(@{$fref}) if ref $fref; + ($filter) = $dxchan->{spotsfilter}->it($fref) if $dxchan->{spotsfilter} && ref $fref; next unless $filter; } next if $sort eq 'ann' && !$dxchan->{ann} && $s !~ /^To\s+LOCAL\s+de\s+(?:$main::myalias|$main::mycall)/i; diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 900460ae..898a6397 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -176,6 +176,9 @@ sub start $self->{annfilter} = Filter::read_in('ann', $call, 0) || Filter::read_in('ann', $nossid, 0) || Filter::read_in('ann', 'user_default', 0) ; + $self->{rbnfilter} = Filter::read_in('rbn', $call, 0) + || Filter::read_in('rbn', $nossid, 0) + || Filter::read_in('rbn', 'user_default', 0); # clean up qra locators my $qra = $user->qra; diff --git a/perl/Filter.pm b/perl/Filter.pm index 12caeef3..867c8ddf 100644 --- a/perl/Filter.pm +++ b/perl/Filter.pm @@ -231,13 +231,15 @@ sub it my $hops = $self->{hops} if exists $self->{hops}; if (isdbg('filter')) { + my $call = $self->{name}; my $args = join '\',\'', map {defined $_ ? $_ : 'undef'} (ref $_[0] ? @{$_[0]} : @_); my $true = $r ? "OK " : "REJ"; my $sort = $self->{sort}; my $dir = $self->{name} =~ /^in_/i ? "IN " : "OUT"; - + + $call =~ s/\.PL$//i; my $h = $hops || ''; - dbg("$true $dir: $type/$sort with $asc on '$args' $h") if isdbg('filter'); + dbg("Filter: $call $true $dir: $type/$sort with '$asc' on '$args' $h") if isdbg('filter'); } return ($r, $hops); } @@ -581,7 +583,8 @@ sub cmd $r = $filter->write; return (1,$r) if $r; - + + $filter->install(1); # 'delete' $filter->install; return (0, $filter, $fno); diff --git a/perl/RBN.pm b/perl/RBN.pm index e2f532d8..b95f6372 100644 --- a/perl/RBN.pm +++ b/perl/RBN.pm @@ -19,6 +19,7 @@ use DXChannel; use Math::Round qw(nearest); use Date::Parse; use Time::HiRes qw(clock_gettime CLOCK_REALTIME); +use Spot; our @ISA = qw(DXChannel); @@ -36,6 +37,8 @@ our $beacontime = 5*60; # same as minspottime, but for beacons (and shorter) our $dwelltime = 6; # the amount of time to wait for duplicates before issuing # a spot to the user (no doubt waiting with bated breath). +our $filterdef = $Spot::filterdef; # we use the same filter as the Spot system. Can't think why. + sub new { @@ -214,8 +217,8 @@ sub normal # do we have it? my $spot = $spots->{$sp}; - $spot = $spots->{$spp}, $sp = $spp, dbg('RBN: SPP using $spp for $sp') if !$spot && exists $spots->{$spp}; - $spot = $spots->{$spm}, $sp = $spm, dbg('RBN: SPM using $spm for $sp') if !$spot && exists $spots->{$spm}; + $spot = $spots->{$spp}, $sp = $spp, dbg(qq{RBN: SPP using $spp for $sp}) if !$spot && exists $spots->{$spp}; + $spot = $spots->{$spm}, $sp = $spm, dbg(qq{RBN: SPM using $spm for $sp}) if !$spot && exists $spots->{$spm}; # if we have one and there is only one slot and that slot's time isn't expired for respot then return @@ -393,12 +396,6 @@ sub dx_spot ++$zone{$s[11]}; # save the spotter's zone ++$qrg{$s[0]}; # and the qrg - # 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; @@ -410,6 +407,12 @@ sub dx_spot last; } + # save the lowest 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'; + } } if ($saver) { -- 2.43.0