X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FFilter.pm;h=d45f5096ac8e0ab7ef2226ac7052c1dd133a6252;hb=647730580f6fe6ad14ee8445f0d5d583390cb130;hp=2981a7b75e6d9f06523f314f1e2c70ce5542215d;hpb=6aca4e461103870de99b0ce452f21cf7fedeb54b;p=spider.git

diff --git a/perl/Filter.pm b/perl/Filter.pm
index 2981a7b7..d45f5096 100644
--- a/perl/Filter.pm
+++ b/perl/Filter.pm
@@ -12,13 +12,95 @@
 #
 # $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
+{
+
+}
+
+
+# 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 = 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
+{
+	my $self = shift;
+}
+
+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:-
 #
 # <some comment>
@@ -43,33 +125,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 +162,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__