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 INSTRUCTIONS
  16 #
  17 # The filters live in a directory tree of their own in $main::root/filter
  18 #
  19 # Each type of filter (e.g. spot, wwv) live in a tree of their own so you
  20 # can have different filters for different things for the same callsign.
  21 #
  22 # Each filter file has the same structure:-
  23 #
  24 # <some comment>
  25 # @in = (
  26 #      [ action, fieldno, fieldsort, comparison, action data ],
  27 #      ...
  28 # );
  29 #
  30 # The action is usually 1 or 0 but could be any numeric value
  31 #
  32 # The fieldno is the field no in the list of fields that is presented
  33 # to 'Filter::it'
  34 #
  35 # The fieldsort is the type of field that we are dealing with which
  36 # currently can be 'a', 'n', 'r' or 'd'. 'a' is alphanumeric, 'n' is
  37 # numeric, 'r' is ranges of pairs of numeric values and 'd' is default.
  38 #
  39 # Filter::it basically goes thru the list of comparisons from top to
  40 # bottom and when one matches it will return the action and the action data as a list.
  41 # The fields
  42 # are the element nos of the list that is presented to Filter::it. Element
  43 # 0 is the first field of the list.
  44 #
  45
  46 package Filter;
  47
  48 use DXVars;
  49 use DXUtil;
  50 use DXDebug;
  51
  52 use strict;
  53
  54 use vars qw ($filterbasefn $in);
  55
  56 $filterbasefn = "$main::root/filter";
  57 $in = undef;
  58
  59 # initial filter system
  60 sub init
  61 {
  62
  63 }
  64
  65 #
  66 # takes the reference to the filter (the first argument) and applies
  67 # it to the subsequent arguments and returns the action specified.
  68 #
  69 sub it
  70 {
  71         my $filter = shift;
  72         my ($action, $field, $fieldsort, $comp, $actiondata);
  73         my $ref;
  74
  75         # default action is 1
  76         $action = 1;
  77         $actiondata = "";
  78         return ($action, $actiondata) if !$filter;
  79
  80         for $ref (@{$filter}) {
  81                 ($action, $field, $fieldsort, $comp, $actiondata) = @{$ref};
  82                 if ($fieldsort eq 'n') {
  83                         my $val = $_[$field];
  84                         return ($action, $actiondata)  if grep $_ == $val, @{$comp};
  85                 } elsif ($fieldsort eq 'r') {
  86                         my $val = $_[$field];
  87                         my $i;
  88                         my @range = @{$comp};
  89                         for ($i = 0; $i < @range; $i += 2) {
  90                                 return ($action, $actiondata)  if $val >= $range[$i] && $val <= $range[$i+1];
  91                         }
  92                 } elsif ($fieldsort eq 'a') {
  93                         return ($action, $actiondata)  if $_[$field] =~ m{$comp};
  94                 } else {
  95                         return ($action, $actiondata);      # the default action
  96                 }
  97         }
  98 }
  99
 100 # this reads in a filter statement and returns it as a list
 101 #
 102 # The filter is stored in straight perl so that it can be parsed and read
 103 # in with a 'do' statement. The 'do' statement reads the filter into
 104 # @in which is a list of references
 105 #
 106 sub read_in
 107 {
 108         my ($sort, $call, $flag) = @_;
 109
 110     # first uppercase
 111         $flag = ($flag) ? "in_" : "";
 112         $call = uc $call;
 113         my $fn = "$filterbasefn/$sort/$flag$call.pl";
 114
 115         # otherwise lowercase
 116         unless (-e $fn) {
 117                 $call = lc $call;
 118                 $fn = "$filterbasefn/$sort/$flag$call.pl";
 119         }
 120
 121         # load it
 122         if (-e $fn) {
 123                 do "$fn";
 124                 dbg('conn', "$@") if $@;
 125                 return $in;
 126         }
 127         return undef;
 128 }
 129
 130 # this writes out the filter in a form suitable to be read in by 'read_in'
 131 # It expects a list of references to filter lines
 132 sub write_out
 133 {
 134         my $sort = shift;
 135         my $call = shift;
 136         my $fn = "$filterbasefn/$sort";
 137
 138
 139         # make the output directory
 140         mkdir $fn, 0777 unless -e $fn;
 141
 142         # write out the file
 143         $fn = "$fn/$call.pl";
 144         unless (open FILTER, ">$fn") {
 145                 warn "can't open $fn $!" ;
 146                 return;
 147         }
 148
 149         my $today = localtime;
 150         print FILTER "#!/usr/bin/perl
 151 #
 152 # Filter for $call stored $today
 153 #
 154 \$in = [
 155 ";
 156
 157         my $ref;
 158         for $ref (@_) {
 159                 my ($action, $field, $fieldsort, $comp, $actiondata) = @{$ref};
 160                 print FILTER "\t[ $action, $field, $fieldsort,";
 161                 if ($fieldsort eq 'n' || $fieldsort eq 'r') {
 162                         print FILTER "[ ", join (',', $comp), " ],";
 163                 } elsif ($fieldsort eq 'a') {
 164                         my $f = $comp;
 165                 print FILTER "'$f'";
 166                 }
 167                 print FILTER " ],\n";
 168         }
 169         print FILTER "];\n";
 170         close FILTER;
 171 }
 172
 173 1;
 174 __END__