From c5e90df0d93d141f8687556a708068521b9b8f77 Mon Sep 17 00:00:00 2001
From: minima <minima>
Date: Wed, 18 Oct 2000 20:16:16 +0000
Subject: [PATCH] force pings (and other PC frames) to go down a local
 connection if available.

---
 Changes           |  3 +++
 perl/DXChannel.pm |  6 +++---
 perl/DXProt.pm    | 38 ++++++++++++++++----------------------
 perl/DXUtil.pm    | 24 +++++++++++++++++++++++-
 4 files changed, 45 insertions(+), 26 deletions(-)

diff --git a/Changes b/Changes
index 53b14944..f0eca38e 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,6 @@
+17Oct00=======================================================================
+1. force frames to go down the local interface when doing a route. This is 
+particularly important for pings!
 16Oct00=======================================================================
 1. add a ':' after 'G7BRN de G1TLH' in a talk message.
 2. added /J to the list of things to ignore (as in G1TLH/J) in prefix 
diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index 17f34919..d975ca0d 100644
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -17,9 +17,9 @@
 #
 # PLEASE NOTE - I am a C programmer using this as a method of learning perl
 # firstly and OO about ninthly (if you don't like the design and you can't 
-# improve it with better OO by make it smaller and more efficient, then tough). 
+# improve it with better OO and thus make it smaller and more efficient, then tough). 
 #
-# Copyright (c) 1998 - Dirk Koopman G1TLH
+# Copyright (c) 1998-2000 - Dirk Koopman G1TLH
 #
 # $Id$
 #
@@ -87,7 +87,7 @@ use vars qw(%channels %valid);
 		  pingave => '0,Ping ave time',
 		  logininfo => '9,Login info req,yesno',
 		  talklist => '0,Talk List,parray',
-		  node => '5,Node data',
+		  cluster => '5,Cluster data',
 		 );
 
 # object destruction
diff --git a/perl/DXProt.pm b/perl/DXProt.pm
index 60e0391f..1f2a6428 100644
--- a/perl/DXProt.pm
+++ b/perl/DXProt.pm
@@ -178,15 +178,6 @@ sub init
 	confess $@ if $@;
 	$me->{sort} = 'S';    # S for spider
 
-	# now prime the spot and wwv  duplicates file with data
-#    my @today = Julian::unixtoj(time);
-#	for (Spot::readfile(@today), Spot::readfile(Julian::sub(@today, 1))) {
-#		Spot::dup(@{$_}[0..3]);
-#	}
-#	for (Geomag::readfile(time)) {
-#		Geomag::dup(@{$_}[1..5]);
-#	}
-
 	# load the baddx file
 	do "$baddxfn" if -e "$baddxfn";
 	print "$@\n" if $@;
@@ -1362,19 +1353,22 @@ sub send_local_config
 sub route
 {
 	my ($self, $call, $line) = @_;
-	my $cl = DXCluster->get_exact($call);
-	if ($cl) {       # don't route it back down itself
-		if (ref $self && $call eq $self->{call}) {
-			dbg('chan', "Trying to route back to source, dropped");
-			return;
-		}
-		my $hops;
-		my $dxchan = $cl->{dxchan};
-		if ($dxchan) {
-			my $routeit = adjust_hops($dxchan, $line);   # adjust its hop count by node name
-			if ($routeit) {
-				$dxchan->send($routeit) if $dxchan;
-			}
+
+	if (ref $self && $call eq $self->{call}) {
+		dbg('chan', "Trying to route back to source, dropped");
+		return;
+	}
+
+	# always send it down the local interface if available
+	my $dxchan = DXChannel->get($call);
+	unless ($dxchan) {
+		my $cl = DXCluster->get_exact($call);
+		$dxchan = $cl->dxchan if $cl;
+	}
+	if ($dxchan) {
+		my $routeit = adjust_hops($dxchan, $line);   # adjust its hop count by node name
+		if ($routeit) {
+			$dxchan->send($routeit);
 		}
 	}
 }
diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm
index 286f6f22..2c05372c 100644
--- a/perl/DXUtil.pm
+++ b/perl/DXUtil.pm
@@ -17,7 +17,7 @@ require Exporter;
 @EXPORT = qw(atime ztime cldate cldatetime slat slong yesno promptf 
 			 parray parraypairs shellregex readfilestr writefilestr
              print_all_fields cltounix iscallsign unpad is_callsign
-			 is_freq is_digits is_pctext is_pcflag
+			 is_freq is_digits is_pctext is_pcflag insertitem deleteitem
             );
 
 @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
@@ -319,3 +319,25 @@ sub is_digits
 {
 	return $_[0] =~ /^[\d]+$/;
 }
+
+# insert an item into a list if it isn't already there returns 1 if there 0 if not
+sub insertitem
+{
+	my $list = shift;
+	my $item = shift;
+	
+	return 1 if grep {$_ eq $item } @$list;
+	push @$list, $item;
+	return 0;
+}
+
+# delete an item from a list if it is there returns no deleted 
+sub deleteitem
+{
+	my $list = shift;
+	my $item = shift;
+	my $n = @$list;
+	
+	@$list = grep {$_ ne $item } @$list;
+	return $n - @$list;
+}
-- 
2.43.0