fix callsign prefix reporting issue (Coded by W7SST) (#129)

- use full callsign when calling ExtractPrefix
- change format of status message to list call prefix, not call

ARRL.pas

@@ -35,7 +35,7 @@   TDXCC= class
 implementation
 
 uses
-    SysUtils, Contnrs, log, PerlRegEx, pcre;
+    SysUtils, Contnrs, log, PerlRegEx, pcre, Ini;
 
 procedure TDXCC.LoadDxCCList;
 var
@@ -100,13 +100,13 @@ function TDXCC.SearchPrefix(out index : integer; const ACallPrefix : string) : B
 
 function TDXCC.FindRec(out dxrec : TDXCCRec; const ACallsign : string) : Boolean;
 var
-  sC, sP: string;
   index : integer;
 begin
   dxrec:= nil;
-  sC:= ExtractCallsign(ACallsign);
-  sP:= ExtractPrefix(sC);
-  Result:= SearchPrefix(index, sP);
+
+  // Use full call when extracting prefix, not user's call.
+  // Example: F6/W7SST should return 'F6' not 'W7' (station located within F6)
+  Result:= SearchPrefix(index, ACallsign);
   if Result then
     dxrec:= TDXCCRec(DXCCList.Items[index]);
 end;
@@ -115,32 +115,34 @@ function TDXCC.FindRec(out dxrec : TDXCCRec; const ACallsign : string) : Boolean
 function TDXCC.GetStationInfo(const ACallsign: string): string;
 var
   i : integer;
-  sC, sP: string;
+  sP: string;
 begin
   Result:= 'Unknown';
-  sC:= ExtractCallsign(ACallsign);
-  sP:= ExtractPrefix(sC);
+
+  // Use full call when extracting prefix, not user's call.
+  sP:= ExtractPrefix(ACallsign);
+
   if SearchPrefix(i, sP) then
-    Result:= sC + '  ' + TDXCCRec(DXCCList[i]).GetString;
+    Result:= sP + ':  ' + TDXCCRec(DXCCList[i]).GetString;
 end;
 
 function TDXCC.Search(ACallsign: string): string;
 var
     reg: TPerlRegEx;
     i: integer;
-    s, sC, sP: string;
+    s, sP: string;
 begin
     reg := TPerlRegEx.Create();
     try
         Result:= '';
-        sC:= ExtractCallsign(ACallsign);
-        sP:= ExtractPrefix(sC);
+        // Use full call when extracting prefix, not user's call.
+        sP:= ExtractPrefix(ACallsign);
         reg.Subject := UTF8Encode(sP);
         for i:= DXCCList.Count - 1 downto 0 do begin
             s:= '^(' + TDXCCRec(DXCCList.Items[i]).prefixReg + ')';
             reg.RegEx:= UTF8Encode(s);
             if Reg.Match then begin
-                Result:= sC + '  ' + TDXCCRec(DXCCList[i]).GetString;
+                Result:= sP + ':  ' + TDXCCRec(DXCCList[i]).GetString;
                 Break;
             end;
         end;
@@ -173,7 +175,11 @@ procedure TDXCC.Delimit(var AStringList: TStringList; const AText: string);
 
 function TDXCCRec.GetString: string;
 begin
-    Result:= Format('%s/%s;  ITU Zone:%s;  CQ Zone:%s', [Entity, Continent, ITU, CQ]);
+  // make the long USA entry a little shorter (similar to N1MM)
+  if Entity = 'United States of America' then
+    Result:= Format('%s/United States;  ITU Zone: %s;  CQ Zone: %s', [Continent, ITU, CQ])
+  else
+    Result:= Format('%s/%s;  ITU Zone: %s;  CQ Zone: %s', [Continent, Entity, ITU, CQ]);
 end;
 
 end.

Log.pas

@@ -25,6 +25,9 @@ function FormatScore(const AScore: integer):string;
 procedure UpdateSbar(const ACallsign: string);
 function ExtractCallsign(Call: string): string;
 function ExtractPrefix(Call: string): string;
+{$ifdef DEBUG}
+function ExtractPrefix0(Call: string): string;
+{$endif}
 
 type
   PQso = ^TQso;
@@ -61,6 +64,9 @@   THisto= class(TObject)
   CallSent: boolean; // msgHisCall has been sent; cleared upon edit.
   NrSent: boolean;   // msgNR has been sent. Seems to imply exchange sent.
   Histo: THisto;
+{$ifdef DEBUG}
+  RunUnitTest : boolean;  // run ExtractPrefix unit tests once
+{$endif}
 
 
 implementation
@@ -303,7 +309,9 @@ function ExtractCallsign(Call: string):string;
     end;
 end;
 
-function ExtractPrefix(Call: string): string;
+
+{$ifdef DEBUG}
+function ExtractPrefix0(Call: string): string;
 var
     reg: TPerlRegEx;
 begin
@@ -318,7 +326,9 @@ function ExtractPrefix(Call: string): string;
         reg.Free;
     end;
 end;
-{
+{$endif}
+
+
 function ExtractPrefix(Call: string): string;
 const
   DIGITS = ['0'..'9'];
@@ -327,6 +337,30 @@ function ExtractPrefix(Call: string): string;
   p: integer;
   S1, S2, Dig: string;
 begin
+{$ifdef DEBUG}
+  if RunUnitTest then begin
+    RunUnitTest := false;
+    // original algorithm
+    assert(ExtractPrefix0('W7SST') = 'W7');
+    assert(ExtractPrefix0('W7SST/6') = 'W7');  // should be 'W6'
+    assert(ExtractPrefix0('N7SST/6') = 'N7');  // should be 'N6'
+    assert(ExtractPrefix0('F6/W7SST') = 'F6');
+    assert(ExtractPrefix0('F6/AB7Q') = 'F6');
+    assert(ExtractPrefix0('W7SST/W') = 'W7');  // should be 'W0'
+    assert(ExtractPrefix0('F6FVY/W7') = 'F6'); // should be 'W7'
+
+    // newer algorithm
+    assert(ExtractPrefix('W7SST') = 'W7');
+    assert(ExtractPrefix('W7SST/6') = 'W6');
+    assert(ExtractPrefix('N7SST/6') = 'N6');
+    assert(ExtractPrefix('F6/W7SST') = 'F6');
+    assert(ExtractPrefix('W7SST/W') = 'W0');
+    assert(ExtractPrefix('F6FVY/W7') = 'W7');
+    assert(ExtractPrefix('F6/W7SST/P') = 'F6');
+    assert(ExtractPrefix('W7SST/W/QRP') = 'W0');
+    assert(ExtractPrefix('F6FVY/W7/MM') = 'W7');
+  end;
+{$endif}
   //kill modifiers
   Call := Call + '|';
   Call := StringReplace(Call, '/QRP|', '', []);
@@ -390,7 +424,7 @@ function ExtractPrefix(Call: string): string;
 
   Result := Copy(Result, 1, 5);
 end;
-}
+
 
 procedure SaveQso;
 var
@@ -475,7 +509,8 @@ procedure SaveQso;
     end;
 
     Qso.RawCallsign:= ExtractCallsign(Qso.Call);
-    Qso.Pfx := ExtractPrefix(Qso.RawCallsign);
+    // Use full call when extracting prefix, not user's call.
+    Qso.Pfx := ExtractPrefix(Qso.Call);
     {if PfxList.Find(Qso.Pfx, Idx) then Qso.Pfx := '' else }
     PfxList.Add(Qso.Pfx);
     if Ini.RunMode = rmHst then
@@ -650,6 +685,9 @@ initialization
   PfxList := TStringList.Create;
   PfxList.Sorted := true;
   PfxList.Duplicates := dupIgnore;
+{$ifdef DEBUG}
+  RunUnitTest := true;
+{$endif}
 
 finalization
   PfxList.Free;