paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-14 21:59:47 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Add service module creation

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-12-11 11:41:46 +01:00
parent f38cfbb23f
commit b412765116
2 changed files with 214 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

85
packages/fcl-openapi/src/fpopenapi.codegen.pp
View File

@ -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.

136
packages/fcl-openapi/src/fpopenapi.generators.pp
View File

@ -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.