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) = @_;
 110         my $fn = "$filterbasefn/$sort/$call.pl";
 111
 112         if (-e $fn) {
 113                 do "$fn";
 114                 dbg('conn', "$@") if $@;
 115                 return $in;
 116         }
 117         return undef;
 118 }
 119
 120 # this writes out the filter in a form suitable to be read in by 'read_in'
 121 # It expects a list of references to filter lines
 122 sub write_out
 123 {
 124         my $sort = shift;
 125         my $call = shift;
 126         my $fn = "$filterbasefn/$sort";
 127
 128
 129         # make the output directory
 130         mkdir $fn, 0777 unless -e $fn;
 131
 132         # write out the file
 133         $fn = "$fn/$call.pl";
 134         unless (open FILTER, ">$fn") {
 135                 warn "can't open $fn $!" ;
 136                 return;
 137         }
 138
 139         my $today = localtime;
 140         print FILTER "#!/usr/bin/perl
 141 #
 142 # Filter for $call stored $today
 143 #
 144 \$in = [
 145 ";
 146
 147         my $ref;
 148         for $ref (@_) {
 149                 my ($action, $field, $fieldsort, $comp, $actiondata) = @{$ref};
 150                 print FILTER "\t[ $action, $field, $fieldsort,";
 151                 if ($fieldsort eq 'n' || $fieldsort eq 'r') {
 152                         print FILTER "[ ", join (',', $comp), " ],";
 153                 } elsif ($fieldsort eq 'a') {
 154                         my $f = $comp;
 155                 print FILTER "'$f'";
 156                 }
 157                 print FILTER " ],\n";
 158         }
 159         print FILTER "];\n";
 160         close FILTER;
 161 }
 162
 163 1;
 164 __END__