perl/Filter.pm

   1 #
   2 # The User/Sysop Filter module
   3 #
   4 # The way this works is that the filter routine is actually
   5 # a predefined function that returns 0 if it is OK and 1 if it
   6 # is not when presented with a list of things.
   7 #
   8 # This set of routines provide a means of maintaining the filter
   9 # scripts which are compiled in when an entity connects.
  10 #
  11 # Copyright (c) 1999 Dirk Koopman G1TLH
  12 #
  13 # $Id$
  14 #
  15 # The NEW INSTRUCTIONS
  16 #
  17 # use the commands accept/spot|ann|wwv|wcy and reject/spot|ann|wwv|wcy
  18 # also show/filter spot|ann|wwv|wcy
  19 #
  20 # The filters live in a directory tree of their own in $main::root/filter
  21 #
  22 # Each type of filter (e.g. spot, wwv) live in a tree of their own so you
  23 # can have different filters for different things for the same callsign.
  24 #
  25
  26
  27 package Filter;
  28
  29 use DXVars;
  30 use DXUtil;
  31 use DXDebug;
  32 use Data::Dumper;
  33
  34 use strict;
  35
  36 use vars qw ($filterbasefn $in);
  37
  38 $filterbasefn = "$main::root/filter";
  39 $in = undef;
  40
  41 # initial filter system
  42 sub init
  43 {
  44
  45 }
  46
  47
  48 # this reads in a filter statement and returns it as a list
  49 #
  50 # The filter is stored in straight perl so that it can be parsed and read
  51 # in with a 'do' statement. The 'do' statement reads the filter into
  52 # @in which is a list of references
  53 #
  54 sub read_in
  55 {
  56         my ($sort, $call, $flag) = @_;
  57
  58     # first uppercase
  59         $flag = ($flag) ? "in_" : "";
  60         $call = uc $call;
  61         my $fn = "$filterbasefn/$sort/$flag$call.pl";
  62
  63         # otherwise lowercase
  64         unless (-e $fn) {
  65                 $call = lc $call;
  66                 $fn = "$filterbasefn/$sort/$flag$call.pl";
  67         }
  68
  69         # load it
  70         if (-e $fn) {
  71                 $in = undef;
  72                 my $s = readfilestr($fn);
  73                 my $newin = eval $s;
  74                 dbg('conn', "$@") if $@;
  75                 if ($in) {
  76                         $newin = bless {filter => $in, name => "$flag$call.pl" }, 'Filter::Old'
  77                 }
  78                 return $newin;
  79         }
  80         return undef;
  81 }
  82
  83 # this writes out the filter in a form suitable to be read in by 'read_in'
  84 # It expects a list of references to filter lines
  85 sub write
  86 {
  87         my $self = shift;
  88 }
  89
  90 sub print
  91 {
  92         my $self = shift;
  93         return $self->{name};
  94 }
  95
  96 package Filter::Old;
  97
  98 use strict;
  99 use vars qw(@ISA);
 100 @ISA = qw(Filter);
 101
 102 # the OLD instructions!
 103 #
 104 # Each filter file has the same structure:-
 105 #
 106 # <some comment>
 107 # @in = (
 108 #      [ action, fieldno, fieldsort, comparison, action data ],
 109 #      ...
 110 # );
 111 #
 112 # The action is usually 1 or 0 but could be any numeric value
 113 #
 114 # The fieldno is the field no in the list of fields that is presented
 115 # to 'Filter::it'
 116 #
 117 # The fieldsort is the type of field that we are dealing with which
 118 # currently can be 'a', 'n', 'r' or 'd'. 'a' is alphanumeric, 'n' is
 119 # numeric, 'r' is ranges of pairs of numeric values and 'd' is default.
 120 #
 121 # Filter::it basically goes thru the list of comparisons from top to
 122 # bottom and when one matches it will return the action and the action data as a list.
 123 # The fields
 124 # are the element nos of the list that is presented to Filter::it. Element
 125 # 0 is the first field of the list.
 126 #
 127
 128 #
 129 # takes the reference to the filter (the first argument) and applies
 130 # it to the subsequent arguments and returns the action specified.
 131 #
 132 sub it
 133 {
 134         my $self = shift;
 135         my $filter = $self->{filter};            # this is now a bless ref of course but so what
 136
 137         my ($action, $field, $fieldsort, $comp, $actiondata);
 138         my $ref;
 139
 140         # default action is 1
 141         $action = 1;
 142         $actiondata = "";
 143         return ($action, $actiondata) if !$filter;
 144
 145         for $ref (@{$filter}) {
 146                 ($action, $field, $fieldsort, $comp, $actiondata) = @{$ref};
 147                 if ($fieldsort eq 'n') {
 148                         my $val = $_[$field];
 149                         return ($action, $actiondata)  if grep $_ == $val, @{$comp};
 150                 } elsif ($fieldsort eq 'r') {
 151                         my $val = $_[$field];
 152                         my $i;
 153                         my @range = @{$comp};
 154                         for ($i = 0; $i < @range; $i += 2) {
 155                                 return ($action, $actiondata)  if $val >= $range[$i] && $val <= $range[$i+1];
 156                         }
 157                 } elsif ($fieldsort eq 'a') {
 158                         return ($action, $actiondata)  if $_[$field] =~ m{$comp};
 159                 } else {
 160                         return ($action, $actiondata);      # the default action
 161                 }
 162         }
 163 }
 164
 165
 166 1;
 167 __END__