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.
--- /dev/null
+#
+# 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}));
--- /dev/null
+#
+# 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}));
--- /dev/null
+#
+# 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);
--- /dev/null
+#
+# 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);
--- /dev/null
+#
+# 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}));
--- /dev/null
+#
+# 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}));
['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');
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
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) {
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
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) {
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) {
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;
}
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)
$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');
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)
$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');
projects / spider.git / commitdiff