X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FFilter.pm;h=5947b856f15cff628b458091ae440e81dcb99062;hb=704d88d7e4a8ff06024b35fc27eb94732b0a8d9f;hp=2981a7b75e6d9f06523f314f1e2c70ce5542215d;hpb=6aca4e461103870de99b0ce452f21cf7fedeb54b;p=spider.git diff --git a/perl/Filter.pm b/perl/Filter.pm index 2981a7b7..5947b856 100644 --- a/perl/Filter.pm +++ b/perl/Filter.pm @@ -12,13 +12,242 @@ # # $Id$ # -# The INSTRUCTIONS +# The NEW INSTRUCTIONS +# +# use the commands accept/spot|ann|wwv|wcy and reject/spot|ann|wwv|wcy +# also show/filter spot|ann|wwv|wcy # # The filters live in a directory tree of their own in $main::root/filter # # Each type of filter (e.g. spot, wwv) live in a tree of their own so you # can have different filters for different things for the same callsign. # + + +package Filter; + +use DXVars; +use DXUtil; +use DXDebug; +use Data::Dumper; + +use strict; + +use vars qw ($filterbasefn $in); + +$filterbasefn = "$main::root/filter"; +$in = undef; + +# initial filter system +sub init +{ + +} + +sub new +{ + my ($class, $sort, $call, $flag) = @_; + $flag = ($flag) ? "in_" : ""; + return bless {sort => $sort, name => "$flag$call.pl" }, $class; +} + +# this reads in a filter statement and returns it as a list +# +# The filter is stored in straight perl so that it can be parsed and read +# in with a 'do' statement. The 'do' statement reads the filter into +# @in which is a list of references +# +sub read_in +{ + my ($sort, $call, $flag) = @_; + + # first uppercase + $flag = ($flag) ? "in_" : ""; + $call = uc $call; + my $fn = "$filterbasefn/$sort/$flag$call.pl"; + + # otherwise lowercase + unless (-e $fn) { + $call = lc $call; + $fn = "$filterbasefn/$sort/$flag$call.pl"; + } + + # load it + if (-e $fn) { + $in = undef; + my $s = readfilestr($fn); + my $newin = eval $s; + dbg('conn', "$@") if $@; + if ($in) { + $newin = new('Filter::Old', $sort, $call, $flag); + $newin->{filter} = $in; + } + return $newin; + } + return undef; +} + +# +# this routine accepts a composite filter with a reject component and then an accept +# the filter returns 0 if an entry is matched by any reject rule and also if any +# accept rule fails otherwise it returns 1 +# +# the either set of rules may be missing meaning an implicit 'ok' +# +# reject rules are implicitly 'or' logic (any reject rules which fires kicks it out) +# accept rules are implicitly 'and' logic (all accept rules must pass to indicate a match) +# +# unlike the old system, this is kept as a hash of hashes so that you can +# easily change them by program. +# +# you can have a [any] number of 'filters', they are tried in random order until one matches +# +# an example in machine readable form:- +# bless ({ +# name => 'G7BRN.pl', +# sort => 'spots', +# filter1 => { +# user_rej => { +# by_dxcc => 'W,VE', +# }, +# reject => { +# by_dxcc => [6, 'n', 226,197], +# }, +# user_acc => { +# freq => '0/30000', +# }, +# accept => { +# freq => [0, 'r', 0, 30000], +# }, +# }, +# filter2 => { +# user_acc => { +# freq => 'vhf', +# by_zone => '14,15,16', +# }, +# accept => { +# freq => [0, 'r', 50000,52000,70000,70500,144000,148000], +# by_zone => [11, 'n', 14,15,16], +# } +# }, +# }, 'Filter'); +# +# in user commands:- +# +# clear/spots 1 2 +# accept/spots 1 freq 0/30000 +# reject/spots 1 by_dxcc W,VE +# accept/spots 2 freq vhf +# accept/spots 2 by_zone 14,15,16 +# +# no filter no implies filter 1 +# +# The field nos are the same as for the 'Old' filters +# +# The user_* fields are there so that the structure can be listed easily +# in human readable form when required. They are not used in the filtering +# process itself. +# +# This defines an HF filter and a VHF filter (as it happens) +# + +sub it +{ + my $self = shift; + + my $hops = undef; + my $filter; + my $r; + + my ($key, $ref, $field, $fieldsort, $comp); + L1: foreach $key (grep {/^filter/ } keys %$self) { + my $filter = $self->{$key}; + $r = 0; + if ($filter->{reject}) { + foreach $ref (values %{$filter->{reject}}) { + ($field, $fieldsort) = @$ref[0,1]; + my $val = $_[$field]; + if ($fieldsort eq 'n') { + next L1 if grep $_ == $val, @{$ref}[2..$#$ref]; + } elsif ($fieldsort eq 'r') { + my $i; + for ($i = 2; $i < @$ref; $i += 2) { + next L1 if $val >= $ref->[$i] && $val <= $ref->[$i+1]; + } + } elsif ($fieldsort eq 'a') { + next L1 if grep $val =~ m{$_}, @$ref[2..$#$ref]; + } + } + } + if ($filter->{accept}) { + foreach $ref (values %{$filter->{accept}}) { + ($field, $fieldsort) = @$ref[0,1]; + my $val = $_[$field]; + if ($fieldsort eq 'n') { + next L1 unless grep $_ == $val, @{$ref}[2..$#$ref]; + } elsif ($fieldsort eq 'r') { + my $i; + for ($i = 2; $i < @$ref; $i += 2) { + next L1 unless $val >= $ref->[$i] && $val <= $ref->[$i+1]; + } + } elsif ($fieldsort eq 'a') { + next L1 unless grep $val =~ m{$_}, @{$ref}[2..$#$ref]; + } + } + } + $r = 1; + last; + } + + # hops are done differently + if ($self->{hops}) { + my $h; + while (($comp, $ref) = each %{$self->{hops}}) { + ($field, $h) = @$ref; + if ($_[$field] =~ m{$comp}) { + $hops = $h; + last; + } + } + } + return ($r, $hops); +} + +# this writes out the filter in a form suitable to be read in by 'read_in' +# It expects a list of references to filter lines +sub write +{ + my $self = shift; + my $sort = $self->{sort}; + my $fn = $self->{name}; + my $dir = "$filterbasefn/$sort"; + mkdir $dir, 0775 unless -e $dir; + my $fh = new IO::File ">$dir/$fn" or return "$dir/$fn $!"; + if ($fh) { + my $dd = new Data::Dumper([ $self ]); + $dd->Indent(1); + $dd->Terse(1); + $dd->Quotekeys($] < 5.005 ? 1 : 0); + $fh->print($dd->Dumpxs); + $fh->close; + } + return undef; +} + +sub print +{ + my $self = shift; + return $self->{name}; +} + +package Filter::Old; + +use strict; +use vars qw(@ISA); +@ISA = qw(Filter); + +# the OLD instructions! +# # Each filter file has the same structure:- # # @@ -43,33 +272,15 @@ # 0 is the first field of the list. # -package Filter; - -use DXVars; -use DXUtil; -use DXDebug; -use Carp; - -use strict; - -use vars qw ($filterbasefn $in); - -$filterbasefn = "$main::root/filter"; -$in = undef; - -# initial filter system -sub init -{ - -} - # # takes the reference to the filter (the first argument) and applies # it to the subsequent arguments and returns the action specified. # sub it { - my $filter = shift; + my $self = shift; + my $filter = $self->{filter}; # this is now a bless ref of course but so what + my ($action, $field, $fieldsort, $comp, $actiondata); my $ref; @@ -98,67 +309,6 @@ sub it } } -# this reads in a filter statement and returns it as a list -# -# The filter is stored in straight perl so that it can be parsed and read -# in with a 'do' statement. The 'do' statement reads the filter into -# @in which is a list of references -# -sub read_in -{ - my ($sort, $call) = @_; - my $fn = "$filterbasefn/$sort/$call.pl"; - - if (-e $fn) { - do "$fn"; - dbg('conn', "$@") if $@; - return $in; - } - return undef; -} - -# this writes out the filter in a form suitable to be read in by 'read_in' -# It expects a list of references to filter lines -sub write_out -{ - my $sort = shift; - my $call = shift; - my $fn = "$filterbasefn/$sort"; - - - # make the output directory - mkdir $fn, 0777 unless -e $fn; - - # write out the file - $fn = "$fn/$call.pl"; - unless (open FILTER, ">$fn") { - warn "can't open $fn $!" ; - return; - } - - my $today = localtime; - print FILTER "#!/usr/bin/perl -# -# Filter for $call stored $today -# -\$in = [ -"; - - my $ref; - for $ref (@_) { - my ($action, $field, $fieldsort, $comp, $actiondata) = @{$ref}; - print FILTER "\t[ $action, $field, $fieldsort,"; - if ($fieldsort eq 'n' || $fieldsort eq 'r') { - print FILTER "[ ", join (',', $comp), " ],"; - } elsif ($fieldsort eq 'a') { - my $f = $comp; - print FILTER "'$f'"; - } - print FILTER " ],\n"; - } - print FILTER "];\n"; - close FILTER; -} 1; __END__