implement displayLanguage checking

library/fhir/fhir_factory.pas

@@ -36,7 +36,7 @@ interface
 uses
   SysUtils, Classes,
   fsl_base, fsl_utilities, fsl_collections, fsl_json, fsl_xml, fsl_stream, fsl_http, fsl_npm_cache, fsl_i18n,
-  fsl_ucum, fsl_npm, fsl_threads, fsl_web_stream,
+  fsl_ucum, fsl_npm, fsl_threads, fsl_web_stream, fsl_lang,
   fhir_objects, fhir_parser, fhir_narrative, fhir_pathengine, fhir_common, fhir_xhtml,
   fhir_elementmodel, fhir_client, fhir_uris;
 
@@ -266,12 +266,13 @@   TFHIRVersionFactories = class (TFslObject)
   TFHIRWorkerContextWithFactory = class (TFHIRWorkerContextV)
   private
     FFactory : TFHIRFactory;
+    FLanguages : TIETFLanguageDefinitions;
     FLoadInfo : TPackageLoadingInformation;
     FPcm : TFHIRPackageManager;
   protected
     function sizeInBytesV(magic : integer) : cardinal; override;
   public
-    constructor Create(factory : TFHIRFactory; pcm : TFHIRPackageManager); overload; virtual;
+    constructor Create(languages : TIETFLanguageDefinitions; factory : TFHIRFactory; pcm : TFHIRPackageManager); overload; virtual;
     destructor Destroy; override;
 
     function link : TFHIRWorkerContextWithFactory;
@@ -1204,10 +1205,11 @@ procedure TFHIRVersionFactories.SetVersion(v: TFHIRVersion; const Value: TFHIRFa
 
 { TFHIRWorkerContextWithFactory }
 
-constructor TFHIRWorkerContextWithFactory.Create(factory: TFHIRFactory; pcm : TFHIRPackageManager);
+constructor TFHIRWorkerContextWithFactory.Create(languages : TIETFLanguageDefinitions; factory: TFHIRFactory; pcm : TFHIRPackageManager);
 begin
   inherited Create;
   FFactory := factory;
+  FLanguages := languages;
   FLoadInfo := TPackageLoadingInformation.Create(FFactory.versionString);
   FLoadInfo.OnLoadEvent := loadResourceJson;
   FPcm := pcm;
@@ -1218,6 +1220,7 @@ destructor TFHIRWorkerContextWithFactory.Destroy;
   FPcm.free;
   FLoadInfo.free;
   FFactory.free;
+  Flanguages.free;
   inherited;
 end;
 

library/fhir/fhir_tx.pas

@@ -83,6 +83,7 @@   TFhirExpansionParamsVersionRule = class (TFslObject)
 
   TFHIRTxOperationParams = class (TFslObject)
   private
+    FLanguages : TIETFLanguageDefinitions;
     FVersionRules : TFslList<TFhirExpansionParamsVersionRule>;
     FValueSetVersionRules : TStringList;
     FactiveOnly: boolean;
@@ -141,11 +142,11 @@   TFHIRTxOperationParams = class (TFslObject)
   protected
     function sizeInBytesV(magic : integer) : cardinal; override;
   public
-    constructor Create; override;
+    constructor Create(Languages : TIETFLanguageDefinitions);
     destructor Destroy; override;
     function link : TFHIRTxOperationParams;
 
-    class function defaultProfile : TFHIRTxOperationParams;
+    class function defaultProfile(langDefs : TIETFLanguageDefinitions) : TFHIRTxOperationParams;
 
     procedure seeParameter(name : String; value : TFHIRObject; isValidation, overwrite : boolean);
 
@@ -341,8 +342,8 @@ procedure TTerminologyOperationContext.log(note: String);
   s : string;
 begin
   s := inttostr(GetTickCount64 - FStartTime)+'ms '+note;
-  if UnderDebugger then
-    Logging.log(s);
+  //if UnderDebugger then
+  //  Logging.log(s);
   FTimeTracker.step(s);
 end;
 
@@ -351,8 +352,8 @@ procedure TTerminologyOperationContext.addNote(vs : TFHIRValueSetW; note : Strin
   s : string;
 begin
   s := inttostr(GetTickCount64 - FStartTime)+'ms '+vs.vurl+': '+note;
-  if UnderDebugger then
-    Logging.log(s);
+  //if UnderDebugger then
+  //  Logging.log(s);
   FTimeTracker.step(s);
 end;
 
@@ -662,7 +663,7 @@ procedure TFHIRCodeSystemInformationProvider.lookupCode(opContext : TTxOperation
       result := StringArrayExistsInsensitive(props, name) or StringArrayExistsInsensitive(props, '*') ;
   end;
 begin
-  params := TFHIRTxOperationParams.Create;
+  params := TFHIRTxOperationParams.Create(FLanguages.link);
   try
     params.defaultToLatestVersion := true;
     provider := findCodeSystem(coding.systemUri, coding.version, profile, [cscmComplete, cscmFragment], false);
@@ -708,13 +709,14 @@ procedure TFHIRCodeSystemInformationProvider.lookupCode(opContext : TTxOperation
 
 { TFHIRTxOperationParams }
 
-constructor TFHIRTxOperationParams.Create;
+constructor TFHIRTxOperationParams.Create(Languages : TIETFLanguageDefinitions);
 begin
-  inherited;
+  inherited Create;
   FVersionRules := TFslList<TFhirExpansionParamsVersionRule>.create;
   FProperties := TStringList.create;
   FAltCodeRules := TAlternateCodeOptions.create;
   FDesignations := TStringlist.create;
+  FLanguages := languages;
 
   FGenerateNarrative := true;
 end;
@@ -827,17 +829,17 @@ function TFHIRTxOperationParams.sizeInBytesV(magic : integer) : cardinal;
   inc(result, (FUid.length * sizeof(char)) + 12);
 end;
 
-class function TFHIRTxOperationParams.defaultProfile: TFHIRTxOperationParams;
+class function TFHIRTxOperationParams.defaultProfile(langDefs : TIETFLanguageDefinitions): TFHIRTxOperationParams;
 begin
-  result := TFHIRTxOperationParams.Create;
+  result := TFHIRTxOperationParams.Create(langDefs);
 end;
 
 procedure TFHIRTxOperationParams.seeParameter(name: String; value: TFHIRObject; isValidation, overwrite: boolean);
 begin
   if (value <> nil) then
   begin
     if (name = 'displayLanguage') and (not HasHTTPLanguages or overwrite) then
-      DisplayLanguages := THTTPLanguageList.create(value.primitiveValue, not isValidation);
+      DisplayLanguages := THTTPLanguageList.create(FLanguages.link, value.primitiveValue, not isValidation);
 
     if (name = 'includeAlternateCodes') then
       altCodeRules.seeParam(value.primitiveValue);
@@ -939,6 +941,7 @@ destructor TFHIRTxOperationParams.Destroy;
   FProperties.free;
   FDesignations.free;
   FValueSetVersionRules.free;
+  FLanguages.free;
   inherited;
 end;
 

library/fhir3/fhir3_profiles.pas

@@ -35,7 +35,7 @@ interface
 
 uses
   SysUtils, Types, Classes, {$IFDEF DELPHI} IOUtils, {$ENDIF}
-  fsl_base, fsl_utilities, fsl_threads, fsl_stream, fsl_collections, fsl_http, fsl_fpc, fsl_npm_cache,
+  fsl_base, fsl_utilities, fsl_threads, fsl_stream, fsl_collections, fsl_http, fsl_fpc, fsl_npm_cache, fsl_lang,
   fhir_objects, fhir_parser, fhir_factory, fhir_uris, fhir_common,
   fhir3_resources, fhir3_types, fhir3_context, fhir3_utilities, fhir3_constants, fhir3_factory, fhir3_resources_base;
 
@@ -126,7 +126,7 @@   TBaseWorkerContextR3 = class abstract (TFHIRWorkerContext)
     procedure SetProfiles(const Value: TProfileManager);
     procedure Load(packageId : String; feed: TFHIRBundle);
   public
-    constructor Create(factory : TFHIRFactory; pcm : TFHIRPackageManager); Override;
+    constructor Create(languages : TIETFLanguageDefinitions; factory : TFHIRFactory; pcm : TFHIRPackageManager); Override;
     destructor Destroy; Override;
     function link : TBaseWorkerContextR3; overload;
     procedure Unload; override;
@@ -1539,7 +1539,7 @@ procedure TBaseWorkerContextR3.listStructures(list : TFslList<TFHIRStructureDefi
     list.add(sd.link);
 end;
 
-constructor TBaseWorkerContextR3.Create(factory : TFHIRFactory; pcm : TFHIRPackageManager);
+constructor TBaseWorkerContextR3.Create(languages : TIETFLanguageDefinitions; factory : TFHIRFactory; pcm : TFHIRPackageManager);
 begin
   inherited;
   FNamingSystems := TFslMap<TFhirResourceProxy>.Create('profiles.ns');

library/fhir4/fhir4_profiles.pas

@@ -36,7 +36,7 @@ interface
 
 uses
   SysUtils, Classes, {$IFDEF DELPHI} IOUtils, {$ENDIF} Types,
-  fsl_base, fsl_utilities, fsl_fpc, fsl_threads, fsl_stream, fsl_collections, fsl_http, fsl_npm_cache,
+  fsl_base, fsl_utilities, fsl_fpc, fsl_threads, fsl_stream, fsl_collections, fsl_http, fsl_npm_cache, fsl_lang,
   fhir_objects, fhir_parser, fhir_factory, fhir_uris, fhir_common,
   fhir4_resources, fhir4_parser, fhir4_types, fhir4_context, fhir4_utilities, fhir4_constants, fhir4_resources_base;
 
@@ -129,7 +129,7 @@   TBaseWorkerContextR4 = class abstract (TFHIRWorkerContext)
     procedure SetProfiles(const Value: TProfileManager);
     procedure Load(packageId : String; feed: TFHIRBundle);
   public
-    constructor Create(factory : TFHIRFactory; pcm : TFHIRPackageManager); Override;
+    constructor Create(languages : TIETFLanguageDefinitions; factory : TFHIRFactory; pcm : TFHIRPackageManager); Override;
     destructor Destroy; Override;
     function link : TBaseWorkerContextR4; overload;
     procedure Unload; override;
@@ -1560,7 +1560,7 @@ procedure TBaseWorkerContextR4.listStructures(list : TFslList<TFHIRStructureDefi
     list.add(sd.link);
 end;
 
-constructor TBaseWorkerContextR4.Create(factory : TFHIRFactory; pcm : TFHIRPackageManager);
+constructor TBaseWorkerContextR4.Create(languages : TIETFLanguageDefinitions; factory : TFHIRFactory; pcm : TFHIRPackageManager);
 begin
   inherited;
   FLock := TFslLock.Create('worker-context r4');

library/fhir4/tests/fhir4_tests_worker.pas

@@ -99,7 +99,7 @@ class function TTestingWorkerContext4.Use: TFHIRWorkerContext;
 begin
   if GWorkerContext = nil then
   begin
-    GWorkerContext := TTestingWorkerContext4.Create(TFHIRFactoryR4.create, TFHIRPackageManager.Create(npmModeUser));
+    GWorkerContext := TTestingWorkerContext4.Create(nil, TFHIRFactoryR4.create, TFHIRPackageManager.Create(npmModeUser));
     pcm := TFHIRPackageManager.Create(npmModeUser);
     li := TPackageLoadingInformation.Create(fhir4_constants.FHIR_GENERATED_VERSION);
     try

library/fhir4b/fhir4b_profiles.pas

@@ -36,7 +36,7 @@ interface
 
 uses
   SysUtils, Classes, {$IFDEF DELPHI} IOUtils, {$ENDIF} Types,
-  fsl_base, fsl_utilities, fsl_fpc, fsl_threads, fsl_stream, fsl_collections, fsl_http, fsl_npm_cache,
+  fsl_base, fsl_utilities, fsl_fpc, fsl_threads, fsl_stream, fsl_collections, fsl_http, fsl_npm_cache, fsl_lang,
   fhir_objects, fhir_parser, fhir_factory, fhir_uris, fhir_common,
   fhir4b_resources, fhir4b_parser, fhir4b_enums, fhir4b_types, fhir4b_context, fhir4b_utilities, fhir4b_constants, fhir4b_resources_base;
 
@@ -129,7 +129,7 @@   TBaseWorkerContextR4B = class abstract (TFHIRWorkerContext)
     procedure SetProfiles(const Value: TProfileManager);
     procedure Load(packageId : String; feed: TFHIRBundle);
   public
-    constructor Create(factory : TFHIRFactory; pcm : TFHIRPackageManager); Override;
+    constructor Create(languages : TIETFLanguageDefinitions; factory : TFHIRFactory; pcm : TFHIRPackageManager); Override;
     destructor Destroy; Override;
     function link : TBaseWorkerContextR4B; overload;
     procedure Unload; override;
@@ -1560,7 +1560,7 @@ procedure TBaseWorkerContextR4B.listStructures(list : TFslList<TFHIRStructureDef
     list.add(sd.link);
 end;
 
-constructor TBaseWorkerContextR4B.Create(factory : TFHIRFactory; pcm : TFHIRPackageManager);
+constructor TBaseWorkerContextR4B.Create(languages : TIETFLanguageDefinitions; factory : TFHIRFactory; pcm : TFHIRPackageManager);
 begin
   inherited;
   FLock := TFslLock.Create('worker-context r4');

library/fhir4b/tests/fhir4b_tests_worker.pas

@@ -99,7 +99,7 @@ class function TTestingWorkerContext4B.Use: TFHIRWorkerContext;
 begin
   if GWorkerContext = nil then
   begin
-    GWorkerContext := TTestingWorkerContext4B.Create(TFHIRFactoryR4B.create, TFHIRPackageManager.Create(npmModeUser));
+    GWorkerContext := TTestingWorkerContext4B.Create(nil, TFHIRFactoryR4B.create, TFHIRPackageManager.Create(npmModeUser));
     pcm := TFHIRPackageManager.Create(npmModeUser);
     li := TPackageLoadingInformation.Create(fhir4b_constants.FHIR_GENERATED_VERSION);
     try

library/fhir5/fhir5_profiles.pas

@@ -35,7 +35,7 @@ interface
 
 uses
   SysUtils, Classes, Types, {$IFDEF DELPHI} IOUtils, {$ENDIF}
-  fsl_base, fsl_utilities, fsl_threads, fsl_stream, fsl_collections, fsl_fpc, fsl_npm_cache,
+  fsl_base, fsl_utilities, fsl_threads, fsl_stream, fsl_collections, fsl_fpc, fsl_npm_cache, fsl_lang,
   fhir_objects, fhir_parser, fhir_factory, fhir_uris, fhir_common,
   fhir5_resources, fhir5_resources_base, fhir5_parser, fhir5_enums, fhir5_types, fhir5_context, fhir5_utilities, fhir5_constants;
 
@@ -128,7 +128,7 @@   TBaseWorkerContextR5 = class abstract (TFHIRWorkerContext)
     procedure SetProfiles(const Value: TProfileManager);
     procedure Load(packageId : String; feed: TFHIRBundle);
   public
-    constructor Create(factory : TFHIRFactory; pcm : TFHIRPackageManager); Override;
+    constructor Create(languages : TIETFLanguageDefinitions; factory : TFHIRFactory; pcm : TFHIRPackageManager); Override;
     destructor Destroy; Override;
     function link : TBaseWorkerContextR5; overload;
     procedure Unload; override;
@@ -1559,7 +1559,7 @@ procedure TBaseWorkerContextR5.listStructures(list : TFslList<TFHIRStructureDefi
     list.add(sd.link);
 end;
 
-constructor TBaseWorkerContextR5.Create(factory : TFHIRFactory; pcm : TFHIRPackageManager);
+constructor TBaseWorkerContextR5.Create(languages : TIETFLanguageDefinitions; factory : TFHIRFactory; pcm : TFHIRPackageManager);
 begin
   inherited;
   FLock := TFslLock.Create('worker-context r5');

library/fhir5/tests/fhir5_tests_worker.pas

@@ -98,7 +98,7 @@ class function TTestingWorkerContext5.Use: TFHIRWorkerContext;
 begin
   if GWorkerContext = nil then
   begin
-    GWorkerContext := TTestingWorkerContext5.Create(TFHIRFactoryR5.create, TFHIRPackageManager.Create(npmModeUser));
+    GWorkerContext := TTestingWorkerContext5.Create(nil, TFHIRFactoryR5.create, TFHIRPackageManager.Create(npmModeUser));
     pcm := TFHIRPackageManager.Create(npmModeUser);
     li := TPackageLoadingInformation.Create(fhir5_constants.FHIR_GENERATED_VERSION);
     try

library/fsl/fsl_base.pas

@@ -128,17 +128,22 @@   EJsonException = class (EFslException); // error reading or writing Json
     Constructor Create(place : String);
   End;
 
+  { EWebServerException }
+
   EWebServerException = Class(EFslException)
   Private
     FCode : Integer;
+    Fdiagnostics: String;
     FMessageId : String;
     FIssueType : String;
   Public
     //constructor Create(code : integer; message : String);
-    constructor Create(code : integer; message, messageId, issueType : String);
+    constructor Create(code : integer; message, messageId, issueType : String); overload;
+    constructor Create(code : integer; message, messageId, issueType, diagnostics : String); overload;
     property Code : Integer read FCode;
     property MessageId : String read FMessageId;
     property issueType : String read FIssueType;
+    property diagnostics : String read Fdiagnostics;
   End;
 
 Function ExceptObject : Exception;
@@ -3696,6 +3701,15 @@ constructor EWebServerException.Create(code: integer; message, messageId, issueT
   FIssueType := issueType;
 end;
 
+constructor EWebServerException.Create(code: integer; message, messageId, issueType, diagnostics: String);
+begin
+  inherited Create(message);
+  FCode := code;
+  FMessageId := messageId;
+  FIssueType := issueType;
+  Fdiagnostics := diagnostics;
+end;
+
 Initialization
   initUnit;
 {$IFNDEF FPC}