From 8b5b37b4dc0816f5c8c00e1b0220dbcd7f3e5d6f Mon Sep 17 00:00:00 2001 From: Mike Brashler Date: Fri, 4 Nov 2022 04:27:11 -0700 Subject: [PATCH] fix callsign prefix selection issue (F6/W7SST now extracts F6, not W7) - use full callsign when calling ExtractPrefix - change format of status message to list call prefix, not call --- ARRL.pas | 34 ++++++++++++++++++++-------------- Log.pas | 46 ++++++++++++++++++++++++++++++++++++++++++---- 2 files changed, 62 insertions(+), 18 deletions(-) diff --git a/ARRL.pas b/ARRL.pas index 2538620..902ef95 100644 --- a/ARRL.pas +++ b/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. diff --git a/Log.pas b/Log.pas index 05bb547..5d9c558 100644 --- a/Log.pas +++ b/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;