From 956e3acab807900fdbccc0e2fa5e999327a1c1ce Mon Sep 17 00:00:00 2001 From: minima Date: Fri, 3 Nov 2000 22:25:23 +0000 Subject: [PATCH] allow - in filters store only filter expressions added announce filters fixed problem with dxcc,itu and cq values on output announce filters --- Changes | 6 +++ cmd/Commands_en.hlp | 84 +++++++++++++++++++++++++++++++++++++++++- cmd/accept/announce.pl | 14 +++++++ cmd/accept/spots.pl | 27 ++------------ cmd/clear/announce.pl | 37 +++++++++++++++++++ cmd/reject/announce.pl | 14 +++++++ cmd/reject/spots.pl | 27 ++------------ perl/AnnTalk.pm | 18 ++++++++- perl/DXProt.pm | 4 +- perl/Filter.pm | 80 ++++++++++++++++++++++++++++------------ perl/Spot.pm | 10 ++++- 11 files changed, 245 insertions(+), 76 deletions(-) create mode 100644 cmd/accept/announce.pl create mode 100644 cmd/clear/announce.pl create mode 100644 cmd/reject/announce.pl diff --git a/Changes b/Changes index 9f0433f7..12b4ea09 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,9 @@ +03Nov00======================================================================= +1. allow - in filter strings +2. store only the filter expression NOTE BENE: you will need to clear all +your existing filters and re-enter them!!!!!! +3. Added announce filtering +4. Fixed problem with announce filtering on output to the node 02Nov00======================================================================= 1. updated filtering logic. You will need to RECREATE your filters (clear/spot all, then start again) for testing. diff --git a/cmd/Commands_en.hlp b/cmd/Commands_en.hlp index 6f60c2a9..97176514 100644 --- a/cmd/Commands_en.hlp +++ b/cmd/Commands_en.hlp @@ -11,6 +11,48 @@ # # Comment lines are indented before printing # +=== 0^ACCEPT/ANNOUNCE [0-9] ^Set an 'accept' filter line for announce +Create an 'accept this announce' line for a filter. + +An accept filter line means that if the announce matches this filter it is +passed onto the user. See HELP FILTERS for more info. Please read this +to understand how filters work - it will save a lot of grief later on. + +You can use any of the following things in this line:- + + info eg: iota or qsl + by eg: G,M,2 + origin + origin_dxcc eg: 61,62 (from eg: sh/pre G) + origin_itu + origin_zone + by_dxcc + by_itu + by_zone + channel + wx 1 filter WX announces + dest eg: 6MUK,WDX (distros) + +some examples:- + + acc/ann dest 6MUK + acc/ann 2 by_zone 14,15,16 + (this could be all on one line: acc/ann dest 6MUK or by_zone 14,15,16) +or + acc/ann by G,M,2 + +You can use the tag 'all' to reject everything that is left, eg: + + acc/ann all + +=== 8^ACCEPT/ANNOUNCE [input] [0-9] ^Announce filter sysop version +This version allows a sysop to set a filter for a callsign as well as the +default for nodes and users eg:- + + accept/ann by G,M,2 + accept/ann input node_default by G,M,2 + accept/ann user_default by G,M,2 + === 0^ACCEPT/SPOTS [0-9] ^Set an 'accept' filter line for spots Create an 'accept this spot' line for a filter. @@ -40,7 +82,7 @@ some examples:- You can use the tag 'all' to reject everything that is left, eg: - rej/spot 3 all + ann/spot 3 all === 8^ACCEPT/SPOTS [input] [0-9] ^Spot filter sysop version This version allows a sysop to set a filter for a callsign as well as the @@ -594,8 +636,46 @@ message either sent by or sent to your callsign. === 5^READ-^ As a sysop you may read any message on the system +=== 0^REJECT/ANNOUNCE [0-9] ^Set an 'reject' filter line for announce +Create an 'reject this announce' line for a filter. + +An reject filter line means that if the announce matches this filter it is +passed onto the user. See HELP FILTERS for more info. Please read this +to understand how filters work - it will save a lot of grief later on. + +You can use any of the following things in this line:- + + info eg: iota or qsl + by eg: G,M,2 + origin + origin_dxcc eg: 61,62 (from eg: sh/pre G) + origin_itu + origin_zone + by_dxcc + by_itu + by_zone + channel + wx 1 filter WX announces + dest eg: 6MUK,WDX (distros) + +some examples:- + + rej/ann by_zone 14,15,16 and not by G,M,2 + +You can use the tag 'all' to reject everything that is left, eg: + + rej/ann all + +=== 8^REJECT/ANNOUNCE [input] [0-9] ^Announce filter sysop version +This version allows a sysop to set a filter for a callsign as well as the +default for nodes and users eg:- + + reject/ann by G,M,2 + reject/ann input node_default by G,M,2 + reject/ann user_default by G,M,2 + === 0^REJECT/SPOTS [0-9] ^Set an 'reject' filter line for spots -Create an 'accept this spot' line for a filter. +Create an 'reject this spot' line for a filter. An reject filter line means that if the spot matches this filter it is dumped (not passed on). See HELP FILTERS for more info. Please read this diff --git a/cmd/accept/announce.pl b/cmd/accept/announce.pl new file mode 100644 index 00000000..1b028e92 --- /dev/null +++ b/cmd/accept/announce.pl @@ -0,0 +1,14 @@ +# +# accept/reject filter commands +# +# Copyright (c) 2000 Dirk Koopman G1TLH +# +# $Id$ +# + +my ($self, $line) = @_; +my $type = 'accept'; +my $sort = 'ann'; + +my ($r, $filter, $fno) = $AnnTalk::filterdef->cmd($self, $sort, $type, $line); +return (0, $r ? $r : $self->msg('filter1', $fno, $filter->{name})); diff --git a/cmd/accept/spots.pl b/cmd/accept/spots.pl index 1c06dbe3..b35770de 100644 --- a/cmd/accept/spots.pl +++ b/cmd/accept/spots.pl @@ -7,27 +7,8 @@ # my ($self, $line) = @_; -my $sort = 'accept'; +my $type = 'accept'; +my $sort = 'spots'; -return (0, $self->msg('filter5')) unless $line; - -my ($r, $filter, $fno, $user, $s) = $Spot::filterdef->parse($self, $line); -return (0, $filter) if $r; - -my $fn = "filter$fno"; - -$filter->{$fn} = {} unless exists $filter->{$fn}; -$filter->{$fn}->{$sort} = {} unless exists $filter->{$fn}->{$sort}; - -$filter->{$fn}->{$sort}->{user} = $user; -my $ref = eval $s; -return (0, $s, $@) if $@; - -$filter->{$fn}->{$sort}->{asc} = $s; -$r = $filter->write; -return (0, $r) if $r; - -$filter->{$fn}->{$sort}->{code} = $ref; -$filter->install; - -return (0, $self->msg('filter1', $fno, $filter->{name})); +my ($r, $filter, $fno) = $Spot::filterdef->cmd($self, $sort, $type, $line); +return (0, $r ? $r : $self->msg('filter1', $fno, $filter->{name})); diff --git a/cmd/clear/announce.pl b/cmd/clear/announce.pl new file mode 100644 index 00000000..41b29b42 --- /dev/null +++ b/cmd/clear/announce.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 = 'ann'; +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/announce.pl b/cmd/reject/announce.pl new file mode 100644 index 00000000..9783185e --- /dev/null +++ b/cmd/reject/announce.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) = $AnnTalk::filterdef->cmd($self, $sort, $type, $line); +return (0, $r ? $r : $self->msg('filter1', $fno, $filter->{name})); diff --git a/cmd/reject/spots.pl b/cmd/reject/spots.pl index b0749321..f8f7615c 100644 --- a/cmd/reject/spots.pl +++ b/cmd/reject/spots.pl @@ -7,27 +7,8 @@ # my ($self, $line) = @_; -my $sort = 'reject'; +my $type = 'reject'; +my $sort = 'spots'; -return (0, $self->msg('filter5')) unless $line; - -my ($r, $filter, $fno, $user, $s) = $Spot::filterdef->parse($self, $line); -return (0, $filter) if $r; - -my $fn = "filter$fno"; - -$filter->{$fn} = {} unless exists $filter->{$fn}; -$filter->{$fn}->{$sort} = {} unless exists $filter->{$fn}->{$sort}; - -$filter->{$fn}->{$sort}->{user} = $user; -my $ref = eval $s; -return (0, $s, $@) if $@; - -$filter->{$fn}->{$sort}->{asc} = $s; -$r = $filter->write; -return (0, $r) if $r; - -$filter->{$fn}->{$sort}->{code} = $ref; -$filter->install; - -return (0, $self->msg('filter1', $fno, $filter->{name})); +my ($r, $filter, $fno) = $Spot::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 34185745..a74c0e25 100644 --- a/perl/AnnTalk.pm +++ b/perl/AnnTalk.pm @@ -15,10 +15,26 @@ use DXDebug; use DXDupe; use DXVars; -use vars qw(%dup $duplth $dupage); +use vars qw(%dup $duplth $dupage $filterdef); $duplth = 60; # the length of text to use in the deduping $dupage = 5*24*3600; # the length of time to hold spot dups +$filterdef = bless ([ + # tag, sort, field, priv, special parser + ['by', 'c', 0], + ['dest', 'c', 1], + ['info', 't', 2], + ['group', 't', 3], + ['wx', 't', 5], + ['origin', 'c', 7, 4], + ['origin_dxcc', 'c', 10], + ['origin_itu', 'c', 11], + ['origin_itu', 'c', 12], + ['by_dxcc', 'n', 7], + ['by_itu', 'n', 8], + ['by_zone', 'n', 9], + ['channel', 'n', 6], + ], 'Filter::Cmd'); # enter the spot for dup checking and return true if it is already a dup diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 441edc61..f429c7ce 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -1291,13 +1291,13 @@ sub send_announce if ($dxchan->{annfilter}) { my ($ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) = (0..0); - my @dxcc = Prefix::extract($_[1]); + 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($_[5]); + @dxcc = Prefix::extract($_[4]); if (@dxcc > 0) { $org_dxcc = $dxcc[1]->dxcc; $org_itu = $dxcc[1]->itu; diff --git a/perl/Filter.pm b/perl/Filter.pm index 226aff4a..6359b319 100644 --- a/perl/Filter.pm +++ b/perl/Filter.pm @@ -76,6 +76,27 @@ sub getfn # in with a 'do' statement. The 'do' statement reads the filter into # @in which is a list of references # +sub compile +{ + my $self = shift; + my $fname = shift; + my $ar = shift; + my $ref = $self->{$fname}; + my $rr; + + if ($ref->{$ar} && exists $ref->{$ar}->{asc}) { + $ref->{$ar}->{code} = eval "sub { my \$r=shift; return $ref->{$ar}->{asc}; }" ; + if ($@) { + my $sort = $ref->{sort}; + my $name = $ref->{name}; + dbg('err', "Error compiling $ar $sort $name: $@"); + Log('err', "Error compiling $ar $sort $name: $@"); + } + $rr = $@; + } + return $rr; +} + sub read_in { my ($sort, $call, $flag) = @_; @@ -94,25 +115,8 @@ sub read_in my $filter; my $key; foreach $key ($newin->getfilkeys) { - $filter = $newin->{$key}; - if ($filter->{reject} && exists $filter->{reject}->{asc}) { - $filter->{reject}->{code} = eval $filter->{reject}->{asc} ; - if ($@) { - my $sort = $newin->{sort}; - my $name = $newin->{name}; - dbg('err', "Error compiling reject $sort $key $name: $@"); - Log('err', "Error compiling reject $sort $key $name: $@"); - } - } - if ($filter->{accept} && exists $filter->{accept}->{asc}) { - $filter->{accept}->{code} = eval $filter->{accept}->{asc} ; - if ($@) { - my $sort = $newin->{sort}; - my $name = $newin->{name}; - dbg('err', "Error compiling accept $sort $key $name: $@"); - Log('err', "Error compiling accept $sort $key $name: $@"); - } - } + $newin->compile($key, 'reject'); + $newin->compile($key, 'accept'); } } return $newin; @@ -327,7 +331,7 @@ use vars qw(@ISA); # this is called as a subroutine not as a method sub parse { - my ($self, $dxchan, $line) = @_; + my ($self, $dxchan, $sort, $line) = @_; my $ntoken = 0; my $fno = 1; my $filter; @@ -336,7 +340,7 @@ sub parse my $user; # check the line for non legal characters - return ('ill', $dxchan->msg('e19')) if $line =~ /[^\s\w,_\*\/\(\)]/; + return ('ill', $dxchan->msg('e19')) if $line =~ /[^\s\w,_\-\*\/\(\)]/; # add some spaces for ease of parsing $line =~ s/([\(\)])/ $1 /g; @@ -362,8 +366,8 @@ sub parse $fno = shift @f; } - $filter = Filter::read_in('spots', $call, $flag); - $filter = Filter->new('spots', $call, $flag) unless $filter; + $filter = Filter::read_in($sort, $call, $flag); + $filter = Filter->new($sort, $call, $flag) unless $filter; $ntoken++; next; @@ -481,7 +485,35 @@ sub parse $user =~ s/\!/ not /g; $user =~ s/\s+/ /g; - return (0, $filter, $fno, $user, "sub { my \$r = shift; return ($s) ? 1 : 0 }"); + return (0, $filter, $fno, $user, "$s"); +} + +# a filter accept/reject command +sub cmd +{ + my ($self, $dxchan, $sort, $type, $line) = @_; + + return $dxchan->msg('filter5') unless $line; + + my ($r, $filter, $fno, $user, $s) = $self->parse($dxchan, $sort, $line); + return (1,$filter) if $r; + + my $fn = "filter$fno"; + + $filter->{$fn} = {} unless exists $filter->{$fn}; + $filter->{$fn}->{$type} = {} unless exists $filter->{$fn}->{$type}; + + $filter->{$fn}->{$type}->{user} = $user; + $filter->{$fn}->{$type}->{asc} = $s; + $r = $filter->compile($fn, $type); + return (1,$r) if $r; + + $r = $filter->write; + return (1,$r) if $r; + + $filter->install; + + return (0, $filter, $fno); } package Filter::Old; diff --git a/perl/Spot.pm b/perl/Spot.pm index 4c7ab06e..9c10796b 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -44,6 +44,14 @@ $filterdef = bless ([ ], 'Filter::Cmd'); +# create a Spot Object +sub new +{ + my $class = shift; + my $self = [ @_ ]; + return bless $self, $class; +} + sub decodefreq { my $dxchan = shift; @@ -113,7 +121,7 @@ sub add my $spotter_cq = (@dxcc > 0 ) ? $dxcc[1]->cq() : 0; push @out, $spotter_dxcc; push @out, $spot[5]; - + my $buf = join("\^", @out); # compare dates to see whether need to open another save file (remember, redefining $fp -- 2.34.1