]> dxcluster.org Git - spider.git/commitdiff
added all the spots filter commands - you luckey people
authorminima <minima>
Wed, 1 Nov 2000 21:27:39 +0000 (21:27 +0000)
committerminima <minima>
Wed, 1 Nov 2000 21:27:39 +0000 (21:27 +0000)
Changes
cmd/accept/spots.pl [new file with mode: 0644]
cmd/clear/spots.pl [new file with mode: 0644]
cmd/reject/spots.pl [new file with mode: 0644]
cmd/show/filter.pl [new file with mode: 0644]
perl/DXChannel.pm
perl/DXCommandmode.pm
perl/DXProt.pm
perl/Filter.pm
perl/Messages
perl/Spot.pm

diff --git a/Changes b/Changes
index 8807ce1a419c40a5099a9bda292bd6beaadb05a7..baf50ccf0e4f5e806b2a29ec6a95a6a42c4438dc 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,6 +1,39 @@
 01Nov00=======================================================================
 1. put PC11 field 2 check back to m for pc text.
 2. improve 'simple' callsign checking
+3. Added the first cut of the new user/sysop filtering code. This cut works 
+for spots and the syntax is:-
+
+accept/spots [<call>] [input] [<filterno>] things ..
+reject/spots [<call>] [input] [<filterno>] things ..
+
+where things are: 
+  freq 0/30000 | hf | hf/cw | 6m,4m,2m
+  call G,PA,HB9
+  info iota
+  by G,PA,HB9
+  call_dxcc 61,62
+  call_itu 31
+  call_zone 14,15,16
+  by_dxcc 61,62
+  by_itu 31
+  by_zone 14,15,16
+  origin GB7,MB7
+  channel GB7DJK,GB7BAA
+      
+You can simply string these together on one line one after the other and 
+there is an implied 'and', you can also string together with 'or' 'not' (or
+'!') and '(' and ')' - in otherwords an arbitrary expression.
+              
+You can see what you have done with:
+
+show/filter [<call>]
+
+You can clear your work with:
+
+clear/spots [<call>] [input] [<filterno>|all]
+
+Have fun and someone please write the documentation.
 31Oct00=======================================================================
 1. add 0x8e to the list of characters we clobber (make xterm go into graphics
 mode).
diff --git a/cmd/accept/spots.pl b/cmd/accept/spots.pl
new file mode 100644 (file)
index 0000000..a76e3b3
--- /dev/null
@@ -0,0 +1,31 @@
+#
+# accept/reject filter commands
+#
+# Copyright (c) 2000 Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my $sort = 'accept';
+
+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})); 
diff --git a/cmd/clear/spots.pl b/cmd/clear/spots.pl
new file mode 100644 (file)
index 0000000..bdce5c8
--- /dev/null
@@ -0,0 +1,35 @@
+#
+# 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 = 'spots';
+my $flag;
+my $fno = 1;
+my $call = $dxchan->call;
+
+my $f = lc shift @f if @f;
+if ($self->priv >= 8) {
+       my $uref = DXUser->get(uc $f);
+       $call = $uref->call if $uref;
+       $f = undef;
+       $f = lc shift @f if @f;
+       if ($f && $f eq 'input') {
+               $flag = 'in';
+               $f = undef;
+               $f = lc 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/spots.pl b/cmd/reject/spots.pl
new file mode 100644 (file)
index 0000000..0a3f77e
--- /dev/null
@@ -0,0 +1,31 @@
+#
+# accept/reject filter commands
+#
+# Copyright (c) 2000 Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+my ($self, $line) = @_;
+my $sort = 'reject';
+
+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})); 
diff --git a/cmd/show/filter.pl b/cmd/show/filter.pl
new file mode 100644 (file)
index 0000000..7289eed
--- /dev/null
@@ -0,0 +1,31 @@
+#
+# show filter commands
+#
+# Copyright (c) 2000 Dirk Koopman G1TLH
+#
+# $Id$
+#
+my ($self, $line) = @_;
+my @f = split /\s+/, $line;
+my @out;
+my $dxchan = $self;
+my $sort = '';
+
+my $f = lc shift @f if @f;
+if ($self->priv >= 8) {
+       my $d = DXChannel->get(uc $f);
+       $dxchan = $d if $d;
+       $f = lc shift @f if @f;
+}
+
+$sort = $f if $f;
+$sort .= 'filter';
+
+my $key;
+foreach $key (sort keys %$self) {
+       if ($key =~ /$sort$/) {
+               push @out, $self->{$key}->print if $self->{$key};
+       }
+}
+push @out, $self->msg('filter3', $dxchan->call) unless @out;
+return (1, @out);
index d566c177c05f07a1ac0b76eac0419db98934010e..140b7726e9e538081b90bfb6694cd53d2f048f89 100644 (file)
@@ -74,11 +74,11 @@ use vars qw(%channels %valid);
                  annfilter => '5,Announce Filter',
                  wwvfilter => '5,WWV Filter',
                  wcyfilter => '5,WCY Filter',
-                 spotfilter => '5,Spot Filter',
+                 spotsfilter => '5,Spot Filter',
                  inannfilter => '5,Input Ann Filter',
                  inwwvfilter => '5,Input WWV Filter',
                  inwcyfilter => '5,Input WCY Filter',
-                 inspotfilter => '5,Input Spot Filter',
+                 inspotsfilter => '5,Input Spot Filter',
                  passwd => '9,Passwd List,parray',
                  pingint => '5,Ping Interval ',
                  nopings => '5,Ping Obs Count',
@@ -102,10 +102,10 @@ sub DESTROY
        undef $self->{delayed};
        undef $self->{annfilter};
        undef $self->{wwvfilter};
-       undef $self->{spotfilter};
+       undef $self->{spotsfilter};
        undef $self->{inannfilter};
        undef $self->{inwwvfilter};
-       undef $self->{inspotfilter};
+       undef $self->{inspotsfilter};
        undef $self->{passwd};
        undef $self->{node};
 }
index 5f6262289d7a8db50bc32046fe3fd12fc4a35feb..72d65cb316ebd05d0d36d76fd7330bcfd7a28d50 100644 (file)
@@ -82,7 +82,7 @@ sub start
        $self->{here} = 1;
 
        # get the filters
-       $self->{spotfilter} = Filter::read_in('spots', $call, 0) || Filter::read_in('spots', 'user_default', 0);
+       $self->{spotsfilter} = 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) ;
index db342dfb028c5b0dd57d9fc6415024f167f2821b..9c7064d21cdfd3a0d943eb970b3a0bdf87423ab0 100644 (file)
@@ -70,7 +70,7 @@ $baddxfn = "$main::data/baddx.pl";
  [ qw(c c n n) ],                              # pc25
  [ qw(f m d t m c c bc) ],             # pc26
  [ qw(d n n n n m c c bc) ],   # pc27
- [ qw(c c c c d t p m bp n p bp bc) ], # pc28
+ [ qw(c c c m d t p m bp n p bp bc) ], # pc28
  [ qw(c c n m) ],                              # pc29
  [ qw(c c n) ],                                        # pc30
  [ qw(c c n) ],                                        # pc31
@@ -212,14 +212,14 @@ sub start
        $self->{here} = 1;
 
        # get the output filters
-       $self->{spotfilter} = Filter::read_in('spots', $call, 0) || Filter::read_in('spots', 'node_default', 0);
+       $self->{spotsfilter} = 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) || Filter::read_in('spots', 'node_default', 1);
+       $self->{inspotsfilter} = 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);
@@ -1138,8 +1138,8 @@ sub send_dx_spot
                my $routeit;
                my ($filter, $hops);
 
-               if ($dxchan->{spotfilter}) {
-                   ($filter, $hops) = $dxchan->{spotfilter}->it(@_, $self->{call} );
+               if ($dxchan->{spotsfilter}) {
+                   ($filter, $hops) = $dxchan->{spotsfilter}->it(@_, $self->{call} );
                        next unless $filter;
                }
                
@@ -1473,7 +1473,7 @@ sub broadcast_list
                
                if ($sort eq 'dx') {
                    next unless $dxchan->{dx};
-                       ($filter) = $dxchan->{spotfilter}->it(@{$fref}) if ref $fref;
+                       ($filter) = $dxchan->{spotsfilter}->it(@{$fref}) if ref $fref;
                        next unless $filter;
                }
                next if $sort eq 'ann' && !$dxchan->{ann};
index 060f7ea8d75e7637b6931ff02032624db26f574f..6a0dad7a9b5debfcdfd27168acc5284101e2481a 100644 (file)
@@ -51,13 +51,8 @@ sub new
        return bless {sort => $sort, name => "$flag$call.pl" }, $class;
 }
 
-# this reads in a filter statement and returns it as a list
-# 
-# The filter is stored in straight perl so that it can be parsed and read
-# in with a 'do' statement. The 'do' statement reads the filter into
-# @in which is a list of references
-#
-sub read_in
+# standard filename generator
+sub getfn
 {
        my ($sort, $call, $flag) = @_;
 
@@ -71,9 +66,23 @@ sub read_in
                $call = lc $call;
                $fn = "$filterbasefn/$sort/$flag$call.pl";
        }
+       $fn = undef unless -e $fn;
+       return $fn;
+}
+
+# this reads in a filter statement and returns it as a list
+# 
+# The filter is stored in straight perl so that it can be parsed and read
+# in with a 'do' statement. The 'do' statement reads the filter into
+# @in which is a list of references
+#
+sub read_in
+{
+       my ($sort, $call, $flag) = @_;
+       my $fn;
        
        # load it
-       if (-e $fn) {
+       if ($fn = getfn($sort, $call, $flag)) {
                $in = undef; 
                my $s = readfilestr($fn);
                my $newin = eval $s;
@@ -81,74 +90,87 @@ sub read_in
                if ($in) {
                        $newin = new('Filter::Old', $sort, $call, $flag);
                        $newin->{filter} = $in;
+               } else {
+                       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: $@");
+                                       }
+                               } 
+                       }
                }
                return $newin;
        }
        return undef;
 }
 
+sub getfilters
+{
+       my $self = shift;
+       my @out;
+       my $key;
+       foreach $key (grep {/^filter/ } keys %$self) {
+               push @out, $self->{$key};
+       }
+       return @out;
+}
+
+sub getfilkeys
+{
+       my $self = shift;
+       return grep {/^filter/ } keys %$self;
+}
+
 #
-# this routine accepts a composite filter with a reject component and then an accept
-# the filter returns 0 if an entry is matched by any reject rule and also if any
-# accept rule fails otherwise it returns 1
+# This routine accepts a composite filter with a reject rule and then an accept rule.
 #
-# the either set of rules may be missing meaning an implicit 'ok'
+# The filter returns 0 if an entry is matched by any reject rule and also if any
+# accept rule fails otherwise it returns 1
 #
-# reject rules are implicitly 'or' logic (any reject rules which fires kicks it out)
-# accept rules are implicitly 'and' logic (all accept rules must pass to indicate a match)
+# Either set of rules may be missing meaning an implicit 'ok'
 #
-# unlike the old system, this is kept as a hash of hashes so that you can
+# Unlike the old system, this is kept as a hash of hashes so that you can
 # easily change them by program.
 #
-# you can have a [any] number of 'filters', they are tried in random order until one matches
-#
-# an example in machine readable form:-
-#   bless ({
-#      name => 'G7BRN.pl',
-#      sort => 'spots',
-#      filter1 => {
-#                      user_rej => {
-#                              by_dxcc => 'W,VE',
-#                      },
-#              reject => {
-#                      by_dxcc => [6, 'n', 226,197],
-#              },
-#                      user_acc => {
-#                              freq => '0/30000',
-#                      },
-#              accept => {
-#                      freq => [0, 'r', 0, 30000],
-#              },
-#      },
-#      filter2 => {
-#                      user_acc => {
-#                              freq => 'vhf',
-#                              by_zone => '14,15,16',
-#                      },
-#              accept => {
-#                      freq => [0, 'r', 50000,52000,70000,70500,144000,148000],
-#                      by_zone => [11, 'n', 14,15,16],
-#              }
-#      },
-#   }, 'Filter');
-#
-# in user commands:-
-#
-#   clear/spots 1 2
-#   accept/spots 1 freq 0/30000
-#   reject/spots 1 by_dxcc W,VE
-#   accept/spots 2 freq vhf 
-#   accept/spots 2 by_zone 14,15,16
+# You can have a [any] number of 'filters', they are tried in random order until 
+# one matches
+#
+# There is a parser that takes a Filter::Cmd object which describes all the possible
+# things you can filter on and then converts that to a bit of perl which is compiled
+# and stored as a function.
+#
+# The result of this is that in theory you can put together an arbritrarily complex 
+# expression involving the things you can filter on including 'and' 'or' 'not' and 
+# 'brackets'.
+#
+# eg:-
+#
+# accept/spots hf and by_zone 14,15,16 and not by pa,on
+#  
+# accept/spots freq 0/30000 and by_zone 4,5
+# 
+# accept/spots 2 vhf and (by_zone 14,15,16 or call_dxcc 61) 
 #
 # no filter no implies filter 1
 #
 # The field nos are the same as for the 'Old' filters
 #
-# The user_* fields are there so that the structure can be listed easily
-# in human readable form when required. They are not used in the filtering
-# process itself.
-#
-# This defines an HF filter and a VHF filter (as it happens)
 # 
 
 sub it
@@ -156,54 +178,26 @@ sub it
        my $self = shift;
        
        my $hops = undef;
-       my $filter;
-       my $r;
+       my $r = 1;
                
-       my ($key, $ref, $field, $fieldsort, $comp);
-       L1: foreach $key (grep {/^filter/ } keys %$self) {
-                       my $filter = $self->{$key};
-                       $r = 0;
-                       if ($filter->{reject}) {
-                               foreach $ref (values %{$filter->{reject}}) {
-                                       ($field, $fieldsort) = @$ref[0,1];
-                                       my $val = $_[$field];
-                                       if ($fieldsort eq 'n') {
-                                               next L1 if grep $_ == $val, @{$ref}[2..$#$ref];
-                                       } elsif ($fieldsort eq 'r') {
-                                               my $i;
-                                               for ($i = 2; $i < @$ref; $i += 2) {
-                                                       next L1 if $val >= $ref->[$i] && $val <= $ref->[$i+1];
-                                               }
-                                       } elsif ($fieldsort eq 'a') {
-                                               next L1  if grep $val =~ m{$_}, @$ref[2..$#$ref];  
-                                       } 
-                               }
-                       }
-                       if ($filter->{accept}) {
-                               foreach $ref (values %{$filter->{accept}}) {
-                                       ($field, $fieldsort) = @$ref[0,1];
-                                       my $val = $_[$field];
-                                       if ($fieldsort eq 'n') {
-                                               next L1 unless grep $_ == $val, @{$ref}[2..$#$ref];
-                                       } elsif ($fieldsort eq 'r') {
-                                               my $i;
-                                               for ($i = 2; $i < @$ref; $i += 2) {
-                                                       next L1 unless $val >= $ref->[$i] && $val <= $ref->[$i+1];
-                                               }
-                                       } elsif ($fieldsort eq 'a') {
-                                               next L1 unless grep $val =~ m{$_}, @{$ref}[2..$#$ref];  
-                                       } 
-                               }
-                       } 
-                       $r = 1;
-                       last;
+       my $filter;
+       foreach $filter ($self->getfilters) {
+               $r = 0;
+               if ($filter->{reject} && exists $filter->{reject}->{code}) {
+                       next if &{$filter->{reject}->{code}}(\@_);                              
+               }
+               if ($filter->{accept} && exists $filter->{accept}->{code}) {
+                       next unless &{$filter->{accept}->{code}}(\@_);                          
+               } 
+               $r = 1;
+               last;
        }
 
        # hops are done differently 
        if ($self->{hops}) {
-               my $h;
+               my ($comp, $ref);
                while (($comp, $ref) = each %{$self->{hops}}) {
-                       ($field, $h) = @$ref;
+                       my ($field, $h) = @$ref;
                        if ($_[$field] =~ m{$comp}) {
                                $hops = $h;
                                last;
@@ -222,7 +216,7 @@ sub write
        my $name = $self->{name};
        my $dir = "$filterbasefn/$sort";
        my $fn = "$dir/$name";
-       
+
        mkdir $dir, 0775 unless -e $dir; 
     rename $fn, "$fn.o" if -e $fn;
        my $fh = new IO::File ">$fn";
@@ -243,7 +237,67 @@ sub write
 sub print
 {
        my $self = shift;
-       return $self->{name};
+       my @out;
+       my $name = $self->{name};
+       $name =~ s/.pl$//;
+       
+       push @out, join(' ',  $name , ':', $self->{sort});
+       my $filter;
+       my $key;
+       foreach $key (sort $self->getfilkeys) {
+               my $filter = $self->{$key};
+               if ($filter->{reject} && exists $filter->{reject}->{user}) {
+                       push @out, '   ' . join(' ', $key, 'reject', $filter->{reject}->{user});
+               }
+               if ($filter->{accept} && exists $filter->{accept}->{user}) {
+                       push @out, '   ' . join(' ', $key, 'accept', $filter->{accept}->{user});
+               } 
+       }
+       return @out;
+}
+
+sub install
+{
+       my $self = shift;
+       my $remove = shift;
+       my $name = uc $self->{name};
+       my $sort = $self->{sort};
+       my ($in) = $name =~ s/^IN_//;
+       $name =~ s/.PL$//;
+               
+       my $dxchan = DXChannel->get($name);
+       if ($dxchan) {
+               $in = lc $in if $in;
+               my $n = "$in$sort" . "filter";
+               $dxchan->$n($remove ? undef : $self);
+       }
+}
+
+sub delete
+{
+       my ($sort, $call, $flag, $fno) = @_;
+       
+       # look for the file
+       my $fn = getfn($sort, $call, $flag);
+       my $filter = read_in($sort, $call, $flag);
+       if ($filter) {
+               if ($fno eq 'all') {
+                       my $key;
+                       foreach $key ($filter->getfilkeys) {
+                               delete $filter->{$key};
+                       }
+               } elsif (exists $filter->{"filter$fno"}) {
+                       delete $filter->{"filter$fno"}; 
+               }
+               
+               # get rid 
+               if ($filter->{hops} || $filter->getfilkeys) {
+                       $filter->install;
+               } else {
+                       $filter->install(1);
+                       unlink $fn;
+               }
+       }
 }
 
 package Filter::Cmd;
@@ -254,21 +308,30 @@ use vars qw(@ISA);
 
 # the general purpose command processor
 # this is called as a subroutine not as a method
-sub process_cmd
+sub parse
 {
        my ($self, $dxchan, $line) = @_;
        my $ntoken = 0;
        my $fno = 1;
        my $filter;
        my ($flag, $call);
-
+       my $s;
+       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,_\*\/\(\)]/;
        
-       while (my @f = split /\s+/, $line) {
+       # add some spaces for ease of parsing
+       $line =~ s/([\(\)])/ $1 /g;
+       $line = lc $line;
+       
+       my @f = split /\s+/, $line;
+       my $conj = ' && ';
+       my $not = "";
+       while (@f) {
                if ($ntoken == 0) {
                        
-                       if (@f && $dxchan->priv >= 9 && DXUser->get($f[0])) {
+                       if (@f && $dxchan->priv >= 8 && (DXUser->get($f[0]) || $f[0] =~ /(?:node|user)_default/)) {
                                $call = shift @f;
                                if ($f[0] eq 'input') {
                                        shift @f;
@@ -278,11 +341,12 @@ sub process_cmd
                                $call = $dxchan->call;
                        }
 
-                       if (@f && $f[0] =~ /^\d+$/) {
+                       if (@f && $f[0] =~ /^\d$/) {
                                $fno = shift @f;
                        }
 
-                       $filter = Filter::read_in('spots', $call, $flag) or new Filter ('spots', $call, $flag);
+                       $filter = Filter::read_in('spots', $call, $flag);
+                       $filter = Filter->new('spots', $call, $flag) unless $filter;
                        
                        $ntoken++;
                        next;
@@ -291,23 +355,112 @@ sub process_cmd
                # do the rest of the filter tokens
                if (@f) {
                        my $tok = shift @f;
+                       if ($tok eq '(') {
+                               if ($s) {
+                                       $s .= $conj;
+                                       $user .= $conj;
+                                       $conj = "";
+                               }
+                               if ($not) {
+                                       $s .= $not;
+                                       $user .= $not;
+                                       $not = "";
+                               }
+                               $s .= $tok;
+                               $user .= $tok;
+                               next;
+                       } elsif ($tok eq ')') {
+                               $conj = ' && ';
+                               $not ="";
+                               $s .= $tok;
+                               $user .= $tok;
+                               next;
+                       } elsif ($tok eq 'or') {
+                               $conj = ' || ' if $conj ne ' || ';
+                               next;
+                       } elsif ($tok eq 'and') {
+                               $conj = ' && ' if $conj ne ' && ';
+                               next;
+                       } elsif ($tok eq 'not' || $tok eq '!') {
+                               $not = '!';
+                               next;
+                       }
                        if (@f) {
                                my $val = shift @f;
-
+                               my @val = split /,/, $val;
+
+                               if ($s) {
+                                       $s .= $conj ;
+                                       $s .= $not;
+                                       $user .= $conj;
+                                       $user .= $not;
+                                       $conj = ' && ';
+                                       $not = "";
+                               }
+                               $user .= "$tok $val";
+                               
                                my $fref;
+                               my $found;
                                foreach $fref (@$self) {
+                                       
                                        if ($fref->[0] eq $tok) {
-                                               
+                                               if ($fref->[4]) {
+                                                       my @nval;
+                                                       for (@val) {
+                                                               push @nval, split(',', &{$fref->[4]}($dxchan, $_));
+                                                       }
+                                                       @val = @nval;
+                                               }
+                                               if ($fref->[1] eq 'a') {
+                                                       my @t;
+                                                       for (@val) {
+                                                               s/\*//g;
+                                                               push @t, "\$r->[$fref->[2]]=~/$_/i";
+                                                       }
+                                                       $s .= "(" . join(' || ', @t) . ")";
+                                               } elsif ($fref->[1] eq 'c') {
+                                                       my @t;
+                                                       for (@val) {
+                                                               s/\*//g;
+                                                               push @t, "\$r->[$fref->[2]]=~/^\U$_/";
+                                                       }
+                                                       $s .= "(" . join(' || ', @t) . ")";
+                                               } elsif ($fref->[1] eq 'n') {
+                                                       my @t;
+                                                       for (@val) {
+                                                               return ('num', $dxchan->msg('e21', $_)) unless /^\d+$/;
+                                                               push @t, "\$r->[$fref->[2]]==$_";
+                                                       }
+                                                       $s .= "(" . join(' || ', @t) . ")";
+                                               } elsif ($fref->[1] eq 'r') {
+                                                       my @t;
+                                                       for (@val) {
+                                                               return ('range', $dxchan->msg('e23', $_)) unless /^(\d+)\/(\d+)$/;
+                                                               push @t, "(\$r->[$fref->[2]]>=$1 && \$r->[$fref->[2]]<=$2)";
+                                                       }
+                                                       $s .= "(" . join(' || ', @t) . ")";
+                                               } else {
+                                                       confess("invalid letter $fref->[1]");
+                                               }
+                                               ++$found;
+                                               last;
                                        }
                                }
+                               return ('unknown', $dxchan->msg('e20', $tok)) unless $found;
                        } else {
                                return ('no', $dxchan->msg('filter2', $tok));
                        }
                }
                
        }
-       $flag = $flag ? "in_" : "";
-       return (0, $dxchan->msg('filter1', $fno, "$flag$call"));
+
+       # tidy up the user string
+       $user =~ s/\&\&/ and /g;
+       $user =~ s/\|\|/ or /g;
+       $user =~ s/\!/ not /g;
+       $user =~ s/\s+/ /g;
+       
+       return (0, $filter, $fno, $user, "sub { my \$r = shift; return $s }");
 }
 
 package Filter::Old;
index 2b2ef76380e43153cd7a5ba1eaf6414234942f40..e20e0d292035ec92b6cb41ab6ffd226c400a3834 100644 (file)
@@ -63,6 +63,9 @@ package DXM;
                                e18 => 'Cannot connect to $_[0] ($!)',
                                e19 => 'Invalid character in line',
                                e20 => 'token $_[0] not recognised',
+                               e21 => '$_[0] not numeric',
+                               e22 => '$_[0] not a callsign',
+                               e23 => '$_[0] not a range (eg 0/30000)', 
 
                                echoon => 'Echoing enabled',
                                echooff => 'Echoing disabled',
@@ -73,8 +76,10 @@ package DXM;
                                export1 => 'usage: export <msgno> <filename>',
                                export2 => '$_[3] has error exporting msg $_[0] to $_[1] ($_[2])',
                                export3 => '$_[2 ] exported msg $_[0] to $_[1]',
-                               filter1 => 'Filter $_[0] updated $_[1]',
+                               filter1 => 'Filter $_[0] updated for $_[1]',
                                filter2 => 'Need a value for $_[0]',
+                               filter3 => 'No filters defined for $_[0]',
+                               filter4 => '$_[0]$_[1] Filter $_[2] deleted for $_[3]',
                                grids => 'DX Grid flag set on $_[0]',
                                gridu => 'DX Grid flag unset on $_[0]',
                                helpe1 => 'Help system unavailable, tell sysop',
index c9178ddb13b3f8668d25676544d69a6365218512..4c7ab06e3bd94b15b7f6be5afcc4a6f5085244f2 100644 (file)
@@ -53,14 +53,18 @@ sub decodefreq
        my $f;
        
        foreach $f (@f) {
-               my ($a, $b) = $f =~ m{^(\d+)/(\d+)$};
-               if ($a && $b) {
-                       push @out, $a, $b;
+               my ($a, $b)
+               if (m{^\d+/\d+$}) {
+                       push @out, $f;
                } elsif (($a, $b) = $f =~ m{^(\w+)(?:/(\w+))?$}) {
                        $b = lc $b if $b;
                        my @fr = Bands::get_freq(lc $a, $b);
                        if (@fr) {
-                               push @out, @fr;    # add these to the list
+                               while (@fr) {
+                                       $a = shift @fr;
+                                       $b = shift @fr;
+                                       push @out, "$a/$b";  # add them as ranges
+                               }
                        } else {
                                return ('dfreq', $dxchan->msg('dfreq1', $f));
                        }