From 15a742ea0f1983282fdff272a362555afbdb99ad Mon Sep 17 00:00:00 2001 From: minima Date: Tue, 24 Oct 2000 17:40:37 +0000 Subject: [PATCH] no text line msgs should now propagate add dxcc, itu and cq to ann filters add default filters for user and nodes --- Changes | 5 +++++ filter/ann/GB7MBC.pl.issue | 6 +++++ perl/DXChannel.pm | 6 ----- perl/DXCommandmode.pm | 6 +++++ perl/DXMsg.pm | 10 ++------- perl/DXProt.pm | 46 +++++++++++++++++++++++++++++++++----- perl/Prefix.pm | 1 + 7 files changed, 60 insertions(+), 20 deletions(-) diff --git a/Changes b/Changes index 55665b06..1b2fd6da 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,11 @@ 24Oct00======================================================================= 1. added cty.dat from http://www.k1ea.com/cty/index.htm to the prefix_data.pl data file and modified create_prefix.pl accordingly. +2. the 'no text line' messages should now propagate correctly +3. added the dxcc, itu and cq zone numbers for announcer and origining node +on announce filters - see the /spider/filter/ann/*.issue files for more info. +4. you can now specify a 'user_default.pl', 'node_default.pl' and +'in_node_default.pl' in each of the filter directories 23Oct00======================================================================= 1. Added K5K as Kingman Reef 1. Added K7K as Kure diff --git a/filter/ann/GB7MBC.pl.issue b/filter/ann/GB7MBC.pl.issue index 5d37fb63..fb81021f 100644 --- a/filter/ann/GB7MBC.pl.issue +++ b/filter/ann/GB7MBC.pl.issue @@ -9,6 +9,12 @@ # 4 - origin # 5 - 0 - announce, 1 - wx # 6 - channel callsign (the interface from which this spot came) +# 7 - announcer country no (as from sh/prefix) +# 8 - announcer itu no +# 9 - announcer cq zone +# 10 - origin country no (as from sh/prefix) +# 11 - origin itu no +# 12 - origin cq zone $in = [ [ 1, 0, 'a', '^(P[ABCDE]|G|M|2|EI|F|ON|LX|HB9)' ], diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index d975ca0d..9d52d67c 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -133,12 +133,6 @@ sub alloc $self->{lang} = $main::lang if !$self->{lang}; $self->{func} = ""; - # get the filters - $self->{spotfilter} = Filter::read_in('spots', $call, 0); - $self->{wwvfilter} = Filter::read_in('wwv', $call, 0); - $self->{wcyfilter} = Filter::read_in('wcy', $call, 0); - $self->{annfilter} = Filter::read_in('ann', $call, 0); - bless $self, $pkg; return $channels{$call} = $self; } diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index e7cf7e97..b0d23af2 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -81,6 +81,12 @@ sub start $self->{logininfo} = $user->wantlogininfo; $self->{here} = 1; + # get the filters + $self->{spotfilter} = Filter::read_in('spots', $call, 0) || Filter::read_in('spots', 'user_default', 0); + $self->{wwvfilter} = Filter::read_in('wwv', $call, 0) || Filter::read_in('wwv', 'user_default', 0); + $self->{wcyfilter} = Filter::read_in('wcy', $call, 0) || Filter::read_in('wcy', 'user_default', 0); + $self->{annfilter} = Filter::read_in('ann', $call, 0) || Filter::read_in('ann', 'user_default', 0) ; + # clean up qra locators my $qra = $user->qra; $qra = undef if ($qra && !DXBearing::is_qra($qra)); diff --git a/perl/DXMsg.pm b/perl/DXMsg.pm index f9ede90c..55834fc3 100644 --- a/perl/DXMsg.pm +++ b/perl/DXMsg.pm @@ -110,6 +110,7 @@ sub alloc $self->{rrreq} = shift; $self->{gotit} = []; $self->{lastt} = $main::systime; + $self->{lines} = []; return $self; } @@ -122,7 +123,6 @@ sub workclean delete $ref->{tonode}; delete $ref->{fromnode}; delete $ref->{stream}; - delete $ref->{lines}; delete $ref->{file}; delete $ref->{count}; delete $ref->{lastt} if exists $ref->{lastt}; @@ -238,7 +238,6 @@ sub process $work{"$f[2]$f[3]"} = $ref; # new ref dbg('msg', "incoming subject ack stream $f[3]\n"); $busy{$f[2]} = $ref; # interlock - $ref->{lines} = []; push @{$ref->{lines}}, ($ref->read_msg_body); $ref->send_tranche($self); $ref->{lastt} = $main::systime; @@ -408,12 +407,7 @@ sub store { my $ref = shift; my $lines = shift; - - # we only proceed if there are actually any lines in the file -# if (!$lines || @{$lines} == 0) { -# return; -# } - + if ($ref->{file}) { # a file dbg('msg', "To be stored in $ref->{to}\n"); diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 1f2a6428..5d2b10b8 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -211,11 +211,18 @@ sub start $self->{consort} = $line; # save the connection type $self->{here} = 1; + # get the output filters + $self->{spotfilter} = Filter::read_in('spots', $call, 0) || Filter::read_in('spots', 'node_default', 0); + $self->{wwvfilter} = Filter::read_in('wwv', $call, 0) || Filter::read_in('wwv', 'node_default', 0); + $self->{wcyfilter} = Filter::read_in('wcy', $call, 0) || Filter::read_in('wcy', 'node_default', 0); + $self->{annfilter} = Filter::read_in('ann', $call, 0) || Filter::read_in('ann', 'node_default', 0) ; + + # get the INPUT filters (these only pertain to Clusters) - $self->{inspotfilter} = Filter::read_in('spots', $call, 1); - $self->{inwwvfilter} = Filter::read_in('wwv', $call, 1); - $self->{inwcyfilter} = Filter::read_in('wcy', $call, 1); - $self->{inannfilter} = Filter::read_in('ann', $call, 1); + $self->{inspotfilter} = Filter::read_in('spots', $call, 1) || Filter::read_in('spots', 'node_default', 1); + $self->{inwwvfilter} = Filter::read_in('wwv', $call, 1) || Filter::read_in('wwv', 'node_default', 1); + $self->{inwcyfilter} = Filter::read_in('wcy', $call, 1) || Filter::read_in('wcy', 'node_default', 1); + $self->{inannfilter} = Filter::read_in('ann', $call, 1) || Filter::read_in('ann', 'node_default', 1); # set unbuffered and no echo $self->send_now('B',"0"); @@ -446,7 +453,21 @@ sub normal # global ann filtering on INPUT if ($self->{inannfilter}) { - my ($filter, $hops) = Filter::it($self->{inannfilter}, @field[1..6], $self->{call} ); + my ($ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) = (0..0); + my @dxcc = Prefix::extract($field[1]); + if (@dxcc > 0) { + $ann_dxcc = $dxcc[1]->dxcc; + $ann_itu = $dxcc[1]->itu; + $ann_cq = $dxcc[1]->cq(); + } + @dxcc = Prefix::extract($field[5]); + if (@dxcc > 0) { + $org_dxcc = $dxcc[1]->dxcc; + $org_itu = $dxcc[1]->itu; + $org_cq = $dxcc[1]->cq(); + } + my ($filter, $hops) = Filter::it($self->{inannfilter}, @field[1..6], $self->{call}, + $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq); unless ($filter) { dbg('chan', "Rejected by filter"); return; @@ -1269,7 +1290,20 @@ sub send_announce my ($filter, $hops); if ($dxchan->{annfilter}) { - ($filter, $hops) = Filter::it($dxchan->{annfilter}, @_, $self->{call} ); + my ($ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) = (0..0); + my @dxcc = Prefix::extract($_[1]); + if (@dxcc > 0) { + $ann_dxcc = $dxcc[1]->dxcc; + $ann_itu = $dxcc[1]->itu; + $ann_cq = $dxcc[1]->cq; + } + @dxcc = Prefix::extract($_[5]); + if (@dxcc > 0) { + $org_dxcc = $dxcc[1]->dxcc; + $org_itu = $dxcc[1]->itu; + $org_cq = $dxcc[1]->cq; + } + ($filter, $hops) = Filter::it($dxchan->{annfilter}, @_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq); next unless $filter; } if ($dxchan->is_node && $_[1] ne $main::mycall) { # i.e not specifically routed to me diff --git a/perl/Prefix.pm b/perl/Prefix.pm index 2906e726..34f581d0 100644 --- a/perl/Prefix.pm +++ b/perl/Prefix.pm @@ -188,6 +188,7 @@ my %valid = ( itu => '0,ITU', cq => '0,CQ', utcoff => '0,UTC offset', + cont => '0,Continent', ); no strict; -- 2.43.0