added filter code
authordjk <djk>
Sun, 21 Feb 1999 17:41:31 +0000 (17:41 +0000)
committerdjk <djk>
Sun, 21 Feb 1999 17:41:31 +0000 (17:41 +0000)
fiddled a bit with the dx commands to allow multiple freq ranges

13 files changed:
Changes
cmd/dx.pl
cmd/set/language.pl [new file with mode: 0644]
cmd/show/dx.pl
filter/spots/GB7DJK.pl.issue [new file with mode: 0644]
filter/spots/K1XX.pl.issue [new file with mode: 0644]
perl/DXChannel.pm
perl/DXCommandmode.pm
perl/DXMsg.pm
perl/DXProt.pm
perl/Filter.pm
perl/Spot.pm
perl/cluster.pl

diff --git a/Changes b/Changes
index 884a861dd9f87147f4855a3079e3d97def5669f3..50528a697e605bd4d2d0cda9ce8610c7736f9ce9 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,8 @@
+21Feb99========================================================================
+1. Allowed multiple 'on <freq>' for show/dx
+2. Made sure the 'on 20m/ssb' thing worked (also 'on hf/cw').
+3. first cut of the Filtering code, no user commands yet but the file
+format is defined and manually added filters should work for spots
 17Feb99========================================================================
 1. added export_user.pl to export user files (for interest and safety)
 2. changed DXUser::init to allow O_RDONLY access which may limit the number
@@ -19,7 +24,7 @@ off which means that the netrom/ax25 call programs terminate properly (and not
 loop as fast as their little legs can paddle, soaking up CPU time).
 2. Implemented read receipts as an especial request from G4PDQ.
 3. Fiddled with DXUser a bit to see whether I can stop it core dumping on new
-users in PC16s on his machine.
+users in PC16s on G0RDI's machine.
 4. Added E4 (Palestine) to Prefix data.
 30Jan99========================================================================
 1. Some of the dates we get can cause crashes, tried to make it more robust (oh
index b80d89bffb0404cafa226c3b059ac424c44ea988..308371fd5129273944c1031e9cac83a2e9b5eabf 100644 (file)
--- a/cmd/dx.pl
+++ b/cmd/dx.pl
@@ -65,7 +65,6 @@ if (!$valid) {
 }
 
 
-
 push @out, $self->msg('dx1', $freq) if !$valid;
 
 # check we have a callsign :-)
@@ -85,10 +84,11 @@ if (grep $_ eq $spotted, @DXProt::baddx) {
        my $buf = Spot::formatb($freq, $spotted, $main::systime, $line, $spotter);
        push @out, $buf;
 } else {
-       if (Spot::add($freq, $spotted, $main::systime, $line, $spotter, $main::mycall)) {
+       my @spot = Spot::add($freq, $spotted, $main::systime, $line, $spotter, $main::mycall);
+       if (@spot) {
                # send orf to the users
                my $buf = Spot::formatb($freq, $spotted, $main::systime, $line, $spotter);
-               DXProt::broadcast_users($buf, 'dx', $buf);
+               DXProt::broadcast_users($buf, 'dx', \@spot);
 
                # send it orf to the cluster (hang onto your tin helmets) 
                DXProt::broadcast_ak1a(DXProt::pc11($spotter, $freq, $spotted, $line));
diff --git a/cmd/set/language.pl b/cmd/set/language.pl
new file mode 100644 (file)
index 0000000..e69de29
index 06cc5d041e8ab2d51e3bf8e86f3c3e2c6e9c73b9..c98699969ad095cc4518eab077ee5bf936009821 100644 (file)
@@ -32,11 +32,12 @@ while ($f = shift @list) {          # next field
        if (lc $f eq 'on' && $list[0]) { # is it freq range?
                #    print "yup freq\n";
                my @r = split '/', $list[0];
-               #       print "r0: $r[0] r1: $r[1]\n";
-               @freq = Bands::get_freq($r[0], $r[1]);
-               if (@freq) {                    # yup, get rid of extranous param
-                       #         print "freq: ", join(',', @freq), "\n";
+                       # print "r0: $r[0] r1: $r[1]\n";
+               my @fr = Bands::get_freq($r[0], $r[1]);
+               if (@fr) {                      # yup, get rid of extranous param
+                       #         print "freq: ", join(',', @fr), "\n";
                        shift @list;
+                       push @freq, @fr;    # add these to the list
                        next;
                }
        }
@@ -50,7 +51,7 @@ while ($f = shift @list) {            # next field
                $info = shift @list;
                next;
        }
-       if (lc $f eq 'spotter' && $list[0]) {
+       if ((lc $f eq 'spotter' || lc $f eq 'by') && $list[0]) {
                #    print "got spotter\n";
                $spotter = uc shift @list;
                next;
diff --git a/filter/spots/GB7DJK.pl.issue b/filter/spots/GB7DJK.pl.issue
new file mode 100644 (file)
index 0000000..006ea2b
--- /dev/null
@@ -0,0 +1,27 @@
+#
+# This is an example filter for the 'isolated' node k1xx
+# 
+# I give him any spots that have a spotter or a spotted in the
+# US. In other filters on the UK side I do the opposite see 
+# GB7DJK.pl.issue
+#
+# The element list is:-
+#   0 = frequency
+#   1 = call
+#   2 = date in unix format
+#   3 = comment
+#   4 = spotter
+#   5 = spotted dxcc country
+#   6 = spotter's dxcc country
+#   7 = origin
+#   8 = spotted itu
+#   9 = spotted cq
+#   10 = spotter's itu
+#   11 = spotter's cq
+#
+
+$in = [
+          [ 1, 9, 'n', [ 14,15 ] ],   # 14 and 15 is CQ region for europe   
+          [ 1, 11, 'n', [ 14,15 ] ],  
+       [ 0, 0, 'd' ],
+];
diff --git a/filter/spots/K1XX.pl.issue b/filter/spots/K1XX.pl.issue
new file mode 100644 (file)
index 0000000..3f226ef
--- /dev/null
@@ -0,0 +1,27 @@
+#
+# This is an example filter for the 'isolated' node k1xx
+# 
+# I give him any spots that have a spotter or a spotted in the
+# US. In other filters on the UK side I do the opposite see 
+# GB7DJK.pl.issue
+#
+# The element list is:-
+#   0 = frequency
+#   1 = call
+#   2 = date in unix format
+#   3 = comment
+#   4 = spotter
+#   5 = spotted dxcc country
+#   6 = spotter's dxcc country
+#   7 = origin
+#   8 = spotted itu
+#   9 = spotted cq
+#   10 = spotter's itu
+#   11 = spotter's cq
+#
+
+$in = [
+          [ 1, 5, 'n', [ 226 ] ],         # dxcc country 226 is the US
+          [ 1, 6, 'a', [ 226 ] ],
+       [ 0, 0, 'd' ],                  # default action (don't forward)
+];
index b3929c1f2a2d5b45b53a09169294b29aa952952f..2b4fda78a20bf554916139a28157b52d20621342 100644 (file)
@@ -70,6 +70,9 @@ use vars qw(%channels %valid);
                  group => '0,Access Group,parray',     # used to create a group of users/nodes for some purpose or other
                  isolate => '9,Isolate network,yesno',
                  delayed => '9,Delayed messages,parray',
+                 annfilter => '9,Announce Filter',
+                 wwvfilter => '9,WWV Filter',
+                 spotfilter => '9,Spot Filter',
                 );
 
 # create a new channel object [$obj = DXChannel->new($call, $msg_conn_obj, $user_obj)]
index 2094cbfaea51d6e9abdf4cec110ac1b29093f3f3..bce0255fd4750002963821575ccd462f5173ddda 100644 (file)
@@ -22,6 +22,7 @@ use DXLogPrint;
 use DXBearing;
 use CmdAlias;
 use FileHandle;
+use Filter;
 use Carp;
 
 use strict;
@@ -87,6 +88,9 @@ sub start
        $self->send($self->msg('qll')) if !$user->qra || (!$user->lat && !$user->long);
        $self->send($self->msg('hnodee1')) if !$user->qth;
        $self->send($self->msg('msgnew')) if DXMsg::for_me($call);
+
+       # get the filters
+       $self->{spotfilter} = Filter::read_in('spots', $call);
        
        $self->send($self->msg('pr', $call));
 }
index dd6d178e1f523acd79a6f9e9f023c001b2a416c2..5a796935a65317bd79643a1311b073fe77b1a6bc 100644 (file)
@@ -11,6 +11,7 @@
 #
 # PC28 field 11 is the RR required flag
 # PC28 field 12 is a VIA routing (ie it is a node call) 
+#
 
 package DXMsg;
 
index 5797c63ff8d3c9d0e801eb49ce082053083cdafd..a16789c7e31a5ee94e8353be9996265e790e92c5 100644 (file)
@@ -22,6 +22,7 @@ use DXLog;
 use Spot;
 use DXProtout;
 use DXDebug;
+use Filter;
 use Local;
 
 use Carp;
@@ -106,6 +107,11 @@ sub start
        $self->{isolate} = $user->{isolate};
        $self->{consort} = $line;       # save the connection type
        $self->{here} = 1;
+
+       # get the filters
+       $self->{spotfilter} = Filter::read_in('spots', $call);
+       $self->{wwvfilter} = Filter::read_in('wwv', $call);
+       $self->{annfilter} = Filter::read_in('ann', $call);
        
        # set unbuffered
        $self->send_now('B',"0");
@@ -207,29 +213,45 @@ sub normal
 
             #
                        # @spot at this point contains:-
-            # freq, spotted call, time, text, spotter, spotted cc, spotters cc,
-            # orig node, spotted itu, spotted cq, spotters itu, spotters cq
+            # freq, spotted call, time, text, spotter, spotted cc, spotters cc, orig node
+                       # then  spotted itu, spotted cq, spotters itu, spotters cq
                        # you should be able to route on any of these
             #
                        
                        # local processing 
                        my $r;
                        eval {
-                               $r = Local::spot($self, $freq, $field[2], $d, $text, $spotter, $field[7]);
+                               $r = Local::spot($self, @spot);
                        };
 #                      dbg('local', "Local::spot1 error $@") if $@;
                        return if $r;
 
+                       # DON'T be silly and send on PC26s!
+                       return if $pcno == 26;
+
+                       # send out the filtered spots
+                       my @dxchan = get_all_ak1a();
+                       my $dxchan;
+       
+                       # send it if it isn't the except list and isn't isolated and still has a hop count
+                       foreach $dxchan (@dxchan) {
+                               next if $dxchan == $self;
+                               my $routeit = adjust_hops($dxchan, $line);  # adjust its hop count by node name
+                               my $filter = Filter::it($dxchan->{spotfilter}, @spot) if $dxchan->{spotfilter};
+                               if ($filter) {
+                                       $dxchan->send($routeit) if $routeit;
+                               } else {
+                                       $dxchan->send($routeit) unless $dxchan->{isolate} || !$routeit;
+                               }                                       
+                       }
+
                        # send orf to the users
-                       if (@spot && $pcno == 11) {
+                       if (@spot) {
                                my $buf = Spot::formatb($field[1], $field[2], $d, $text, $spotter);
                                broadcast_users("$buf\a\a", 'dx', $spot[0]);
                        }
 
-                       # DON'T be silly and send on PC26s!
-                       return if $pcno == 26;
-                       
-                       last SWITCH;
+                       return;
                }
                
                if ($pcno == 12) {              # announces
@@ -781,13 +803,19 @@ sub broadcast_list
        my $dxchan;
        
        foreach $dxchan (@_) {
+               my $filter = 1;
                
-               next if $sort eq 'dx' && !$dxchan->{dx};
+               if ($sort eq 'dx') {
+                   next unless $dxchan->{dx};
+                       $filter = Filter::it($dxchan->{spotfilter}, @{$fref}) if ref $fref;
+                       next unless $filter;
+               }
                next if $sort eq 'ann' && !$dxchan->{ann};
                next if $sort eq 'wwv' && !$dxchan->{wwv};
                next if $sort eq 'wx' && !$dxchan->{wx};
 
                $s =~ s/\a//og unless $dxchan->{beep};
+
                if ($dxchan->{state} eq 'prompt' || $dxchan->{state} eq 'convers') {
                        $dxchan->send($s);      
                } else {
index bc622e36490c1faa4a0050b4e208cbe9ba2dc9a2..1e1913a27af1cec13eeed03f51e2962191899521 100644 (file)
 #
 # $Id$
 #
+# The INSTRUCTIONS
+#
+# 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:-
+#
+# <some comment>
+# @in = (
+#      [ action, fieldno, fieldsort, comparison ],
+#      ...
+# );
+#
+# 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. 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 DXUtils;
+use DXUtil;
 use DXDebug;
+use Carp;
+
+use strict;
+
+use vars qw ($filterbasefn);
+
+$filterbasefn = "$main::root/filter";
 
 # initial filter system
 sub init
 {
+
 }
 
-sub compile
+#
+# 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 $ref;
+
+       # default action is 1
+       return 1 if !$filter;
+       
+       for $ref (@{$filter}) {
+               my ($action, $field, $fieldsort, $comp) = @{$ref};
+               if ($fieldsort eq 'n') {
+                       my $val = $_[$field];
+                       return $action  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 if $val >= $range[$i] && $val <= $range[$i+1];
+                       }
+               } elsif ($fieldsort eq 'a') {
+                       return $action  if $_[$field] =~ m{$comp};
+               } else {
+                       return $action;      # the default action
+               }
+       }
 }
 
+# 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";
+       my $in;
+       
+       if (-e $fn) {
+               do $fn;
+               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 "#
+# Filter for $call stored $today
+#
+\$in = [
+";
+
+       my $ref;
+       for $ref (@_) {
+               my ($action, $field, $fieldsort, $comp) = @{$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__
index c2917e2e69b52194afa4fa91374835daa855b96c..6f21535a39c0d17d5db6484982ea73205ac256eb 100644 (file)
@@ -69,7 +69,7 @@ sub add
        # automagically closes the output file (if any)). 
        $fp->writeunix($out[2], $buf);
   
-       return ($buf, $spotted_itu, $spotted_cq, $spotter_itu, $spotter_cq);
+       return (@spot, $spotted_itu, $spotted_cq, $spotter_itu, $spotter_cq);
 }
 
 # search the spot database for records based on the field no and an expression
@@ -83,7 +83,10 @@ sub add
 #   $f2 = date in unix format
 #   $f3 = comment
 #   $f4 = spotter
-#   $f5 = dxcc country
+#   $f5 = spotted dxcc country
+#   $f6 = spotter dxcc country
+#   $f7 = origin
+#
 #
 # In addition you can specify a range of days, this means that it will start searching
 # from <n> days less than today to <m> days less than today
index 0de499f62a4784b9cdbbb7271977374b04ba3a50..2ae98efcfb727d453e745c3b4bf77d57f15f752e 100755 (executable)
@@ -55,6 +55,7 @@ use Prefix;
 use Bands;
 use Geomag;
 use CmdAlias;
+use Filter;
 use Local;
 use Fcntl ':flock';