From 2b44cbaa7a18bf641aec3439384dd1fb10b99752 Mon Sep 17 00:00:00 2001 From: minima Date: Mon, 18 Dec 2000 14:16:43 +0000 Subject: [PATCH] Add new style filtering for WWV and WCY get the field nos correct for ANN Filters --- Changes | 2 ++ cmd/accept/wcy.pl | 14 ++++++++++++ cmd/accept/wwv.pl | 14 ++++++++++++ cmd/clear/wcy.pl | 37 ++++++++++++++++++++++++++++++ cmd/clear/wwv.pl | 37 ++++++++++++++++++++++++++++++ cmd/reject/wcy.pl | 14 ++++++++++++ cmd/reject/wwv.pl | 14 ++++++++++++ perl/AnnTalk.pm | 10 ++++---- perl/DXProt.pm | 58 +++++++++++++++++++++++++++++++++++------------ perl/Geomag.pm | 15 +++++++++++- perl/WCY.pm | 16 ++++++++++++- 11 files changed, 209 insertions(+), 22 deletions(-) create mode 100644 cmd/accept/wcy.pl create mode 100644 cmd/accept/wwv.pl create mode 100644 cmd/clear/wcy.pl create mode 100644 cmd/clear/wwv.pl create mode 100644 cmd/reject/wcy.pl create mode 100644 cmd/reject/wwv.pl diff --git a/Changes b/Changes index bf62d8a8..ce65beb7 100644 --- 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 index 00000000..bfa89dc2 --- /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 index 00000000..f19db5e8 --- /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 index 00000000..dfcc8da4 --- /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 index 00000000..01f1390f --- /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 index 00000000..fb3ad126 --- /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 index 00000000..3be6330f --- /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 5a387d21..b7eb1311 100644 --- 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 15f92c47..c7cd41b7 100644 --- 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 037dcc50..6b6d778d 100644 --- 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 3949e5e4..ee9679c6 100644 --- 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'); -- 2.43.0