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 ],
  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. The fields
  41 # are the element nos of the list that is presented to Filter::it. Element
  42 # 0 is the first field of the list.
  43 #
  44
  45 package Filter;
  46
  47 use DXVars;
  48 use DXUtil;
  49 use DXDebug;
  50 use Carp;
  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 $ref;
  73
  74         # default action is 1
  75         return 1 if !$filter;
  76
  77         for $ref (@{$filter}) {
  78                 my ($action, $field, $fieldsort, $comp) = @{$ref};
  79                 if ($fieldsort eq 'n') {
  80                         my $val = $_[$field];
  81                         return $action  if grep $_ == $val, @{$comp};
  82                 } elsif ($fieldsort eq 'r') {
  83                         my $val = $_[$field];
  84                         my $i;
  85                         my @range = @{$comp};
  86                         for ($i = 0; $i < @range; $i += 2) {
  87                                 return $action if $val >= $range[$i] && $val <= $range[$i+1];
  88                         }
  89                 } elsif ($fieldsort eq 'a') {
  90                         return $action  if $_[$field] =~ m{$comp};
  91                 } else {
  92                         return $action;      # the default action
  93                 }
  94         }
  95 }
  96
  97 # this reads in a filter statement and returns it as a list
  98 #
  99 # The filter is stored in straight perl so that it can be parsed and read
 100 # in with a 'do' statement. The 'do' statement reads the filter into
 101 # @in which is a list of references
 102 #
 103 sub read_in
 104 {
 105         my ($sort, $call) = @_;
 106         my $fn = "$filterbasefn/$sort/$call.pl";
 107
 108         if (-e $fn) {
 109                 do "$fn";
 110                 dbg('conn', "$@") if $@;
 111                 return $in;
 112         }
 113         return undef;
 114 }
 115
 116 # this writes out the filter in a form suitable to be read in by 'read_in'
 117 # It expects a list of references to filter lines
 118 sub write_out
 119 {
 120         my $sort = shift;
 121         my $call = shift;
 122         my $fn = "$filterbasefn/$sort";
 123
 124
 125         # make the output directory
 126         mkdir $fn, 0777 unless -e $fn;
 127
 128         # write out the file
 129         $fn = "$fn/$call.pl";
 130         unless (open FILTER, ">$fn") {
 131                 warn "can't open $fn $!" ;
 132                 return;
 133         }
 134
 135         my $today = localtime;
 136         print FILTER "#
 137 # Filter for $call stored $today
 138 #
 139 \$in = [
 140 ";
 141
 142         my $ref;
 143         for $ref (@_) {
 144                 my ($action, $field, $fieldsort, $comp) = @{$ref};
 145                 print FILTER "\t[ $action, $field, $fieldsort,";
 146                 if ($fieldsort eq 'n' || $fieldsort eq 'r') {
 147                         print FILTER "[ ", join (',', $comp), " ],";
 148                 } elsif ($fieldsort eq 'a') {
 149                         my $f = $comp;
 150                 print FILTER "'$f'";
 151                 }
 152                 print FILTER " ],\n";
 153         }
 154         print FILTER "];\n";
 155         close FILTER;
 156 }
 157
 158 1;
 159 __END__