fixed A & K to be right way round

[spider.git] / perl / DXProt.pm

diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 0cc714135317ff1119a0dc786a326b2b81c8c23f..5797c63ff8d3c9d0e801eb49ce082053083cdafd 100644 (file)
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -27,7 +27,9 @@ use Local;
 use Carp;
 
 use strict;
-use vars qw($me $pc11_max_age $pc11_dup_age $pc23_dup_age %spotdup %wwvdup $last_hour %pings %rcmds %nodehops);
+use vars qw($me $pc11_max_age $pc11_dup_age $pc23_dup_age 
+                       %spotdup %wwvdup $last_hour %pings %rcmds 
+                       %nodehops @baddx $baddxfn);
 
 $me = undef;                                   # the channel id for this cluster
 $pc11_max_age = 1*3600;                        # the maximum age for an incoming 'real-time' pc11
@@ -39,7 +41,9 @@ $last_hour = time;                            # last time I did an hourly periodic update
 %pings = ();                    # outstanding ping requests outbound
 %rcmds = ();                    # outstanding rcmd requests outbound
 %nodehops = ();                 # node specific hop control
+@baddx = ();                    # list of illegal spotted callsigns
 
+$baddxfn = "$main::data/baddx.pl";
 
 sub init
 {
@@ -69,6 +73,9 @@ sub init
                $wwvdup{$dupkey} = $_->[1];
        }
 
+       # load the baddx file
+       do "$baddxfn" if -e "$baddxfn";
+       print "$@\n" if $@;
 }
 
 #
@@ -138,7 +145,7 @@ sub normal
        eval {
                $pcr = Local::pcprot($self, $pcno, @field);
        };
-       dbg('local', "Local::pcprot error $@") if $@;
+#      dbg('local', "Local::pcprot error $@") if $@;
        return if $pcr;
        
  SWITCH: {
@@ -189,21 +196,34 @@ sub normal
                        }
                        
                        $spotdup{$dupkey} = $d;
+
+                       # is it 'baddx'
+                       if (grep $field[2] eq $_, @baddx) {
+                               dbg('chan', "Bad DX spot, ignored");
+                               return;
+                       }
                        
-                       my $spot = Spot::add($freq, $field[2], $d, $text, $spotter, $field[7]);
+                       my @spot = Spot::add($freq, $field[2], $d, $text, $spotter, $field[7]);
+
+            #
+                       # @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
+                       # you should be able to route on any of these
+            #
                        
                        # local processing 
                        my $r;
                        eval {
-                               $r = Local::spot1($self, $freq, $field[2], $d, $text, $spotter, $field[7]);
+                               $r = Local::spot($self, $freq, $field[2], $d, $text, $spotter, $field[7]);
                        };
-                       dbg('local', "Local::spot1 error $@") if $@;
+#                      dbg('local', "Local::spot1 error $@") if $@;
                        return if $r;
 
                        # send orf to the users
-                       if ($spot && $pcno == 11) {
+                       if (@spot && $pcno == 11) {
                                my $buf = Spot::formatb($field[1], $field[2], $d, $text, $spotter);
-                               broadcast_users("$buf\a\a", 'dx', $spot);
+                               broadcast_users("$buf\a\a", 'dx', $spot[0]);
                        }
 
                        # DON'T be silly and send on PC26s!
@@ -271,7 +291,7 @@ sub normal
                        
                        for ($i = 2; $i < $#field; $i++) {
                                my ($call, $confmode, $here) = $field[$i] =~ /^(\S+) (\S) (\d)/o;
-                               next if length $call < 3 || length $call > 8;
+                               next if !$call || length $call < 3 || length $call > 8;
                                next if !$confmode;
                                $call = uc $call;
                                next if DXCluster->get_exact($call); # we already have this (loop?)
@@ -396,16 +416,16 @@ sub normal
 
                        my $r;
                        eval {
-                               $r = Local::wwv2($self, $field[1], $field[2], $sfi, $k, $i, @field[6..$#field]);
+                               $r = Local::wwv($self, $field[1], $field[2], $sfi, $k, $i, @field[6..$#field]);
                        };
-                       dbg('local', "Local::wwv2 error $@") if $@;
+#                      dbg('local', "Local::wwv2 error $@") if $@;
                        return if $r;
 
                        # DON'T be silly and send on PC27s!
                        return if $pcno == 27;
 
                        # broadcast to the eager users
-                       broadcast_users("WWV de $field[7] <$field[2]>:   SFI=$sfi, K=$k, A=$i, $field[6]", 'wwv', $wwv );
+                       broadcast_users("WWV de $field[7] <$field[2]>:   SFI=$sfi, A=$k, K=$i, $field[6]", 'wwv', $wwv );
                        last SWITCH;
                }
                
@@ -545,7 +565,7 @@ sub normal
                
                if ($pcno == 50) {              # keep alive/user list
                        my $ref = DXCluster->get_exact($field[1]);
-                       $ref->update_users($field[2]) if $ref;
+                       $ref->update_users($field[2]) if $ref;                  
                        last SWITCH;
                }
                
@@ -672,8 +692,11 @@ sub send_local_config
                @nodes = (DXCluster->get_exact($main::mycall));
        } else {
                # create a list of all the nodes that are not connected to this connection
-               @nodes = DXNode::get_all();
+               # and are not themselves isolated, this to make sure that isolated nodes
+        # don't appear outside of this node
+               @nodes = DXNode::get_all(); 
                @nodes = grep { $_->dxchan != $self } @nodes;
+               @nodes = grep { !($_->dxchan && $_->dxchan->isolate) } @nodes;
        }
 
        my @s = $me->pc19(@nodes);