X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FFilter.pm;h=d45f5096ac8e0ab7ef2226ac7052c1dd133a6252;hb=647730580f6fe6ad14ee8445f0d5d583390cb130;hp=aefa922419ee94afac488101b11c184aba45a8eb;hpb=82de56e409a19a05761794c9588713160b51144e;p=spider.git diff --git a/perl/Filter.pm b/perl/Filter.pm index aefa9224..d45f5096 100644 --- a/perl/Filter.pm +++ b/perl/Filter.pm @@ -12,43 +12,24 @@ # # $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. # -# Each filter file has the same structure:- -# -# -# @in = ( -# [ action, fieldno, fieldsort, comparison, action data ], -# ... -# ); -# -# The action is usually 1 or 0 but could be any numeric value -# -# The fieldno is the field no in the list of fields that is presented -# to 'Filter::it' -# -# The fieldsort is the type of field that we are dealing with which -# currently can be 'a', 'n', 'r' or 'd'. 'a' is alphanumeric, 'n' is -# numeric, 'r' is ranges of pairs of numeric values and 'd' is default. -# -# Filter::it basically goes thru the list of comparisons from top to -# bottom and when one matches it will return the action and the action data as a list. -# The fields -# are the element nos of the list that is presented to Filter::it. Element -# 0 is the first field of the list. -# + package Filter; use DXVars; use DXUtil; use DXDebug; -use Carp; +use Data::Dumper; use strict; @@ -63,40 +44,6 @@ 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 ($action, $field, $fieldsort, $comp, $actiondata); - my $ref; - - # default action is 1 - $action = 1; - $actiondata = ""; - return ($action, $actiondata) if !$filter; - - for $ref (@{$filter}) { - ($action, $field, $fieldsort, $comp, $actiondata) = @{$ref}; - if ($fieldsort eq 'n') { - my $val = $_[$field]; - return ($action, $actiondata) if grep $_ == $val, @{$comp}; - } elsif ($fieldsort eq 'r') { - my $val = $_[$field]; - my $i; - my @range = @{$comp}; - for ($i = 0; $i < @range; $i += 2) { - return ($action, $actiondata) if $val >= $range[$i] && $val <= $range[$i+1]; - } - } elsif ($fieldsort eq 'a') { - return ($action, $actiondata) if $_[$field] =~ m{$comp}; - } else { - return ($action, $actiondata); # the default action - } - } -} # this reads in a filter statement and returns it as a list # @@ -121,55 +68,100 @@ sub read_in # load it if (-e $fn) { - do "$fn"; + $in = undef; + my $s = readfilestr($fn); + my $newin = eval $s; dbg('conn', "$@") if $@; - return $in; + if ($in) { + $newin = bless {filter => $in, name => "$flag$call.pl" }, 'Filter::Old' + } + return $newin; } 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 +sub write { - 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 $self = shift; +} + +sub print +{ + my $self = shift; + return $self->{name}; +} + +package Filter::Old; + +use strict; +use vars qw(@ISA); +@ISA = qw(Filter); - my $today = localtime; - print FILTER "#!/usr/bin/perl +# the OLD instructions! +# +# Each filter file has the same structure:- +# +# +# @in = ( +# [ action, fieldno, fieldsort, comparison, action data ], +# ... +# ); +# +# The action is usually 1 or 0 but could be any numeric value +# +# The fieldno is the field no in the list of fields that is presented +# to 'Filter::it' # -# Filter for $call stored $today +# The fieldsort is the type of field that we are dealing with which +# currently can be 'a', 'n', 'r' or 'd'. 'a' is alphanumeric, 'n' is +# numeric, 'r' is ranges of pairs of numeric values and 'd' is default. +# +# Filter::it basically goes thru the list of comparisons from top to +# bottom and when one matches it will return the action and the action data as a list. +# The fields +# are the element nos of the list that is presented to Filter::it. Element +# 0 is the first field of the list. # -\$in = [ -"; +# +# takes the reference to the filter (the first argument) and applies +# it to the subsequent arguments and returns the action specified. +# +sub it +{ + 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; - 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), " ],"; + + # default action is 1 + $action = 1; + $actiondata = ""; + return ($action, $actiondata) if !$filter; + + for $ref (@{$filter}) { + ($action, $field, $fieldsort, $comp, $actiondata) = @{$ref}; + if ($fieldsort eq 'n') { + my $val = $_[$field]; + return ($action, $actiondata) if grep $_ == $val, @{$comp}; + } elsif ($fieldsort eq 'r') { + my $val = $_[$field]; + my $i; + my @range = @{$comp}; + for ($i = 0; $i < @range; $i += 2) { + return ($action, $actiondata) if $val >= $range[$i] && $val <= $range[$i+1]; + } } elsif ($fieldsort eq 'a') { - my $f = $comp; - print FILTER "'$f'"; + return ($action, $actiondata) if $_[$field] =~ m{$comp}; + } else { + return ($action, $actiondata); # the default action } - print FILTER " ],\n"; } - print FILTER "];\n"; - close FILTER; } + 1; __END__