From b4127651169ce143161923d74b03489c1fb13afe Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Micha=C3=ABl=20Van=20Canneyt?= <michael@freepascal.org>
Date: Wed, 11 Dec 2024 11:41:46 +0100
Subject: [PATCH] * Add service module creation
---
packages/fcl-openapi/src/fpopenapi.codegen.pp | 85 ++++++++++-
.../fcl-openapi/src/fpopenapi.generators.pp | 136 +++++++++++++++++-
2 files changed, 214 insertions(+), 7 deletions(-)
diff --git a/packages/fcl-openapi/src/fpopenapi.codegen.pp b/packages/fcl-openapi/src/fpopenapi.codegen.pp
index 689e1b0926..f4ae03fed7 100644
--- a/packages/fcl-openapi/src/fpopenapi.codegen.pp
+++ b/packages/fcl-openapi/src/fpopenapi.codegen.pp
@@ -32,7 +32,7 @@ uses
fpopenapi.pascaltypes;
Type
- TUnitKind = (ukDto, ukSerialize, ukClientServiceIntf, ukServerServiceHandler, ukClientServiceImpl, ukServerServiceImpl, ukClientParent, ukServerParent);
+ TUnitKind = (ukDto, ukSerialize, ukClientServiceIntf, ukServerServiceHandler, ukClientServiceImpl, ukServerServiceImpl, ukClientParent, ukServerParent, ukServerProxy);
const
DefaultUnitSuffix = '.{kind}';
@@ -45,7 +45,10 @@ const
DefaultServerServiceImplSuffix = 'Module.Impl';
DefaultServiceNamePrefix = '';
DefaultServiceNameSuffix = 'Service';
-
+ DefaultServerProxyModuleName = 'TServerProxy';
+ DefaultServerProxyModuleParentName = 'TDataModule';
+ DefaultServerProxyModuleParentUnit = ''; // Depends on Delphicode or not
+ DefaultServerProxyUseServiceInterface = True;
Suffixes : Array[TUnitKind] of string = (
@@ -56,7 +59,8 @@ const
DefaultClientServiceImplSuffix,
DefaultServerServiceImplSuffix,
'',
- '');
+ '',
+ 'ServerProxy');
type
{ TOpenAPICodeGen }
@@ -71,9 +75,14 @@ type
FDelphiCode: boolean;
FGenerateClient: boolean;
FGenerateServer: boolean;
+ FGenerateServerProxyModule: Boolean;
FOnLog: TSchemaCodeGenLogEvent;
FParentHasCancelRequest: Boolean;
FServerParentClass: String;
+ FServerProxyModuleName: String;
+ FServerProxyModuleParentName: String;
+ FServerProxyModuleParentUnit: String;
+ FServerProxyUseServiceInterface: Boolean;
FServiceMap: TStrings;
FServiceNamePrefix: String;
FServiceNameSuffix: String;
@@ -87,6 +96,7 @@ type
FUnitNames : Array [TUnitKind] of string;
procedure CleanMaps;
function GetBaseOutputUnitName: string;
+ function GetServerProxyModuleParentUnit: String;
function GetUnitName(AIndex: TUnitKind): String;
function GetUnitSuffix(aKind: TUnitKind): String;
procedure SetUnitName(AIndex: TUnitKind; AValue: String);
@@ -104,6 +114,7 @@ type
procedure GenerateServiceImplementation(aData: TAPIData); virtual;
procedure GenerateServerHandlerModule(aData: TAPIData); virtual;
procedure GenerateServerModuleImplementation(aData: TAPIData); virtual;
+ procedure GenerateServerProxy(aData: TAPIData); virtual;
procedure GetUUIDMap(aData: TAPIData);
procedure PrepareAPIData(aData: TAPIData); virtual;
public
@@ -177,6 +188,18 @@ type
Property AbstractServiceCalls : Boolean Read FAbstractServiceCalls Write FAbstractServiceCalls;
// Skip generation of implementation module (only used when AbstractServiceCalls is True
Property SkipServerServiceImplementationModule : Boolean Read FSkipServerServiceImplementationModule Write FSkipServerServiceImplementationModule;
+ // In case of multiple services modules, generate a "server proxy" TDataModule that contains each service as a property?
+ Property GenerateServerProxyModule : Boolean Read FGenerateServerProxyModule Write FGenerateServerProxyModule;
+ // Server proxy unit name serservice parent class name
+ Property ServerProxyUnit : String index ukServerProxy Read GetUnitName Write SetUnitName;
+ // Class name for server proxy datamodule.
+ Property ServerProxyModuleName : String Read FServerProxyModuleName Write FServerProxyModuleName;
+ // Class name for server proxy parent class.
+ Property ServerProxyModuleParentName : String Read FServerProxyModuleParentName Write FServerProxyModuleParentName;
+ // Unit name where server proxy parent class is defined.
+ Property ServerProxyModuleParentUnit : String Read GetServerProxyModuleParentUnit Write FServerProxyModuleParentUnit;
+ // Define service properties using their interface definition.
+ Property ServerProxyUseServiceInterface : Boolean Read FServerProxyUseServiceInterface Write FServerProxyUseServiceInterface;
// Prefix for client/server service name
Property ServiceNameSuffix : String Read FServiceNameSuffix Write FServiceNameSuffix;
// Prefix for client/server service name
@@ -207,8 +230,13 @@ Const
KeyServerParentUnit = 'ServerParentUnit';
KeyParentHasCancelRequest = 'ParentHasCancelRequest';
KeyAbstractServiceCalls = 'AbstractServiceCalls';
+ KeyGenerateServerProxyModule = 'GenerateServerProxyModule';
KeyServiceNameSuffix = 'ServiceNameSuffix';
KeyServiceNamePrefix = 'ServiceNamePrefix';
+ KeyServerProxyModuleName = 'ServerProxyModuleName';
+ KeyServerProxyModuleParentName = 'ServerProxyModuleParentName';
+ KeyServerProxyModuleParentUnit = 'ServerProxyModuleParentUnit';
+ KeyServerProxyUseServiceInterface = 'ServerProxyModuleUseInterface';
{ TOpenAPICodeGen }
@@ -239,6 +267,7 @@ var
aKind : TUnitKind;
begin
+ GenerateServerProxyModule:=False;
GenerateServer:=False;
GenerateClient:=True;
AbstractServiceCalls:=True;
@@ -253,12 +282,16 @@ begin
ServerServiceParentUnit:='fpopenapimodule';
ServiceNamePrefix:=DefaultServiceNamePrefix;
ServiceNameSuffix:=DefaultServiceNameSuffix;
+ ServerProxyModuleName:=DefaultServerProxyModuleName;
+ ServerProxyModuleParentName:=DefaultServerProxyModuleParentName;
+ ServerProxyModuleParentUnit:=DefaultServerProxyModuleParentUnit;
+ ServerProxyUseServiceInterface:=DefaultServerProxyUseServiceInterface;
end;
procedure TOpenAPICodeGen.LoadConfig(aIni : TCustomIniFile; const aSection : String);
var
- lSection : String;
+ lSection: String;
begin
lSection:=aSection;
@@ -282,6 +315,11 @@ begin
AbstractServiceCalls:=ReadBool(lSection,KeyAbstractServiceCalls,AbstractServiceCalls);
ServiceNameSuffix:=ReadString(lSection,KeyServiceNameSuffix,ServiceNameSuffix);
ServiceNamePrefix:=ReadString(lSection,KeyServiceNamePrefix,ServiceNamePrefix);
+ GenerateServerProxyModule:=ReadBool(lSection,KeyGenerateServerProxyModule,GenerateServerProxyModule);
+ ServerProxyModuleName:=ReadString(lSection,KeyServerProxyModuleName,ServerProxyModuleName);
+ ServerProxyModuleParentName:=ReadString(lSection,KeyServerProxyModuleParentName,ServerProxyModuleParentName);
+ ServerProxyModuleParentUnit:=ReadString(lSection,KeyServerProxyModuleParentName,ServerProxyModuleParentUnit);
+ ServerProxyUseServiceInterface:=ReadBool(lSection,KeyServerProxyUseServiceInterface,ServerProxyUseServiceInterface);
end;
end;
@@ -384,6 +422,16 @@ begin
Result := ExtractFileName(BaseOutputFileName);
end;
+function TOpenAPICodeGen.GetServerProxyModuleParentUnit: String;
+begin
+ Result:=FServerProxyModuleParentUnit;
+ if Result='' then
+ if DelphiCode then
+ Result:='System.Classes'
+ else
+ Result:='Classes';
+end;
+
function TOpenAPICodeGen.GetUnitName(AIndex: TUnitKind): String;
begin
Result:=FUnitNames[aIndex];
@@ -514,6 +562,9 @@ begin
if AbstractServiceCalls and not SkipServerServiceImplementationModule then
GenerateServerModuleImplementation(lAPIData);
end;
+ if GenerateServerProxyModule then
+ GenerateServerProxy(lAPIData);
+
GetUUIDMap(lAPIData);
finally
lAPIData.Free;
@@ -679,5 +730,31 @@ begin
end;
end;
+procedure TOpenAPICodeGen.GenerateServerProxy(aData: TAPIData);
+var
+ codegen: TServerProxyServiceModuleCodeGen;
+ lFileName : string;
+
+begin
+ lFileName:=ResolveUnit(ukServerProxy,True);
+ DoLog(etInfo, 'Writing server proxy module implementation to file "%s"', [lFileName]);
+ codegen := TServerProxyServiceModuleCodeGen.Create(Self);
+ try
+ Configure(codegen);
+ codegen.OutputUnitName := ResolveUnit(ukServerProxy);
+ codegen.ProxyParentClass := ServerProxyModuleParentName;
+ codegen.ProxyParentUnit := ServerProxyModuleParentUnit;
+ codegen.ProxyClassName := ServerProxyModuleName;
+ codegen.UseInterfaceType:=ServerProxyUseServiceInterface;
+ codegen.ServiceImplementationUnit := ResolveUnit(ukClientServiceImpl);
+ codegen.ServiceInterfaceUnit := ResolveUnit(ukClientServiceIntf);
+ codegen.Execute(aData);
+ codegen.Source.SaveToFile(lFileName);
+ finally
+ codegen.Free;
+ end;
+
+end;
+
end.
diff --git a/packages/fcl-openapi/src/fpopenapi.generators.pp b/packages/fcl-openapi/src/fpopenapi.generators.pp
index 712f45ca98..13b6490b64 100644
--- a/packages/fcl-openapi/src/fpopenapi.generators.pp
+++ b/packages/fcl-openapi/src/fpopenapi.generators.pp
@@ -190,13 +190,35 @@ type
{ TServerImplementationModuleCodeGen }
TServerImplementationModuleCodeGen = class(TServerCodeGen)
- // private
- // FServerModuleInterfaceUnit: String;
public
procedure Execute(aData: TAPIData); virtual;
- // property ServerModuleInterfaceUnit : String Read FServerModuleInterfaceUnit Write FServerModuleInterfaceUnit;
end;
+ { TServerServiceModule }
+
+ { TServerProxyServiceModule }
+
+ TServerProxyServiceModuleCodeGen = class(TOpenApiPascalCodeGen)
+ private
+ FProxyClassName: string;
+ FProxyParentClass: string;
+ FProxyParentUnit: string;
+ FServiceImplementationUnit: string;
+ FServiceInterfaceUnit: string;
+ FUseInterfaceType: Boolean;
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure GenerateModule;
+ procedure Execute(aData: TAPIData); virtual;
+ property ServiceInterfaceUnit: string read FServiceInterfaceUnit write FServiceInterfaceUnit;
+ property ServiceImplementationUnit: string read FServiceImplementationUnit write FServiceImplementationUnit;
+ property ProxyParentClass: string read FProxyParentClass write FProxyParentClass;
+ property ProxyParentUnit: string read FProxyParentUnit write FProxyParentUnit;
+ Property UseInterfaceType : Boolean Read FUseInterfaceType Write FUseInterfaceType;
+ Property ProxyClassName : string Read FProxyClassName Write FProxyClassName;
+ end;
+
+
implementation
{ TJSONSchemaCodeGeneratorHelper }
@@ -1314,5 +1336,113 @@ begin
Addln('end.');
end;
+{ TServerServiceModule }
+
+constructor TServerProxyServiceModuleCodeGen.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FProxyClassName:='TServerProxy';
+ FProxyParentClass:='TDataModule';
+ FProxyParentUnit:='Classes';
+end;
+
+procedure TServerProxyServiceModuleCodeGen.GenerateModule;
+
+var
+ I: integer;
+ lUnits : String;
+ lService: TAPIService;
+
+begin
+ GenerateFPCDirectives();
+
+ Addln('unit %s;', [Self.OutputUnitName]);
+ Addln('');
+ Addln('interface');
+ Addln('');
+ Addln('uses');
+ indent;
+ If Not UseInterfaceType then
+ lUnits:=ServiceImplementationUnit
+ else
+ lUnits:=ServiceInterfaceUnit;
+ if not (SameText(ProxyParentUnit,'Classes') or SameText(ProxyParentUnit,'System.Classes')) then
+ if DelphiCode then
+ lUnits:='System.Classes, '+lUnits
+ else
+ lUnits:='Classes, '+lUnits;
+ AddLn('%s, %s;', [ProxyParentUnit, lUnits]);
+ undent;
+ Addln('');
+ EnsureSection(csType);
+ indent;
+ Addln('%s = class(%s)',[ProxyClassName,ProxyParentClass]);
+ Addln('private');
+ indent;
+ for I:=0 to APIData.ServiceCount-1 do
+ begin
+ lService:=APIData.Services[I];
+ Addln('F%s : %s;',[lService.ServiceName,lService.ServiceInterfaceName]);
+ end;
+ undent;
+ Addln('protected');
+ indent;
+ Addln('Procedure CreateServices; virtual;');
+ undent;
+ Addln('public');
+ indent;
+ Addln('constructor Create(aOwner : TComponent); override;');
+ for I:=0 to APIData.ServiceCount-1 do
+ begin
+ lService:=APIData.Services[I];
+ Addln('Property %s : %s read F%s;',[lService.ServiceName,lService.ServiceInterfaceName,lService.ServiceName]);
+ end;
+ undent;
+ Addln('end;');
+ undent;
+ Addln('');
+ Addln('implementation');
+ Addln('');
+ Addln('uses');
+ indent;
+ if UseInterfaceType then
+ Addln('%s,', [ServiceImplementationUnit]);
+ if DelphiCode then
+ Addln('System.SysUtils;')
+ else
+ Addln('SysUtils;');
+ undent;
+ Addln('');
+ Addln('constructor %s.Create(aOwner : TComponent);',[ProxyClassName]);
+ Addln('');
+ Addln('begin');
+ indent;
+ Addln('Inherited;');
+ Addln('CreateServices;');
+ undent;
+ Addln('end;');
+ Addln('');
+ Addln('');
+ Addln('procedure %s.CreateServices;',[ProxyClassName]);
+ Addln('');
+ Addln('begin');
+ Indent;
+ for I:=0 to APIData.ServiceCount-1 do
+ begin
+ lService:=APIData.Services[I];
+ Addln('F%s:=%s.create(Self);',[lService.ServiceName,lService.ServiceProxyImplementationClassName]);
+ end;
+ undent;
+ Addln('end;');
+ Addln('');
+ Addln('end.');
+end;
+
+procedure TServerProxyServiceModuleCodeGen.Execute(aData: TAPIData);
+begin
+ SetTypeData(aData);
+ GenerateModule;
+end;
+
end.