add RBN filtering

diff --git a/cmd/accept/rbn.pl b/cmd/accept/rbn.pl
new file mode 100644 (file)
index 0000000..69b39e6
--- /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 (file)
index 0000000..4a7222b
--- /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 (file)
index 0000000..de1ebd2
--- /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 f3aab0166c259f5e1b8cdc6f24a0b143e419d159..ccfbc48583c980a12ee2999e8757775f9230ac1b 100644 (file)
--- 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 10466b0f1e2be9b975cf09557179504bff97d8a6..c35d21ca1517d7d286185fbb1d1426d685793397 100644 (file)
--- 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 900460aef2c1df89f65fb48b1a97fd1ef7bb3eeb..898a639720013e9c1e54d563f8ebf14f3bce2b04 100644 (file)
--- 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 12caeef398d21c20b95d1f87e43b48d9c1bdd11d..867c8ddfe73533fea29a6e3b09f5f0dcd106e2d5 100644 (file)
--- 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 e2f532d83c076bc1c4b5531370af558ca60757d8..b95f637288b4af1d3be834186c94b39af91b0449 100644 (file)
--- 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) {