allow - in filters
authorminima <minima>
Fri, 3 Nov 2000 22:25:23 +0000 (22:25 +0000)
committerminima <minima>
Fri, 3 Nov 2000 22:25:23 +0000 (22:25 +0000)
store only filter expressions
added announce filters
fixed problem with dxcc,itu and cq values on output announce filters

Changes
cmd/Commands_en.hlp
cmd/accept/announce.pl [new file with mode: 0644]
cmd/accept/spots.pl
cmd/clear/announce.pl [new file with mode: 0644]
cmd/reject/announce.pl [new file with mode: 0644]
cmd/reject/spots.pl
perl/AnnTalk.pm
perl/DXProt.pm
perl/Filter.pm
perl/Spot.pm

diff --git a/Changes b/Changes
index 9f0433f7e5bcdec15dc2a266e4e805c4a81ce3f6..12b4ea09988edf6b555c2e34766a62be0ce0dceb 100644 (file)
--- 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.
index 6f60c2a91833382a3b7671a0d70f6033bacf66e4..971765143762bae70c641a083b8f242e3b0aea51 100644 (file)
 #
 # Comment lines are indented before printing
 #
+=== 0^ACCEPT/ANNOUNCE [0-9] <pattern>^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 <string>            eg: iota or qsl
+  by <prefixes>            eg: G,M,2         
+  origin <prefixes>
+  origin_dxcc <numbers>    eg: 61,62 (from eg: sh/pre G)
+  origin_itu <numbers>
+  origin_zone <numbers>
+  by_dxcc <numbers>
+  by_itu <numbers>
+  by_zone <numbers>
+  channel <prefixes>
+  wx 1                     filter WX announces
+  dest <prefixes>          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 <call> [input] [0-9] <pattern>^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] <pattern>^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 <call> [input] [0-9] <pattern>^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] <pattern>^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 <string>            eg: iota or qsl
+  by <prefixes>            eg: G,M,2         
+  origin <prefixes>
+  origin_dxcc <numbers>    eg: 61,62 (from eg: sh/pre G)
+  origin_itu <numbers>
+  origin_zone <numbers>
+  by_dxcc <numbers>
+  by_itu <numbers>
+  by_zone <numbers>
+  channel <prefixes>
+  wx 1                     filter WX announces
+  dest <prefixes>          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 <call> [input] [0-9] <pattern>^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] <pattern>^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 (file)
index 0000000..1b028e9
--- /dev/null
@@ -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})); 
index 1c06dbe337783e0c3cee68732f758a7d8e85a857..b35770de6f67a62a28a9db5312b5952630dbb214 100644 (file)
@@ -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 (file)
index 0000000..41b29b4
--- /dev/null
@@ -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 (file)
index 0000000..9783185
--- /dev/null
@@ -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})); 
index b07493219b4c63d43f10ee0eb90dbaba1fa78226..f8f7615cd33f09c2109cad18d3433578bf4aba41 100644 (file)
@@ -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})); 
index 341857450be90e8e45dd5003fed742875d645682..a74c0e250495bfdd7c1ae0603a285ddbeb8f45ed 100644 (file)
@@ -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
index 441edc6138110705f8bddaada25999252178937c..f429c7ce93196e09ede58025bdb7b8b5b2808d2a 100644 (file)
@@ -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;
index 226aff4a22987f820934fcbfef9b11f7f4b124dc..6359b319dfd14c2d839dbd334e812a4e7e7afd45 100644 (file)
@@ -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;
index 4c7ab06e3bd94b15b7f6be5afcc4a6f5085244f2..9c10796b8ef4f924f9dc46cbb4eeb9c5053d5cb2 100644 (file)
@@ -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