From a91e80b479d48d5d9be339c7aa2ab8cf6621886f Mon Sep 17 00:00:00 2001 From: minima Date: Tue, 31 Oct 2000 01:11:25 +0000 Subject: [PATCH] added new Filter::it engine --- Changes | 3 + perl/DXUtil.pm | 2 +- perl/Filter.pm | 147 ++++++++++++++++++++++++++++++++++++++++++++++++- 3 files changed, 150 insertions(+), 2 deletions(-) diff --git a/Changes b/Changes index d242d301..39b49a0b 100644 --- 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 21ae3e23..07e86cea 100644 --- 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 d45f5096..78840529 100644 --- 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 -- 2.43.0