From 6b6eda0362049fd67809f2789e523708a1a8cb13 Mon Sep 17 00:00:00 2001
From: minima <minima>
Date: Mon, 24 Jun 2002 15:21:17 +0000
Subject: [PATCH] added k1b and 3xa changed prefix searching so it goes from
 right to left instead of the other way around. This may leave stuff out...

---
 Changes             | 2 ++
 cmd/show/prefix.pl  | 5 +++--
 data/cty.dat        | 4 ++--
 data/prefix_data.pl | 2 ++
 perl/DXUtil.pm      | 2 +-
 perl/Prefix.pm      | 9 ++++++---
 6 files changed, 16 insertions(+), 8 deletions(-)

diff --git a/Changes b/Changes
index 800dc23d..c1115669 100644
--- a/Changes
+++ b/Changes
@@ -1,6 +1,8 @@
 24Jun02=======================================================================
 1. make set/badspotter non SSID sensitive. Set/badnode is left to be SSID
 sensitive. 
+2. added 3XA(=3X) and K1B(=KH1) also changed the logic of sh/prefix. This
+may break things, please test it. 
 19Jun02=======================================================================
 1. make set/badspotter and set/badnode apply to announces and talks as well
 as spots. 
diff --git a/cmd/show/prefix.pl b/cmd/show/prefix.pl
index a1290379..ed53d927 100644
--- a/cmd/show/prefix.pl
+++ b/cmd/show/prefix.pl
@@ -13,12 +13,13 @@ my @out;
 #print "line: $line\n";
 foreach $l (@list) {
   my @ans = Prefix::extract($l);
-  #print "ans:", @ans, "\n";
+  my $dd = new Data::Dumper([ \@ans ]);
+  print "ans:", $dd->Dumpxs;
   next if !@ans;
   my $pre = shift @ans;
   my $a;
   foreach $a (@ans) {
-    push @out, sprintf "%s DXCC: %d ITU: %d CQ: %d LL: %s %s (%s, %s)", uc $l, $a->dxcc(), $a->itu(), $a->cq(), slat($a->lat), slong($a->long), $pre, $a->name();
+    push @out, sprintf "%s DXCC: %d ITU: %d CQ: %d LL: %s %s (%s, %s)", uc $l, $a->dxcc, $a->itu, $a->cq, slat($a->lat), slong($a->long), $pre, $a->name;
 	$l = " " x length $l;
   }
 }
diff --git a/data/cty.dat b/data/cty.dat
index c876d7bb..596dff12 100644
--- a/data/cty.dat
+++ b/data/cty.dat
@@ -28,7 +28,7 @@ Tunisia:                  33:  37:  AF:   36.80:   -10.20:    -1.0:  3V:
 Vietnam:                  26:  49:  AS:   10.80:  -106.70:    -7.0:  3W:
     3W,XV;
 Republic of Guinea:       35:  46:  AF:    9.50:    13.70:     0.0:  3X:
-    3X;
+    3X,3XA;
 Bouvet:                   38:  67:  AF:  -54.50:    -3.40:     0.0:  3Y/b:
     3Y;
 Peter I I.:               12:  72:  SA:  -68.80:    90.60:     6.0:  3Y/p:
@@ -413,7 +413,7 @@ Guantanamo Bay:           08:  11:  NA:   19.90:    75.20:     5.0:  KG4:
 Mariana Is.:              27:  64:  OC:   15.20:  -145.80:    10.0:  KH0:
     AH0,KG6SL,KH0,NH0,WH0;
 Baker & Howland Is.:      31:  61:  OC:    0.50:   176.00:    11.0:  KH1:
-    AH1,KH1,NH1,WH1;
+    AH1,KH1,NH1,WH1,K1B;
 Guam:                     27:  64:  OC:   13.50:  -144.80:   -10.0:  KH2:
     AH2,KG6ASO,KH2,NH2,WH2;
 Johnston I.:              31:  61:  OC:   16.80:   169.50:    10.0:  KH3:
diff --git a/data/prefix_data.pl b/data/prefix_data.pl
index 637c7c8c..5b221bd8 100644
--- a/data/prefix_data.pl
+++ b/data/prefix_data.pl
@@ -265,6 +265,7 @@
   '3V' => '13',
   '3W' => '14',
   '3X' => '15',
+  '3XA' => '15',
   '3Y' => '16,17',
   '3Y/B' => '16',
   '3Y/P' => '17',
@@ -1228,6 +1229,7 @@
   'K0PP' => '293',
   'K0TV' => '293',
   'K1' => '473,474,475,476,477,478',
+  'K1B' => '169',
   'K1KY' => '293',
   'K1VWL/BY1QH' => '68,346,347',
   'K2' => '479,480',
diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm
index 0942c69a..4ea3782e 100644
--- a/perl/DXUtil.pm
+++ b/perl/DXUtil.pm
@@ -340,7 +340,7 @@ sub unpad
 # check that a field only has callsign characters in it
 sub is_callsign
 {
-	return $_[0] =~ /^(?:[A-Z]{1,2}\d+|\d[A-Z]\d+)[A-Z]{1,3}(?:-\d{1,2}|\/(?:[A-Z]{1,2}\d{0,2}|\d[A-Z]\d{0,2}))?$/;
+	return $_[0] =~ /^(?:[A-Z]{1,2}\d+|\d[A-Z]{1,2}\d+)[A-Z]{1,3}(?:-\d{1,2}|\/(?:[A-Z]{1,2}\d{0,2}|\d[A-Z]\d{0,2}))?$/;
 }
 
 # check that a PC protocol field is valid text
diff --git a/perl/Prefix.pm b/perl/Prefix.pm
index 01e3079c..15b6752d 100644
--- a/perl/Prefix.pm
+++ b/perl/Prefix.pm
@@ -177,12 +177,15 @@ sub extract
 		foreach $p (@parts) {
 			$sp = $p if length $sp > length $p;
 		}
-		# now start to resolve it from the left hand end
-		for ($i = 1; $i <= length $sp; ++$i) {
+#		# now start to resolve it from the left hand end
+#		for ($i = 1; $i <= length $sp; ++$i) {
+		# now start to resolve it from the right hand end
+		for ($i = length $sp; $i >= 1; --$i) {
 			my @wout = get(substr($sp, 0, $i));
 			last if @wout > 0 && $wout[0] gt $sp;
-			last if @wout == 0;
+#			last if @wout == 0;
 			push @out, @wout;
+			last if @wout;
 		}
 	}
 	return @out;
-- 
2.43.0