Add new style filtering for WWV and WCY

get the field nos correct for ANN Filters

diff --git a/Changes b/Changes
index bf62d8a8f46a37da67eab1a53ba43eb7fdf9c9a7..ce65beb7a1caca9c25339bc49644941bfb23f02d 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,7 @@
 18Dec00=======================================================================
 1. fix double printing of DB results
+2. add new style filtering for WWV and WCY to complete the set
+3. got the field nos right (hopefully) on Announces for filters
 05Dec00=======================================================================
 1. fix frequency hinting routine so it correctly handles things like 'on 23cm'
 where digits are the 'wrong' way round.

diff --git a/cmd/accept/wcy.pl b/cmd/accept/wcy.pl
new file mode 100644 (file)
index 0000000..bfa89dc
--- /dev/null
+++ b/cmd/accept/wcy.pl
@@ -0,0 +1,14 @@
+#
+# accept/reject filter commands
+#
+# Copyright (c) 2000 Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my $type = 'accept';
+my $sort  = 'wcy';
+
+my ($r, $filter, $fno) = $WCY::filterdef->cmd($self, $sort, $type, $line);
+return (0, $r ? $r : $self->msg('filter1', $fno, $filter->{name})); 

diff --git a/cmd/accept/wwv.pl b/cmd/accept/wwv.pl
new file mode 100644 (file)
index 0000000..f19db5e
--- /dev/null
+++ b/cmd/accept/wwv.pl
@@ -0,0 +1,14 @@
+#
+# accept/reject filter commands
+#
+# Copyright (c) 2000 Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my $type = 'accept';
+my $sort  = 'wwv';
+
+my ($r, $filter, $fno) = $Geomag::filterdef->cmd($self, $sort, $type, $line);
+return (0, $r ? $r : $self->msg('filter1', $fno, $filter->{name})); 

diff --git a/cmd/clear/wcy.pl b/cmd/clear/wcy.pl
new file mode 100644 (file)
index 0000000..dfcc8da
--- /dev/null
+++ b/cmd/clear/wcy.pl
@@ -0,0 +1,37 @@
+#
+# clear filters commands
+#
+# Copyright (c) 2000 Dirk Koopman G1TLH
+#
+# $Id$
+#
+my ($self, $line) = @_;
+my @f = split /\s+/, $line;
+my @out;
+my $dxchan = $self;
+my $sort = 'wcy';
+my $flag;
+my $fno = 1;
+my $call = $dxchan->call;
+
+my $f = lc shift @f if @f;
+if ($self->priv >= 8) {
+       if (is_callsign(uc $f)) {
+               my $uref = DXUser->get(uc $f);
+               $call = $uref->call if $uref;
+       }
+       if (@f) {
+               $f = lc shift @f;
+               if ($f eq 'input') {
+                       $flag = 'in';
+                       $f = shift @f if @f;
+               }
+       }
+}
+
+$fno = $f if $f;
+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/clear/wwv.pl b/cmd/clear/wwv.pl
new file mode 100644 (file)
index 0000000..01f1390
--- /dev/null
+++ b/cmd/clear/wwv.pl
@@ -0,0 +1,37 @@
+#
+# clear filters commands
+#
+# Copyright (c) 2000 Dirk Koopman G1TLH
+#
+# $Id$
+#
+my ($self, $line) = @_;
+my @f = split /\s+/, $line;
+my @out;
+my $dxchan = $self;
+my $sort = 'wwv';
+my $flag;
+my $fno = 1;
+my $call = $dxchan->call;
+
+my $f = lc shift @f if @f;
+if ($self->priv >= 8) {
+       if (is_callsign(uc $f)) {
+               my $uref = DXUser->get(uc $f);
+               $call = $uref->call if $uref;
+       }
+       if (@f) {
+               $f = lc shift @f;
+               if ($f eq 'input') {
+                       $flag = 'in';
+                       $f = shift @f if @f;
+               }
+       }
+}
+
+$fno = $f if $f;
+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/wcy.pl b/cmd/reject/wcy.pl
new file mode 100644 (file)
index 0000000..fb3ad12
--- /dev/null
+++ b/cmd/reject/wcy.pl
@@ -0,0 +1,14 @@
+#
+# accept/reject filter commands
+#
+# Copyright (c) 2000 Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my $type = 'reject';
+my $sort  = 'ann';
+
+my ($r, $filter, $fno) = $WCY::filterdef->cmd($self, $sort, $type, $line);
+return (0, $r ? $r : $self->msg('filter1', $fno, $filter->{name})); 

diff --git a/cmd/reject/wwv.pl b/cmd/reject/wwv.pl
new file mode 100644 (file)
index 0000000..3be6330
--- /dev/null
+++ b/cmd/reject/wwv.pl
@@ -0,0 +1,14 @@
+#
+# accept/reject filter commands
+#
+# Copyright (c) 2000 Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my $type = 'reject';
+my $sort  = 'ann';
+
+my ($r, $filter, $fno) = $Geomag::filterdef->cmd($self, $sort, $type, $line);
+return (0, $r ? $r : $self->msg('filter1', $fno, $filter->{name})); 

diff --git a/perl/AnnTalk.pm b/perl/AnnTalk.pm
index 5a387d219ff30946138c720d92ce36ac058c68b0..b7eb1311772759e78114fd4401c2ecc2f4d627ec 100644 (file)
--- a/perl/AnnTalk.pm
+++ b/perl/AnnTalk.pm
@@ -25,15 +25,15 @@ $filterdef = bless ([
                          ['dest', 'c', 1],
                          ['info', 't', 2],
                          ['group', 't', 3],
+                         ['origin', 'c', 4],
                          ['wx', 't', 5],
-                         ['origin', 'c', 7, 4],
-                         ['origin_dxcc', 'c', 10],
-                         ['origin_itu', 'c', 11],
-                         ['origin_itu', 'c', 12],
+                         ['channel', 'n', 6],
                          ['by_dxcc', 'n', 7],
                          ['by_itu', 'n', 8],
                          ['by_zone', 'n', 9],
-                         ['channel', 'n', 6],
+                         ['origin_dxcc', 'c', 10],
+                         ['origin_itu', 'c', 11],
+                         ['origin_itu', 'c', 12],
                         ], 'Filter::Cmd');
 
 

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 15f92c477e8aaf6d5cb2919aecd456d42c876177..c7cd41b77cec153ca0b6a83c5aefddafab9dee2b 100644 (file)
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -1225,6 +1225,19 @@ sub send_wwv_spot
        my $line = shift;
        my @dxchan = DXChannel->get_all();
        my $dxchan;
+       my ($wwv_dxcc, $wwv_itu, $wwv_cq, $org_dxcc, $org_itu, $org_cq) = (0..0);
+       my @dxcc = Prefix::extract($_[7]);
+       if (@dxcc > 0) {
+               $wwv_dxcc = $dxcc[1]->dxcc;
+               $wwv_itu = $dxcc[1]->itu;
+               $wwv_cq = $dxcc[1]->cq;                                         
+       }
+       @dxcc = Prefix::extract($_[8]);
+       if (@dxcc > 0) {
+               $org_dxcc = $dxcc[1]->dxcc;
+               $org_itu = $dxcc[1]->itu;
+               $org_cq = $dxcc[1]->cq;                                         
+       }
        
        # send it if it isn't the except list and isn't isolated and still has a hop count
        # taking into account filtering and so on
@@ -1233,7 +1246,7 @@ sub send_wwv_spot
                my ($filter, $hops);
 
                if ($dxchan->{wwvfilter}) {
-                        ($filter, $hops) = $dxchan->{wwvfilter}->it(@_, $self->{call} );
+                       ($filter, $hops) = $dxchan->{wwvfilter}->it(@_, $self->{call}, $wwv_dxcc, $wwv_itu, $wwv_cq, $org_dxcc, $org_itu, $org_cq);
                         next unless $filter;
                }
                if ($dxchan->is_node) {
@@ -1269,6 +1282,19 @@ sub send_wcy_spot
        my $line = shift;
        my @dxchan = DXChannel->get_all();
        my $dxchan;
+       my ($wcy_dxcc, $wcy_itu, $wcy_cq, $org_dxcc, $org_itu, $org_cq) = (0..0);
+       my @dxcc = Prefix::extract($_[11]);
+       if (@dxcc > 0) {
+               $wcy_dxcc = $dxcc[1]->dxcc;
+               $wcy_itu = $dxcc[1]->itu;
+               $wcy_cq = $dxcc[1]->cq;                                         
+       }
+       @dxcc = Prefix::extract($_[12]);
+       if (@dxcc > 0) {
+               $org_dxcc = $dxcc[1]->dxcc;
+               $org_itu = $dxcc[1]->itu;
+               $org_cq = $dxcc[1]->cq;                                         
+       }
        
        # send it if it isn't the except list and isn't isolated and still has a hop count
        # taking into account filtering and so on
@@ -1277,7 +1303,7 @@ sub send_wcy_spot
                my ($filter, $hops);
 
                if ($dxchan->{wcyfilter}) {
-                        ($filter, $hops) = $dxchan->{wcyfilter}->it(@_, $self->{call} );
+                       ($filter, $hops) = $dxchan->{wcyfilter}->it(@_, $self->{call}, $wcy_dxcc, $wcy_itu, $wcy_cq, $org_dxcc, $org_itu, $org_cq);
                         next unless $filter;
                }
                if ($dxchan->is_clx || $dxchan->is_spider || $dxchan->is_dxnet) {
@@ -1332,6 +1358,21 @@ sub send_announce
        
        Log('ann', $target, $_[0], $text);
 
+       # obtain country codes etc 
+       my ($ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) = (0..0);
+       my @dxcc = Prefix::extract($_[0]);
+       if (@dxcc > 0) {
+               $ann_dxcc = $dxcc[1]->dxcc;
+               $ann_itu = $dxcc[1]->itu;
+               $ann_cq = $dxcc[1]->cq;                                         
+       }
+       @dxcc = Prefix::extract($_[4]);
+       if (@dxcc > 0) {
+               $org_dxcc = $dxcc[1]->dxcc;
+               $org_itu = $dxcc[1]->itu;
+               $org_cq = $dxcc[1]->cq;                                         
+       }
+
        # send it if it isn't the except list and isn't isolated and still has a hop count
        # taking into account filtering and so on
        foreach $dxchan (@dxchan) {
@@ -1339,19 +1380,6 @@ sub send_announce
                my ($filter, $hops);
 
                if ($dxchan->{annfilter}) {
-                       my ($ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) = (0..0);
-                       my @dxcc = Prefix::extract($_[0]);
-                       if (@dxcc > 0) {
-                               $ann_dxcc = $dxcc[1]->dxcc;
-                               $ann_itu = $dxcc[1]->itu;
-                               $ann_cq = $dxcc[1]->cq;                                         
-                       }
-                       @dxcc = Prefix::extract($_[4]);
-                       if (@dxcc > 0) {
-                               $org_dxcc = $dxcc[1]->dxcc;
-                               $org_itu = $dxcc[1]->itu;
-                               $org_cq = $dxcc[1]->cq;                                         
-                       }
                        ($filter, $hops) = $dxchan->{annfilter}->it(@_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq);
                        next unless $filter;
                } 

diff --git a/perl/Geomag.pm b/perl/Geomag.pm
index 037dcc50be74637e6d4721f962066789dd3b6106..6b6d778dbeb62bae791722688f5728d17018df99 100644 (file)
--- a/perl/Geomag.pm
+++ b/perl/Geomag.pm
@@ -21,7 +21,7 @@ use DXDupe;
 use strict;
 use vars qw($date $sfi $k $a $r $forecast @allowed @denied $fp $node $from 
             $dirprefix $param
-            $duplth $dupage);
+            $duplth $dupage $filterdef);
 
 $fp = 0;                                               # the DXLog fcb
 $date = 0;                                             # the unix time of the WWV (notional)
@@ -40,6 +40,19 @@ $dupage = 12*3600;                           # the length of time to hold spot dups
 $dirprefix = "$main::data/wwv";
 $param = "$dirprefix/param";
 
+$filterdef = bless ([
+                         # tag, sort, field, priv, special parser 
+                         ['by', 'c', 7],
+                         ['origin', 'c', 8],
+                         ['channel', 'n', 9],
+                         ['by_dxcc', 'n', 10],
+                         ['by_itu', 'n', 11],
+                         ['by_zone', 'n', 12],
+                         ['origin_dxcc', 'c', 13],
+                         ['origin_itu', 'c', 14],
+                         ['origin_itu', 'c', 15],
+                        ], 'Filter::Cmd');
+
 sub init
 {
        $fp = DXLog::new('wwv', 'dat', 'm');

diff --git a/perl/WCY.pm b/perl/WCY.pm
index 3949e5e439e646ac5d6c8f6962e8a965a2bb04c7..ee9679c648c776fa763d159387e8c1827279dce9 100644 (file)
--- a/perl/WCY.pm
+++ b/perl/WCY.pm
@@ -20,7 +20,7 @@ use Data::Dumper;
 use strict;
 use vars qw($date $sfi $k $expk $a $r $sa $gmf $au  @allowed @denied $fp $node $from 
             $dirprefix $param
-            $duplth $dupage);
+            $duplth $dupage $filterdef);
 
 $fp = 0;                                               # the DXLog fcb
 $date = 0;                                             # the unix time of the WWV (notional)
@@ -41,6 +41,20 @@ $dupage = 12*3600;                           # the length of time to hold spot dups
 $dirprefix = "$main::data/wcy";
 $param = "$dirprefix/param";
 
+$filterdef = bless ([
+                         # tag, sort, field, priv, special parser 
+                         ['by', 'c', 11],
+                         ['origin', 'c', 12],
+                         ['channel', 'n', 13],
+                         ['by_dxcc', 'n', 14],
+                         ['by_itu', 'n', 15],
+                         ['by_zone', 'n', 16],
+                         ['origin_dxcc', 'c', 17],
+                         ['origin_itu', 'c', 18],
+                         ['origin_itu', 'c', 19],
+                        ], 'Filter::Cmd');
+
+
 sub init
 {
        $fp = DXLog::new('wcy', 'dat', 'm');