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 use Carp;
  52
  53 use strict;
  54
  55 use vars qw ($filterbasefn $in);
  56
  57 $filterbasefn = "$main::root/filter";
  58 $in = undef;
  59
  60 # initial filter system
  61 sub init
  62 {
  63
  64 }
  65
  66 #
  67 # takes the reference to the filter (the first argument) and applies
  68 # it to the subsequent arguments and returns the action specified.
  69 #
  70 sub it
  71 {
  72         my $filter = shift;
  73         my ($action, $field, $fieldsort, $comp, $actiondata);
  74         my $ref;
  75
  76         # default action is 1
  77         $action = 1;
  78         $actiondata = "";
  79         return ($action, $actiondata) if !$filter;
  80
  81         for $ref (@{$filter}) {
  82                 ($action, $field, $fieldsort, $comp, $actiondata) = @{$ref};
  83                 if ($fieldsort eq 'n') {
  84                         my $val = $_[$field];
  85                         return ($action, $actiondata)  if grep $_ == $val, @{$comp};
  86                 } elsif ($fieldsort eq 'r') {
  87                         my $val = $_[$field];
  88                         my $i;
  89                         my @range = @{$comp};
  90                         for ($i = 0; $i < @range; $i += 2) {
  91                                 return ($action, $actiondata)  if $val >= $range[$i] && $val <= $range[$i+1];
  92                         }
  93                 } elsif ($fieldsort eq 'a') {
  94                         return ($action, $actiondata)  if $_[$field] =~ m{$comp};
  95                 } else {
  96                         return ($action, $actiondata);      # the default action
  97                 }
  98         }
  99 }
 100
 101 # this reads in a filter statement and returns it as a list
 102 #
 103 # The filter is stored in straight perl so that it can be parsed and read
 104 # in with a 'do' statement. The 'do' statement reads the filter into
 105 # @in which is a list of references
 106 #
 107 sub read_in
 108 {
 109         my ($sort, $call, $flag) = @_;
 110
 111     # first uppercase
 112         $flag = ($flag) ? "in_" : "";
 113         $call = uc $call;
 114         my $fn = "$filterbasefn/$sort/$flag$call.pl";
 115
 116         # otherwise lowercase
 117         unless (-e $fn) {
 118                 $call = lc $call;
 119                 $fn = "$filterbasefn/$sort/$flag$call.pl";
 120         }
 121
 122         # load it
 123         if (-e $fn) {
 124                 do "$fn";
 125                 dbg('conn', "$@") if $@;
 126                 return $in;
 127         }
 128         return undef;
 129 }
 130
 131 # this writes out the filter in a form suitable to be read in by 'read_in'
 132 # It expects a list of references to filter lines
 133 sub write_out
 134 {
 135         my $sort = shift;
 136         my $call = shift;
 137         my $fn = "$filterbasefn/$sort";
 138
 139
 140         # make the output directory
 141         mkdir $fn, 0777 unless -e $fn;
 142
 143         # write out the file
 144         $fn = "$fn/$call.pl";
 145         unless (open FILTER, ">$fn") {
 146                 warn "can't open $fn $!" ;
 147                 return;
 148         }
 149
 150         my $today = localtime;
 151         print FILTER "#!/usr/bin/perl
 152 #
 153 # Filter for $call stored $today
 154 #
 155 \$in = [
 156 ";
 157
 158         my $ref;
 159         for $ref (@_) {
 160                 my ($action, $field, $fieldsort, $comp, $actiondata) = @{$ref};
 161                 print FILTER "\t[ $action, $field, $fieldsort,";
 162                 if ($fieldsort eq 'n' || $fieldsort eq 'r') {
 163                         print FILTER "[ ", join (',', $comp), " ],";
 164                 } elsif ($fieldsort eq 'a') {
 165                         my $f = $comp;
 166                 print FILTER "'$f'";
 167                 }
 168                 print FILTER " ],\n";
 169         }
 170         print FILTER "];\n";
 171         close FILTER;
 172 }
 173
 174 1;
 175 __END__