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