allow - in filters

store only filter expressions
added announce filters
fixed problem with dxcc,itu and cq values on output announce filters

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.
 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 6f60c2a91833382a3b7671a0d70f6033bacf66e4..971765143762bae70c641a083b8f242e3b0aea51 100644 (file)
--- a/cmd/Commands_en.hlp
+++ b/cmd/Commands_en.hlp
@@ -11,6 +11,48 @@
 #
 # Comment lines are indented before printing
 #
 #
 # 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. 
 
 === 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:
 
 
 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
 
 === 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
 
 === 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
 === 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
 
 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
+++ 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 1c06dbe337783e0c3cee68732f758a7d8e85a857..b35770de6f67a62a28a9db5312b5952630dbb214 100644 (file)
--- a/cmd/accept/spots.pl
+++ b/cmd/accept/spots.pl
@@ -7,27 +7,8 @@
 #
 
 my ($self, $line) = @_;
 #
 
 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
+++ 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 (file)
index 0000000..9783185
--- /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 b07493219b4c63d43f10ee0eb90dbaba1fa78226..f8f7615cd33f09c2109cad18d3433578bf4aba41 100644 (file)
--- a/cmd/reject/spots.pl
+++ b/cmd/reject/spots.pl
@@ -7,27 +7,8 @@
 #
 
 my ($self, $line) = @_;
 #
 
 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 341857450be90e8e45dd5003fed742875d645682..a74c0e250495bfdd7c1ae0603a285ddbeb8f45ed 100644 (file)
--- a/perl/AnnTalk.pm
+++ b/perl/AnnTalk.pm
@@ -15,10 +15,26 @@ use DXDebug;
 use DXDupe;
 use DXVars;
 
 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
 
 $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
 
 
 # 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 441edc6138110705f8bddaada25999252178937c..f429c7ce93196e09ede58025bdb7b8b5b2808d2a 100644 (file)
--- 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);
 
                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;                                         
                        }
                        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;
                        if (@dxcc > 0) {
                                $org_dxcc = $dxcc[1]->dxcc;
                                $org_itu = $dxcc[1]->itu;

diff --git a/perl/Filter.pm b/perl/Filter.pm
index 226aff4a22987f820934fcbfef9b11f7f4b124dc..6359b319dfd14c2d839dbd334e812a4e7e7afd45 100644 (file)
--- 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
 #
 # 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) = @_;
 sub read_in
 {
        my ($sort, $call, $flag) = @_;


@@ -94,25 +115,8 @@ sub read_in
                        my $filter;
                        my $key;
                        foreach $key ($newin->getfilkeys) {
                        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;
                        }
                }
                return $newin;


@@ -327,7 +331,7 @@ use vars qw(@ISA);
 # this is called as a subroutine not as a method
 sub parse
 {
 # 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;
        my $ntoken = 0;
        my $fno = 1;
        my $filter;


@@ -336,7 +340,7 @@ sub parse
        my $user;
        
        # check the line for non legal characters
        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;
        
        # add some spaces for ease of parsing
        $line =~ s/([\(\)])/ $1 /g;


@@ -362,8 +366,8 @@ sub parse
                                $fno = shift @f;
                        }
 
                                $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;
                        
                        $ntoken++;
                        next;


@@ -481,7 +485,35 @@ sub parse
        $user =~ s/\!/ not /g;
        $user =~ s/\s+/ /g;
        
        $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;
 }
 
 package Filter::Old;

diff --git a/perl/Spot.pm b/perl/Spot.pm
index 4c7ab06e3bd94b15b7f6be5afcc4a6f5085244f2..9c10796b8ef4f924f9dc46cbb4eeb9c5053d5cb2 100644 (file)
--- a/perl/Spot.pm
+++ b/perl/Spot.pm
@@ -44,6 +44,14 @@ $filterdef = bless ([
                         ], 'Filter::Cmd');
 
 
                         ], 'Filter::Cmd');
 
 

+# create a Spot Object
+sub new
+{
+       my $class = shift;
+       my $self = [ @_ ];
+       return bless $self, $class;
+}
+

 sub decodefreq
 {
        my $dxchan = shift;
 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 $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 
        my $buf = join("\^", @out);
 
        # compare dates to see whether need to open another save file (remember, redefining $fp