added new Filter::it engine

diff --git a/Changes b/Changes
index d242d3014f4f94081df4c04e7b67ae918ac6970a..39b49a0bd080d64883ee9bf35465b778ed47e4c6 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,6 @@
+30Oct00=======================================================================
+1. put in new Filter::it code and tested it. Now all we have to do is write
+the user access routines (oh and the help files!).
 29Oct00=======================================================================
 1. put in echo cancelling measures into the clients. This doesn't mean you
 shouldn't take steps to prevent echoing on node links, but it may help where

diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm
index 21ae3e2354e620b7607e265adcf8c747cdb76ad0..07e86cea4a7d5254d8415c49ddecd23f94d3b078 100644 (file)
--- a/perl/DXUtil.pm
+++ b/perl/DXUtil.pm
@@ -134,7 +134,7 @@ sub promptf
                my $dd = new Data::Dumper([$value]);
                $dd->Indent(0);
                $dd->Terse(1);
-               $dd->Quotekeys($] < 5.005 ? 1 : 0);
+               $dd->Quotekeys(0);
                $value = $dd->Dumpxs;
        }
        $prompt = sprintf "%15s: %s", $prompt, $value;

diff --git a/perl/Filter.pm b/perl/Filter.pm
index d45f5096ac8e0ab7ef2226ac7052c1dd133a6252..7884052990c64630dbcdbb355f1b5a150ccb5508 100644 (file)
--- a/perl/Filter.pm
+++ b/perl/Filter.pm
@@ -44,6 +44,12 @@ sub init
 
 }
 
+sub new
+{
+       my ($class, $sort, $call, $flag) = @_;
+       $flag = ($flag) ? "in_" : "";
+       return bless {sort => $sort, name => "$flag$call.pl" }, $class;
+}
 
 # this reads in a filter statement and returns it as a list
 # 
@@ -73,18 +79,157 @@ sub read_in
                my $newin = eval $s;
                dbg('conn', "$@") if $@;
                if ($in) {
-                       $newin = bless {filter => $in, name => "$flag$call.pl" }, 'Filter::Old'
+                       $newin = new('Filter::Old', $sort, $call, $flag);
+                       $newin->{filter} = $in;
                }
                return $newin;
        }
        return undef;
 }
 
+#
+# 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
+#
+# the either set of rules may be missing meaning an implicit 'ok'
+#
+# 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)
+#
+# 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_zone => '4,5',
+#                      },
+#              reject => {
+#                      by_zone => [11, 'n', 4, 5],
+#              },
+#                      user_acc => {
+#                              freq => 'hf',
+#                      },
+#              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_zone 4,5
+#   accept/spots 2 freq vhf 
+#   accept/spots 2 by_zone 14,15,16
+#
+# no filter no implies filter 1
+#
+# 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
+{
+       my $self = shift;
+       
+       my $hops = undef;
+       my $filter;
+       my $r;
+               
+       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;
+       }
+
+       # hops are done differently 
+       if ($self->{hops}) {
+               my $h;
+               while (($comp, $ref) = each %{$self->{hops}}) {
+                       ($field, $h) = @$ref;
+                       if ($_[$field] =~ m{$comp}) {
+                               $hops = $h;
+                               last;
+                       } 
+               }               
+       }
+       return ($r, $hops);
+}
+
 # this writes out the filter in a form suitable to be read in by 'read_in'
 # It expects a list of references to filter lines
 sub write
 {
        my $self = shift;
+       my $sort = $self->{sort};
+       my $fn = $self->{name};
+       my $dir = "$filterbasefn/$sort";
+       mkdir $dir, 0775 unless -e $dir; 
+       my $fh = new IO::File ">$dir/$fn" or return "$dir/$fn $!";
+       if ($fh) {
+               my $dd = new Data::Dumper([ $self ]);
+               $dd->Indent(1);
+               $dd->Terse(1);
+               $dd->Quotekeys($] < 5.005 ? 1 : 0);
+               $fh->print($dd->Dumpxs);
+               $fh->close;
+       }
+       return undef;
 }
 
 sub print