123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566 |
- {
- This file is part of the Free Component Library
- Copyright (c) 2024 by Michael Van Canneyt [email protected]
- Open API code generators
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- unit fpopenapi.generators;
- {$mode ObjFPC}{$H+}
- interface
- uses
- {$IFDEF FPC_DOTTEDUNITS}
- System.Classes, System.SysUtils, System.DateUtils, System.Contnrs, Pascal.CodeGenerator,
- {$ELSE}
- Classes, SysUtils, strutils, dateutils, pascodegen, inifiles,
- {$ENDIF}
- fpjson.schema.types,
- fpjson.schema.Pascaltypes,
- fpjson.schema.codegen,
- fpopenapi.objects,
- fpopenapi.types,
- fpopenapi.pascaltypes;
- Const
- DefaultServerProxyName = 'TServerProxy';
- DefaultServerProxyParent = 'TDataModule';
- DefaultServerProxyParentUnit = 'Classes';
- type
- { TJSONSchemaCodeGeneratorHelper }
- // Helper class to generate an API unit header
- // And to get access
- TJSONSchemaCodeGeneratorHelper = class helper for TJSONSchemaCodeGenerator
- procedure GenerateAPIheader;
- function ApiData: TAPIData;
- end;
- { TOpenApiPascalCodeGen }
- TOpenApiPascalCodeGen = class(TJSONSchemaCodeGenerator)
- private
- function GetData: TAPIData;
- protected
- procedure GenerateHeader; override;
- public
- property APIData: TAPIData read GetData;
- end;
- { TDtoCodeGen }
- TDtoCodeGen = class(TTypeCodeGenerator)
- protected
- procedure GenerateHeader; override;
- end;
- { TSerializerCodeGen }
- TSerializerCodeGen = class(TSerializerCodeGenerator)
- protected
- procedure GenerateHeader; override;
- end;
- { TIntfCodeGen }
- { TOpenAPIServiceCodeGen }
- TOpenAPIServiceCodeGen = class(TOpenApiPascalCodeGen)
- private
- FDefineServiceResultType: boolean;
- FDtoUnit: string;
- FSerializerUnit: string;
- FServiceName: string;
- FAsync: boolean;
- FServiceRequestIDType: string;
- FServiceResultType: string;
- function GetServiceRequestIDType: string;
- function GetServiceResultType: string;
- protected
- procedure WriteResultTypes; virtual;
- procedure WriteCallbackTypes; virtual;
- procedure GenerateAuxiliaryTypes; virtual;
- procedure GenerateServiceResultType; virtual;
- function GenerateClientServiceMethodDecl(aMethod: TAPIServiceMethod; const aClassName: string): string; virtual;
- procedure GetMethodCallbackTypeNames(aTypes: TStrings); virtual;
- procedure GetMethodResultTypeNames(aTypes: TStrings); virtual;
- function GetMethodResultType(aMethod: TAPIServiceMethod): string; virtual;
- function MethodResultCallBackName(aMethod: TAPIServiceMethod): string; virtual;
- function ParameterToArg(Idx: integer; aParam: TAPIServiceMethodParam): string; virtual;
- public
- constructor Create(AOwner: TComponent); override;
- property ServiceName: string read FServiceName write FServiceName;
- property DtoUnit: string read FDtoUnit write FDtoUnit;
- property SerializerUnit: string read FSerializerUnit write FSerializerUnit;
- property AsyncService: boolean read FAsync write FAsync;
- property ServiceResultType: string read GetServiceResultType write FServiceResultType;
- property DefineServiceResultType: boolean read FDefineServiceResultType write FDefineServiceResultType;
- property ServiceRequestIDType: string read GetServiceRequestIDType write FServiceRequestIDType;
- end;
- { TServiceInterfaceCodeGen }
- TServiceInterfaceCodeGen = class(TOpenAPIServiceCodeGen)
- protected
- procedure GenerateServiceInterface(aService: TAPIService); virtual;
- public
- procedure Execute(aData: TAPIData); virtual;
- end;
- { TServiceImplementationCodeGen }
- TServiceImplementationCodeGen = class(TOpenAPIServiceCodeGen)
- private
- FParentHasCancelRequest: boolean;
- FServiceInterfaceUnit: string;
- FServiceParentClass: string;
- FServiceParentUnit: string;
- procedure SetServiceInterfaceUnit(AValue: string);
- protected
- procedure GenerateCancelRequest(aService: TAPIService); virtual;
- procedure GenerateConstructor(aService: TAPIService); virtual;
- procedure GenerateServiceImplementationImpl(aService: TAPIService); virtual;
- procedure GenerateServiceMethodImpl(aService: TAPIService; aMethod: TAPIServiceMethod); virtual;
- procedure GenerateURLConstruction(aService: TAPIService; aMethod: TAPIServiceMethod); virtual;
- procedure GenerateServiceImplementationDecl(aService: TAPIService); virtual;
- public
- constructor Create(AOwner: TComponent); override;
- procedure Execute(aData: TAPIData); virtual;
- property ServiceInterfaceUnit: string read FServiceInterfaceUnit write SetServiceInterfaceUnit;
- property ServiceParentClass: string read FServiceParentClass write FServiceParentClass;
- property ServiceParentUnit: string read FServiceParentUnit write FServiceParentUnit;
- property ParentHasCancelRequest: boolean read FParentHasCancelRequest write FParentHasCancelRequest;
- end;
- { TServerModuleCodeGen }
- { TServerCodeGen }
- TServerCodeGen = class(TOpenAPIServiceCodeGen)
- private
- FModuleParentUnit: string;
- function GetModuleParentUnit: string;
- protected
- procedure GenerateServerServiceMethodImpl(lMethod: TAPIserviceMethod; const aClassName: string);
- // needed for service registration
- function GetMethodHandleRequestName(aMethod: TAPIServiceMethod; const aClassName: string): string; virtual;
- function GetServerServiceHandleMethodDecl(aMethod: TAPIServiceMethod; const aClassName: string = ''): string; virtual;
- // Methods for the actual implementation
- function GetMethodParameterDecl(aMethod: TAPIServiceMethod; aParam: TAPIServiceMethodParam): string; virtual;
- function GetMethodArgs(aMethod: TAPIServiceMethod): string; virtual;
- function GetServerServiceMethodDecl(aMethod: TAPIServiceMethod; const aClassName: string = ''): string; virtual;
- procedure GenerateServerServiceImplementationImpl(aService: TAPIService; const aModuleName: string; isAbstract: boolean); virtual;
- procedure GenerateServerServiceImplementationDecl(aService: TAPIService;
- aParentModule, aModuleName: string; isAbstract: boolean; isHandler: boolean); virtual;
- public
- property ModuleParentUnit: string read GetModuleParentUnit write FModuleParentUnit;
- end;
- // This module generates a complete module that handles the HTTP Requests and hands them off.
- { TServerModuleHandlerCodeGen }
- TServerModuleHandlerCodeGen = class(TServerCodeGen)
- private
- FAbstractServiceCalls: boolean;
- FModuleParentClass: string;
- class function ConvertToRouteParams(const aPath: string): string;
- function GetModuleParentCLass: string;
- protected
- procedure GenerateRegisterAPIRoutes(aClassName: string; aService: TAPIService); virtual;
- procedure GenerateServerServiceImplementationImpl(aService: TAPIService; const aModuleName: string; isAbstract: boolean); override;
- procedure WriteConvertArgument(aMethod: TAPIServiceMethod; aParam: TAPIServiceMethodParam); virtual;
- procedure GenerateServerServiceHandleMethodImpl(lMethod: TAPIserviceMethod; const aClassName: string); virtual;
- public
- procedure Execute(aData: TAPIData); virtual;
- property AbstractServiceCalls: boolean read FAbstractServiceCalls write FAbstractServiceCalls;
- property ModuleParentClass: string read GetModuleParentClass write FModuleParentClass;
- end;
- // This module generates a descendant of the server module.
- // Can be used when TServerModuleCodeGen is used with AbstractServiceCalls = True
- { TServerImplementationModuleCodeGen }
- TServerImplementationModuleCodeGen = class(TServerCodeGen)
- public
- procedure Execute(aData: TAPIData); virtual;
- end;
- { TServerServiceModule }
- { TServerProxyServiceModule }
- { TServerProxyServiceModuleCodeGen }
- TServerProxyServiceModuleCodeGen = class(TOpenApiPascalCodeGen)
- private
- FFormFile: Boolean;
- FProxyClassName: string;
- FProxyParentClass: string;
- FProxyParentUnit: string;
- FProxyVarName: String;
- FServiceImplementationUnit: string;
- FServiceInterfaceUnit: string;
- FUseInterfaceType: Boolean;
- FForm : TStrings;
- procedure CheckDefaults;
- function GetProxyVarName: String;
- procedure SetProxyClassName(const aValue: string);
- Protected
- public
- constructor Create(AOwner: TComponent); override;
- Destructor Destroy; override;
- procedure GenerateModule;
- procedure GenerateFormFile;
- 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 SetProxyClassName;
- Property ProxyVarName : String Read GetProxyVarName Write FProxyVarName;
- Property FormFile : Boolean Read FFormFile Write FFormFile;
- Property Form : TStrings Read FForm Write FForm;
- end;
- implementation
- { TJSONSchemaCodeGeneratorHelper }
- procedure TJSONSchemaCodeGeneratorHelper.GenerateAPIheader;
- var
- S, lTitle, lDate, lVersion: string;
- lDescription: TStrings;
- I: integer;
- begin
- lDescription:=nil;
- lDate:=FormatDateTime('yyyy"-"mm"-"dd hh":"nn', Now);
- lVersion:=APIData.API.Info.Version;
- lTitle:=APIData.API.Info.Title;
- if VerboseHeader and (APIData.API.Info.Description<>'') then
- begin
- lDescription:=TStringList.Create;
- lDescription.Text:=APIData.API.Info.Description;
- end;
- Addln('{ -----------------------------------------------------------------------');
- Indent;
- Addln('Do not edit !');
- Addln('');
- Addln('This file was automatically generated on %s.', [lDate]);
- S:='';
- for I:=1 to ParamCount do
- S:=S+' '+ParamStr(i);
- Addln('Used command-line parameters:');
- Indent;
- Addln(S);
- Undent;
- Addln('Source OpenAPI document data:');
- Indent;
- if lTitle<>'' then
- Addln('Title: %s', [lTitle]);
- if lVersion<>'' then
- Addln('Version: %s', [lVersion]);
- if Assigned(lDescription) then
- begin
- Addln('Description:');
- for S in lDescription do
- AddLn(S);
- end;
- Undent;
- Undent;
- Addln(' -----------------------------------------------------------------------}');
- FreeAndNil(lDescription);
- end;
- function TJSONSchemaCodeGeneratorHelper.ApiData: TAPIData;
- begin
- Result:=TypeData as TAPIData;
- end;
- { TOpenAPICodeGen }
- function TOpenApiPascalCodeGen.GetData: TAPIData;
- begin
- Result:=TypeData as TAPIData;
- end;
- procedure TOpenApiPascalCodeGen.GenerateHeader;
- begin
- GenerateAPIheader;
- end;
- { TDtoCodeGen }
- procedure TDtoCodeGen.GenerateHeader;
- begin
- GenerateAPIheader;
- end;
- { TSerializerCodeGen }
- procedure TSerializerCodeGen.GenerateHeader;
- begin
- GenerateAPIheader;
- end;
- { TOpenAPIerviceCodeGen }
- function TOpenAPIServiceCodeGen.MethodResultCallBackName(aMethod:
- TAPIServiceMethod): string;
- begin
- Result:=GetMethodResultType(aMethod);
- if Result<>'' then
- Result:=Result+'Callback';
- end;
- function TOpenAPIServiceCodeGen.ParameterToArg(Idx: integer;
- aParam: TAPIServiceMethodParam): string;
- begin
- Result:=Format('%s : %s', [aParam.Name, aParam.TypeName]);
- if aParam.DefaultValue<>'' then
- Result:=Result+' = '+aParam.DefaultValue;
- end;
- constructor TOpenAPIServiceCodeGen.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- DefineServiceResultType:=False;
- end;
- function TOpenAPIServiceCodeGen.GetServiceResultType: string;
- begin
- Result:=FServiceResultType;
- if Result = '' then
- Result:='TServiceResult';
- end;
- function TOpenAPIServiceCodeGen.GetServiceRequestIDType: string;
- begin
- Result:=FServiceRequestIDType;
- if Result = '' then
- Result:='TRESTServiceRequestID';
- end;
- procedure TOpenAPIServiceCodeGen.GenerateServiceResultType;
- begin
- if AsyncService then
- begin
- Addln('%s = string;', [ServiceRequestIDType]);
- Addln('');
- end;
- if not DelphiCode then
- Addln('generic %s<T> = record', [ServiceResultType])
- else
- Addln(' %s<T> = record', [ServiceResultType]);
- Indent;
- Addln('StatusCode : Integer;');
- Addln('StatusText : String;');
- if AsyncService then
- Addln('RequestID : %s;', [ServiceRequestIDType]);
- Addln('Value : T;');
- Undent;
- AddLn('end;');
- AddLn('');
- end;
- function TOpenAPIServiceCodeGen.GenerateClientServiceMethodDecl(aMethod: TAPIServiceMethod; const aClassName: string): string;
- procedure AddTo(var S: string; const T: string);
- begin
- if T = '' then exit;
- if S<>'' then
- S:=S+'; ';
- S:=S+T;
- end;
- var
- lBodyType, lResultType, lName, lParams: string;
- I: integer;
- begin
- lParams:='';
- // Non-optional
- for I:=0 to aMethod.ParamCount-1 do
- if aMethod.Param[I].DefaultValue = '' then
- AddTo(lParams, ParameterToArg(I, aMethod.Param[I]));
- if Assigned(aMethod.RequestBodyDataType) then
- lBodyType:=aMethod.RequestBodyDataType.GetTypeName(ntPascal);
- if lBodyType<>'' then
- AddTo(lParams, 'aBody : '+lBodyType);
- if AsyncService then
- AddTo(lParams, 'aCallback : '+MethodResultCallbackName(aMethod));
- // Optional
- for I:=0 to aMethod.ParamCount-1 do
- if aMethod.Param[I].DefaultValue<>'' then
- AddTo(lParams, ParameterToArg(I, aMethod.Param[I]));
- lName:=aMethod.MethodName;
- if aClassName<>'' then
- lName:=aClassName+'.'+lName;
- if AsyncService then
- Result:=Format('Function %s(%s) : %s;', [lName, lParams, ServiceRequestIDType])
- else
- begin
- lResultType:=GetMethodResultType(aMethod);
- Result:=Format('Function %s(%s) : %s;', [lName, lParams, lResultType]);
- end;
- end;
- procedure TOpenAPIServiceCodeGen.GetMethodCallbackTypeNames(aTypes: TStrings);
- var
- I, J: integer;
- lName: string;
- lService: TAPIService;
- lMethod: TAPIServiceMethod;
- begin
- for I:=0 to APIData.ServiceCount-1 do
- begin
- lService:=APIData.Services[I];
- if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
- for J:=0 to lService.MethodCount-1 do
- begin
- lMethod:=lService.Methods[J];
- if lMethod.ResultDataType<>nil then
- begin
- lName:=MethodResultCallBackName(lMethod);
- if lName<>'TVoidResultCallBack' then
- aTypes.AddObject(lName, lMethod);
- end;
- end;
- end;
- end;
- procedure TOpenAPIServiceCodeGen.GetMethodResultTypeNames(aTypes: TStrings);
- var
- I, J: integer;
- lName: string;
- lService: TAPIService;
- lMethod: TAPIServiceMethod;
- begin
- for I:=0 to APIData.ServiceCount-1 do
- begin
- lService:=APIData.Services[I];
- if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
- for J:=0 to lService.MethodCount-1 do
- begin
- lMethod:=lService.Methods[J];
- if lMethod.ResultDataType<>nil then
- begin
- lName:=GetMethodResultType(lMethod);
- if lName<>'' then
- aTypes.AddObject(lName, lMethod);
- end;
- end;
- end;
- end;
- function TOpenAPIServiceCodeGen.GetMethodResultType(aMethod: TAPIServiceMethod): string;
- begin
- Result:=aMethod.ResultDtoType;
- if Result<>'' then
- Result:=Result+'ServiceResult'
- else
- Result:='TVoidServiceResult';
- end;
- { TServiceInterfaceCodeGen }
- procedure TServiceInterfaceCodeGen.GenerateServiceInterface(aService: TAPIService);
- var
- I: integer;
- lDecl, lParent: string;
- lMethod: TAPIServiceMethod;
- begin
- DoLog('Generating service interface %s (UUID: %s)',
- [aService.ServiceName, aService.ServiceUUID]);
- lParent:=aService.ServiceParentInterface;
- if lParent<>'' then
- lParent:='('+lParent+')';
- Addln('// Service %s', [aService.ServiceInterfaceName]);
- Addln('');
- Addln('%s = interface %s [''%s'']', [aService.ServiceInterfaceName,
- lParent, aService.ServiceUUID]);
- indent;
- for I:=0 to aService.MethodCount-1 do
- begin
- lMethod:=aService.Methods[I];
- lDecl:=GenerateClientServiceMethodDecl(lMethod, '');
- Addln(lDecl);
- end;
- if AsyncService then
- Addln('Procedure CancelRequest(aRequestID : %s);', [ServiceRequestIDType]);
- undent;
- Addln('end;');
- Addln('');
- end;
- procedure TOpenAPIServiceCodeGen.WriteResultTypes;
- var
- I: integer;
- lName, lDef, lResType: string;
- lTypes: TStringList;
- begin
- Addln('// Service result types');
- lTypes:=TStringList.Create;
- try
- lTypes.Sorted:=True;
- lTypes.Duplicates:=dupIgnore;
- GetMethodResultTypeNames(lTypes);
- lTypes.Sorted:=False;
- for I:=0 to lTypes.Count-1 do
- begin
- lName:=lTypes[I];
- lResType:=TAPIServiceMethod(lTypes.objects[I]).ResultDtoType;
- lDef:=Format('%s<%s>', [ServiceResultType, lResType]);
- if not DelphiCode then
- lDef:='specialize '+lDef;
- Addln('%s = %s;', [lName, lDef]);
- end;
- Addln('');
- finally
- lTypes.Free;
- end;
- end;
- procedure TOpenAPIServiceCodeGen.WriteCallbackTypes;
- var
- I: integer;
- lName, lDef: string;
- lTypes: TStringList;
- begin
- Addln('// Service Callback types');
- lTypes:=TStringList.Create;
- try
- lTypes.Sorted:=True;
- lTypes.Duplicates:=dupIgnore;
- GetMethodCallbackTypeNames(lTypes);
- lTypes.Sorted:=False;
- for I:=0 to lTypes.Count-1 do
- begin
- lName:=lTypes[I];
- lDef:=Format('reference to procedure(aResult : %s)', [lName]);
- Addln('%s = %s;', [lName, lDef]);
- end;
- Addln('');
- finally
- lTypes.Free;
- end;
- end;
- procedure TOpenAPIServiceCodeGen.GenerateAuxiliaryTypes;
- begin
- if DefineServiceResultType then
- GenerateServiceResultType;
- WriteResultTypes;
- if AsyncService then
- WriteCallbackTypes;
- end;
- procedure TServiceInterfaceCodeGen.Execute(aData: TAPIData);
- var
- I: integer;
- lService: TAPIService;
- begin
- SetTypeData(aData);
- try
- GenerateHeader;
- Addln('unit %s;', [Self.OutputUnitName]);
- Addln('');
- if AsyncService then
- GenerateFPCDirectives(['functionreferences'])
- else
- GenerateFPCDirectives();
- Addln('interface');
- Addln('');
- Addln('uses');
- indent;
- Addln(' fpopenapiclient, %s;', [DtoUnit]);
- undent;
- Addln('');
- EnsureSection(csType);
- indent;
- GenerateAuxiliaryTypes;
- for I:=0 to aData.ServiceCount-1 do
- begin
- lService:=aData.Services[I];
- if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
- GenerateServiceInterface(lService);
- end;
- undent;
- Addln('');
- Addln('implementation');
- Addln('');
- Addln('end.');
- finally
- SetTypeData(nil);
- end;
- end;
- { TServiceImplementationCodeGen }
- procedure TServiceImplementationCodeGen.GenerateServiceImplementationDecl(aService: TAPIService);
- var
- I: integer;
- lDecl, lParent: string;
- lMethod: TAPIServiceMethod;
- lName: string;
- begin
- lName:=aService.ServiceProxyImplementationClassName;
- DoLog('Generating class %s to implement service interface %s', [lName,
- aService.ServiceName]);
- lParent:=ServiceParentClass;
- Addln('// Service %s', [aService.ServiceInterfaceName]);
- Addln('');
- if ServiceInterfaceUnit<>'' then
- Addln('%s = Class (%s,%s)', [lName, lParent, aService.ServiceInterfaceName])
- else
- Addln('%s = Class (%s)', [lName, lParent]);
- Indent;
- for I:=0 to aService.MethodCount-1 do
- begin
- lMethod:=aService.Methods[I];
- lDecl:=GenerateClientServiceMethodDecl(lMethod, '');
- Addln(lDecl);
- end;
- if not ParentHasCancelRequest then
- Addln('Procedure CancelRequest(aRequestID : TServiceRequestID);');
- undent;
- Addln('end;');
- Addln('');
- end;
- constructor TServiceImplementationCodeGen.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- ServiceParentClass:='TFPOpenAPIServiceClient';
- ServiceParentUnit:='fpopenapiclient';
- end;
- procedure TServiceImplementationCodeGen.GenerateConstructor(aService: TAPIService);
- var
- lName: string;
- begin
- lName:=aService.ServiceProxyImplementationClassName;
- Addln('Constructor %s.Create(aOwner : TComponent; aWebClient : TFPAbstractWebClient);',
- [lName]);
- Addln('begin');
- indent;
- Addln('Inherited Create(aOwner);');
- // We can try to put http/authenticator in a parent class ?
- Addln('WebClient:=aWebClient;');
- undent;
- Addln('end;');
- Addln('');
- end;
- procedure TServiceImplementationCodeGen.SetServiceInterfaceUnit(AValue: string);
- begin
- if FServiceInterfaceUnit = AValue then Exit;
- FServiceInterfaceUnit:=AValue;
- end;
- procedure TServiceImplementationCodeGen.GenerateCancelRequest(aService: TAPIService);
- var
- lName: string;
- begin
- lName:=aService.ServiceProxyImplementationClassName;
- Addln('Procedure %s.CancelRequest(aRequestID : TServiceRequestID);', [lName]);
- Addln('');
- Addln('begin');
- indent;
- Addln('WebClient.CancelRequest(aRequestID);');
- undent;
- Addln('end;');
- Addln('');
- end;
- procedure TServiceImplementationCodeGen.GenerateURLConstruction(aService: TAPIService; aMethod: TAPIServiceMethod);
- var
- I: integer;
- lParam: TAPIServiceMethodParam;
- lParamName: string;
- begin
- Addln('lURL:=BuildEndPointURL(lMethodURL);');
- if aMethod.HasQueryParam then
- Addln('lQuery:='''';');
- if aMethod.Operation.HasKeyWord(okParameters) then
- begin
- for I:=0 to aMethod.Operation.Parameters.Count-1 do
- begin
- lParam:=aMethod.Param[I];
- if lParam.Location = plPath then
- begin
- lParamName:=lParam.OriginalName;
- Addln('lUrl:=ReplacePathParam(lURL,''%s'',%s);',
- [lParamName, lParam.AsStringValue]);
- end;
- end;
- for I:=0 to aMethod.Operation.Parameters.Count-1 do
- begin
- lParam:=aMethod.Param[I];
- if lParam.Location = plQuery then
- begin
- lParamName:=lParam.OriginalName;
- Addln('lQuery:=ConcatRestParam(lQuery,''%s'',%s);', [lParamName, lParam.AsStringValue]);
- end;
- end;
- end;
- if aMethod.HasQueryParam then
- Addln('lURL:=lURL+lQuery;');
- end;
- procedure TServiceImplementationCodeGen.GenerateServiceMethodImpl(aService: TAPIService; aMethod: TAPIServiceMethod);
- var
- lDecl: string;
- lHTTPMethod: string;
- lBodyArg: string;
- lName: string;
- begin
- lName:=aService.ServiceProxyImplementationClassName;
- lDecl:=GenerateClientServiceMethodDecl(aMethod, lName);
- Addln(lDecl);
- Addln('');
- Addln('const');
- indent;
- Addln('lMethodURL = ''%s'';', [aMethod.Path.PathComponent]);
- undent;
- Addln('');
- Addln('var');
- indent;
- Addln('lURL : String;');
- Addln('lResponse : TServiceResponse;');
- if aMethod.HasQueryParam then
- Addln('lQuery : String;');
- undent;
- Addln('');
- Addln('begin');
- indent;
- Addln('Result:=Default(%s);', [GetMethodResultType(aMethod)]);
- GenerateURLConstruction(aService, aMethod);
- lHTTPMethod:=aMethod.Operation.PathComponent;
- if aMethod.RequestBodyDataType<>nil then
- lBodyArg:='aBody.Serialize'
- else
- lBodyArg:='''''';
- Addln('lResponse:=ExecuteRequest(''%s'',lURL,%s);', [lHTTPMethod, lBodyArg]);
- AddLn('Result:=%s.Create(lResponse);', [GetMethodResultType(aMethod)]);
- if aMethod.ResultDataType<>nil then
- begin
- Addln('if Result.Success then');
- indent;
- Addln('Result.Value:=%s.Deserialize(lResponse.Content);', [aMethod.ResultDtoType]);
- Undent;
- end
- else
- Addln('Result.Value:=Result.Success;');
- undent;
- Addln('end;');
- Addln('');
- end;
- procedure TServiceImplementationCodeGen.GenerateServiceImplementationImpl(aService: TAPIService);
- var
- I: integer;
- lName: string;
- begin
- lName:=aService.ServiceProxyImplementationClassName;
- DoLog('Generating implementation for class %s', [lName]);
- if AsyncService then
- GenerateCancelRequest(aService);
- for I:=0 to aService.MethodCount-1 do
- GenerateServiceMethodImpl(aService, aService.Methods[I]);
- end;
- procedure TServiceImplementationCodeGen.Execute(aData: TAPIData);
- var
- I: integer;
- lService: TAPIService;
- begin
- SetTypeData(aData);
- GenerateHeader;
- Addln('unit %s;', [Self.OutputUnitName]);
- Addln('');
- if AsyncService then
- GenerateFPCDirectives(['functionreferences, anonymousfunctions'])
- else
- GenerateFPCDirectives();
- Addln('interface');
- Addln('');
- Addln('uses');
- indent;
- AddLn('fpopenapiclient');
- if ServiceInterfaceUnit<>'' then
- Addln(', %s // Service definition ', [ServiceInterfaceUnit]);
- if (ServiceParentUnit<>'') and not SameText(ServiceParentUnit, 'fpopenapiclient') then
- Addln(', %s // Service parent class ', [ServiceParentUnit]);
- Addln(', %s;', [DtoUnit]);
- undent;
- Addln('');
- EnsureSection(csType);
- indent;
- if ServiceInterfaceUnit = '' then
- GenerateAuxiliaryTypes;
- for I:=0 to aData.ServiceCount-1 do
- begin
- lService:=aData.Services[I];
- if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
- GenerateServiceImplementationDecl(lService);
- end;
- undent;
- Addln('');
- Addln('implementation');
- Addln('');
- Addln('uses');
- indent;
- if DelphiCode then
- Addln('System.SysUtils')
- else
- Addln('SysUtils');
- Addln(', %s;', [SerializerUnit]);
- undent;
- Addln('');
- for I:=0 to aData.ServiceCount-1 do
- begin
- lService:=aData.Services[I];
- if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
- GenerateServiceImplementationImpl(lService);
- end;
- Addln('');
- Addln('end.');
- end;
- { TServerModuleCodeGen }
- function TServerCodeGen.GetMethodHandleRequestName(aMethod: TAPIServiceMethod; const aClassName: string): string;
- var
- lMethodName: string;
- begin
- lMethodName:=aMethod.MethodName;
- lMethodName:='Handle'+lMethodName+'Request';
- if aClassName<>'' then
- lMethodName:=aClassName+'.'+lMethodName;
- Result:=lMethodName;
- end;
- function TServerCodeGen.GetServerServiceHandleMethodDecl(aMethod: TAPIServiceMethod; const aClassName: string): string;
- var
- lMethodName: string;
- begin
- lMethodName:=GetMethodHandleRequestName(aMethod, aClassName);
- Result:=Format('Procedure %s(aRequest : TRequest; aResponse : TResponse);',
- [lMethodName]);
- if aclassName = '' then
- Result:=Result+' virtual;';
- end;
- function TServerCodeGen.GetMethodParameterDecl(aMethod: TAPIServiceMethod;
- aParam: TAPIServiceMethodParam): string;
- begin
- Result:=aParam.Name+': ';
- Result:=Result+aParam.TypeName;
- end;
- function TServerCodeGen.GetMethodArgs(aMethod: TAPIServiceMethod): string;
- var
- I: integer;
- begin
- Result:='';
- for I:=0 to aMethod.ParamCount-1 do
- begin
- if Result<>'' then
- Result:=Result+'; ';
- Result:=Result+GetMethodParameterDecl(aMethod, aMethod.Param[i]);
- end;
- if aMethod.RequestBodyDataType<>nil then
- begin
- if Result<>'' then
- Result:=Result+'; ';
- Result:=Result+'aBody : '+aMethod.RequestBodyDataType.PascalName;
- end;
- end;
- function TServerCodeGen.GetServerServiceMethodDecl(aMethod: TAPIServiceMethod; const aClassName: string): string;
- var
- lMethodArgs: string;
- lMethodName: string;
- lResultType: string;
- begin
- lMethodName:=aMethod.MethodName;
- if aClassName<>'' then
- lMethodName:=aClassName+'.'+lMethodName;
- lResultType:=aMethod.ResultDtoType;
- lMethodArgs:=GetMethodArgs(aMethod);
- if lResultType = '' then
- Result:=Format('procedure %s(%s);', [lMethodName, lMethodArgs])
- else
- Result:=Format('function %s(%s) : %s;', [lMethodName, lMethodArgs, lResultType]);
- end;
- procedure TServerCodeGen.GenerateServerServiceImplementationDecl(aService: TAPIService;
- aParentModule, aModuleName: string; isAbstract: boolean; isHandler: boolean);
- var
- lDecl: string;
- lMethod: TAPIServiceMethod;
- I: integer;
- begin
- Addln('%s = class(%s)', [aModuleName, aParentModule]);
- Addln('Public');
- Indent;
- if IsHandler then
- begin
- Addln('class Procedure RegisterAPIRoutes(aBaseURL : String; aUseStreaming : Boolean = False); override;');
- for I:=0 to aService.MethodCount-1 do
- begin
- lMethod:=aService.Methods[i];
- lDecl:=GetServerServiceHandleMethodDecl(lMethod, '');
- Addln(lDecl);
- end;
- end;
- AddLn('');
- for I:=0 to aService.MethodCount-1 do
- begin
- lMethod:=aService.Methods[i];
- lDecl:=GetServerServiceMethodDecl(lMethod, '');
- if isHandler then
- begin
- lDecl:=lDecl+' virtual;';
- if isAbstract then
- lDecl:=lDecl+' abstract;';
- end
- else
- lDecl:=lDecl+' override;';
- Addln(lDecl);
- end;
- undent;
- AddLn('end;');
- AddLn('');
- end;
- class function TServerModuleHandlerCodeGen.ConvertToRouteParams(const aPath: string): string;
- begin
- Result:=StringReplace(aPath, '{', ':', [rfReplaceAll]);
- Result:=StringReplace(Result, '}', '', [rfReplaceAll]);
- end;
- procedure TServerModuleHandlerCodeGen.GenerateRegisterAPIRoutes(aClassName: string; aService: TAPIService);
- const
- lRegisterCall = 'RegisterOpenAPIRoute(aBaseURL,''%s'',@%s,aUseStreaming);';
- var
- I: integer;
- lMethod: TAPIServiceMethod;
- lDecl, lEndPoint: string;
- begin
- Addln('class Procedure %s.RegisterAPIRoutes(aBaseURL : String; aUseStreaming : Boolean = False);', [aClassName]);
- Addln('begin');
- Indent;
- for I:=0 to aService.MethodCount-1 do
- begin
- lMethod:=aService.Methods[i];
- lDecl:=GetMethodHandleRequestName(lMethod, '');
- lEndPoint:=ConvertToRouteParams(lMethod.Path.PathComponent);
- Addln(lRegisterCall, [lEndPoint, lDecl]);
- end;
- Undent;
- Addln('end;');
- Addln('');
- end;
- procedure TServerModuleHandlerCodeGen.WriteConvertArgument(aMethod: TAPIServiceMethod;
- aParam: TAPIServiceMethodParam);
- const
- LocationNames: array[TParamLocation] of string =
- ('alQuery', 'alPath', 'alHeader', 'alCookie');
- var
- lDefault: string;
- lLocation: string;
- lLocalName: string;
- lParamName: string;
- begin
- lParamName:=aParam.OriginalName;
- lLocalName:='_'+aParam.Name;
- lDefault:=aParam.DefaultValue;
- if lDefault = '' then
- case aParam.ArgType of
- ptString: lDefault:='''''';
- ptInteger: lDefault:='0';
- ptInt64: lDefault:='Int64(0)';
- ptDateTime: lDefault:='TDateTime(0.0)';
- ptFloat32: lDefault:='0.0';
- ptFloat64: lDefault:='0.0';
- end;
- lLocation:=LocationNames[aParam.Location];
- AddLn('%s:=ExtractRequestArgument(aRequest,%s,''%s'',%s);',
- [lLocalName, lLocation, lParamName, lDefault]);
- end;
- procedure TServerModuleHandlerCodeGen.GenerateServerServiceHandleMethodImpl(lMethod: TAPIserviceMethod; const aClassName: string);
- var
- lResultType: string;
- lCallArgs: string;
- i: integer;
- procedure AddToArgs(aName: string);
- begin
- if lCallArgs<>'' then
- lCallargs:=lCallArgs+';';
- lCallargs:=lCallArgs+aName;
- end;
- begin
- AddLn(GetServerServiceHandleMethodDecl(lMethod, aClassName));
- lResultType:=lMethod.ResultDtoType;
- Addln('');
- Addln('var');
- indent;
- Addln('lResult : %s;', [lResultType]);
- for I:=0 to lMethod.ParamCount-1 do
- begin
- Addln('_%s;', [GetMethodParameterDecl(lMethod, lMethod.Param[i])]);
- AddToArgs('_'+lMethod.Param[I].Name);
- end;
- if lMethod.RequestBodyDataType<>nil then
- begin
- Addln('_Body : %s;', [lMethod.RequestBodyDataType.PascalName]);
- AddToArgs('_lBody');
- end;
- undent;
- Addln('');
- Addln('begin');
- indent;
- Addln('lResult:=Default(%s);', [lResultType]);
- Addln('try');
- Indent;
- Addln('if PrepareRequest(aRequest,aResponse) then');
- Indent;
- Addln('begin');
- if lResultType<>'' then
- begin
- for I:=0 to lMethod.ParamCount-1 do
- WriteConvertArgument(lMethod, lMethod.Param[i]);
- if lMethod.RequestBodyDataType<>nil then
- AddLn('_lBody:=%s.Deserialize;', [lMethod.RequestBodyDataType.PascalName]);
- Addln('lResult:=%s(%s);', [lMethod.MethodName, lCallArgs]);
- if WriteClassType then
- begin
- Addln('try');
- Indent;
- Addln('aResponse.Content:=lResult.Serialize;');
- end;
- end
- else
- Addln('%s;', [lMethod.MethodName]);
- if (lResultType<>'') and WriteClassType then
- begin
- Undent;
- Addln('finally');
- Indent;
- Addln('FreeAndNil(lResult);');
- Undent;
- Addln('end;'); // Finally
- end;
- Addln('end;'); // if PrepareRequest
- Undent;
- Addln('ProcessResponse(aRequest,aResponse);');
- Undent;
- Addln('except');
- Indent;
- Addln('on E : Exception do');
- Indent;
- Addln('HandleRequestError(E,aRequest,aResponse);');
- Undent;
- Undent;
- Addln('end;'); // except
- undent;
- Addln('end;'); // handlerequest
- Addln('');
- end;
- procedure TServerCodeGen.GenerateServerServiceMethodImpl(lMethod: TAPIserviceMethod; const aClassName: string);
- var
- lResultType, lDecl: string;
- begin
- lDecl:=GetServerServiceMethodDecl(lMethod, aClassName);
- lResultType:=lMethod.ResultDtoType;
- AddLn(lDecl);
- Addln('');
- Addln('begin');
- Indent;
- AddLn('Result:=Default(%s);', [lResultType]);
- Undent;
- Addln('end;');
- Addln('');
- end;
- procedure TServerCodeGen.GenerateServerServiceImplementationImpl(aService: TAPIService; const aModuleName: string; isAbstract: boolean);
- var
- lMethod: TAPIServiceMethod;
- I: integer;
- begin
- AddLn('');
- if not IsAbstract then
- begin
- for I:=0 to aService.MethodCount-1 do
- begin
- lMethod:=aService.Methods[i];
- GenerateServerServiceMethodImpl(lMethod, aModuleName);
- end;
- AddLn('');
- end;
- end;
- function TServerModuleHandlerCodeGen.GetModuleParentCLass: string;
- begin
- Result:=FModuleParentClass;
- if Result = '' then
- Result:='TFPOpenAPIModule';
- end;
- function TServerCodeGen.GetModuleParentUnit: string;
- begin
- Result:=FModuleParentUnit;
- if Result = '' then
- Result:='fpopenapimodule';
- end;
- procedure TServerModuleHandlerCodeGen.GenerateServerServiceImplementationImpl(aService: TAPIService; const aModuleName: string; IsAbstract: boolean);
- var
- I: integer;
- lMethod: TAPIServiceMethod;
- begin
- GenerateRegisterAPIRoutes(aModuleName, aService);
- for I:=0 to aService.MethodCount-1 do
- begin
- lMethod:=aService.Methods[i];
- GenerateServerServiceHandleMethodImpl(lMethod, aModuleName);
- end;
- inherited GenerateServerServiceImplementationImpl(aService, aModuleName, isAbstract);
- end;
- procedure TServerModuleHandlerCodeGen.Execute(aData: TAPIData);
- var
- I: integer;
- lService: TAPIService;
- lName: string;
- begin
- SetTypeData(aData);
- GenerateHeader;
- GenerateFPCDirectives();
- Addln('unit %s;', [Self.OutputUnitName]);
- Addln('');
- if AsyncService then
- GenerateFPCDirectives();
- Addln('interface');
- Addln('');
- Addln('uses');
- indent;
- AddLn('%s, httpprotocol, httpdefs, fphttpapp, httproute, %s;',
- [ModuleParentUnit, DtoUnit]);
- undent;
- Addln('');
- EnsureSection(csType);
- indent;
- for I:=0 to aData.ServiceCount-1 do
- begin
- lService:=aData.Services[I];
- if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
- begin
- if AbstractServiceCalls then
- lName:='TAbstract'+lService.ServiceName+'Module'
- else
- lName:='T'+lService.ServiceName+'Module';
- GenerateServerServiceImplementationDecl(
- lService, ModuleParentClass, lName, AbstractServiceCalls, True);
- end;
- end;
- undent;
- Addln('');
- Addln('implementation');
- Addln('');
- Addln('uses');
- indent;
- if DelphiCode then
- Addln('System.SysUtils')
- else
- Addln('SysUtils');
- Addln(', %s;', [SerializerUnit]);
- undent;
- Addln('');
- for I:=0 to aData.ServiceCount-1 do
- begin
- lService:=aData.Services[I];
- if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
- begin
- if AbstractServiceCalls then
- lName:='TAbstract'+lService.ServiceName+'Module'
- else
- lName:='T'+lService.ServiceName+'Module';
- GenerateServerServiceImplementationImpl(lService, lName, AbstractServiceCalls);
- end;
- end;
- Addln('');
- Addln('end.');
- end;
- { TServerImplementationModuleCodeGen }
- procedure TServerImplementationModuleCodeGen.Execute(aData: TAPIData);
- var
- I: integer;
- lService: TAPIService;
- lName, lParentName: string;
- begin
- SetTypeData(aData);
- GenerateHeader;
- GenerateFPCDirectives();
- Addln('unit %s;', [Self.OutputUnitName]);
- Addln('');
- if AsyncService then
- GenerateFPCDirectives();
- Addln('interface');
- Addln('');
- Addln('uses');
- indent;
- AddLn('%s, %s;', [ModuleParentUnit, DtoUnit]);
- undent;
- Addln('');
- EnsureSection(csType);
- indent;
- for I:=0 to aData.ServiceCount-1 do
- begin
- lService:=aData.Services[I];
- if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
- begin
- lName:='T'+lService.ServiceName+'Module';
- lParentName:='TAbstract'+lService.ServiceName+'Module';
- GenerateServerServiceImplementationDecl(lService, lParentName, lName, False, False);
- end;
- end;
- undent;
- Addln('');
- Addln('implementation');
- Addln('');
- Addln('uses');
- indent;
- if DelphiCode then
- Addln('System.SysUtils')
- else
- Addln('SysUtils');
- Addln(', %s;', [SerializerUnit]);
- undent;
- Addln('');
- for I:=0 to aData.ServiceCount-1 do
- begin
- lService:=aData.Services[I];
- if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
- begin
- lName:='T'+lService.ServiceName+'Module';
- GenerateServerServiceImplementationImpl(lService, lName, False);
- end;
- end;
- Addln('');
- Addln('end.');
- end;
- { TServerServiceModule }
- function TServerProxyServiceModuleCodeGen.GetProxyVarName: String;
- begin
- Result:=FProxyVarName;
- if Result='' then
- Result:=Copy(ProxyClassName,2,Length(ProxyClassName)-1);
- end;
- procedure TServerProxyServiceModuleCodeGen.SetProxyClassName(const aValue: string);
- begin
- if FProxyClassName=aValue then Exit;
- FProxyClassName:=aValue;
- CheckDefaults;
- end;
- constructor TServerProxyServiceModuleCodeGen.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- FForm:=TStringList.Create;
- CheckDefaults;
- end;
- destructor TServerProxyServiceModuleCodeGen.Destroy;
- begin
- FreeAndNil(FForm);
- inherited Destroy;
- end;
- procedure TServerProxyServiceModuleCodeGen.CheckDefaults;
- begin
- if FProxyClassName='' then
- FProxyClassName:=DefaultServerProxyName;
- if FProxyParentClass='' then
- FProxyParentClass:=DefaultServerProxyParent;
- if FProxyParentUnit='' then
- FProxyParentUnit:=DefaultServerProxyParentUnit;
- end;
- procedure TServerProxyServiceModuleCodeGen.GenerateModule;
- var
- I: integer;
- lClass,lUnits : String;
- lService: TAPIService;
- begin
- GenerateFPCDirectives();
- CheckDefaults;
- Addln('unit %s;', [Self.OutputUnitName]);
- Addln('');
- Addln('interface');
- Addln('');
- Addln('uses');
- indent;
- lUnits:=ServiceInterfaceUnit+', '+ServiceImplementationUnit;
- if not (SameText(ProxyParentUnit,'Classes') or SameText(ProxyParentUnit,'System.Classes')) then
- if DelphiCode then
- lUnits:='System.Classes, '+lUnits
- else
- lUnits:='Classes, fpWebClient, '+lUnits;
- AddLn('%s, %s;', [ProxyParentUnit, lUnits]);
- undent;
- Addln('');
- EnsureSection(csType);
- indent;
- Addln('%s = class(%s)',[ProxyClassName,ProxyParentClass]);
- Addln('private');
- indent;
- Addln('FWebClient : TAbstractWebClient;');
- Addln('FBaseURL : TAbstractWebClient;');
- for I:=0 to APIData.ServiceCount-1 do
- begin
- lService:=APIData.Services[I];
- lClass:=lService.ServiceProxyImplementationClassName;
- Addln('F%s : %s;',[lService.ServiceName,lClass]);
- end;
- if UseInterfaceType then
- for I:=0 to APIData.ServiceCount-1 do
- begin
- lService:=APIData.Services[I];
- lClass:=lService.ServiceProxyImplementationClassName;
- Addln('function Get%s : %s;',[lService.ServiceName,lService.ServiceInterfaceName]);
- end;
- Addln('Procedure SetBaseURL(const aValue : string);');
- 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];
- if UseInterfaceType then
- Addln('Property %s : %s read Get%s;',[lService.ServiceName,lService.ServiceInterfaceName,lService.ServiceName])
- else
- Addln('Property %s : %s read F%s;',[lService.ServiceName,lService.ServiceProxyImplementationClassName,lService.ServiceName]);
- end;
- Addln('Property BaseURL : String Read FBaseURL Write SetBaseURL;',[lService.ServiceName,lService.ServiceInterfaceName,lService.ServiceName]);
- undent;
- Addln('end;');
- undent;
- Addln('');
- if FormFile then
- begin
- Addln('var %s : %s;',[ProxyVarName,ProxyClassName]);
- Addln('');
- end;
- Addln('implementation');
- Addln('');
- Addln('uses');
- indent;
- if DelphiCode then
- Addln('System.SysUtils;')
- else
- Addln('SysUtils;');
- undent;
- if FormFile then
- begin
- Addln('');
- Addln('{$R *.lfm}');
- end;
- Addln('');
- Addln('constructor %s.Create(aOwner : TComponent);',[ProxyClassName]);
- Addln('');
- Addln('begin');
- indent;
- Addln('Inherited;');
- Addln('FWebClient:=DefaultWebClientClass.Create(Self);');
- 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];
- lClass:=lService.ServiceProxyImplementationClassName;
- Addln('F%s:=%s.create(Self);',[lService.ServiceName,lClass]);
- Addln('%s(F%s).WebClient:=FWebClient',[lClass,lService.ServiceName]);
- end;
- undent;
- Addln('end;');
- Addln('');
- Addln('');
- Addln('Procedure %s.SetBaseURL(const aValue : string);',[ProxyClassName]);
- Addln('');
- Addln('begin');
- Indent;
- Addln('FBaseURL:=aValue;');
- for I:=0 to APIData.ServiceCount-1 do
- begin
- lService:=APIData.Services[I];
- Addln('F%s.BaseURL:=aValue;',[lService.ServiceName]);
- end;
- undent;
- Addln('end;');
- Addln('');
- Addln('');
- for I:=0 to APIData.ServiceCount-1 do
- begin
- lService:=APIData.Services[I];
- lClass:=lService.ServiceProxyImplementationClassName;
- Addln('function %s.Get%s : %s;',[ProxyClassName,lService.ServiceName,lService.ServiceInterfaceName]);
- Addln('');
- Addln('begin');
- Indent;
- Addln('Result:=F%s;',[lService.ServiceName]);
- Undent;
- Addln('end;');
- Addln('');
- Addln('');
- end;
- Addln('');
- Addln('end.');
- end;
- procedure TServerProxyServiceModuleCodeGen.GenerateFormFile;
- begin
- With FForm Do
- begin
- Add('object %s: %s',[ProxyVarName,ProxyClassName]);
- Add(' OldCreateOrder = False');
- Add(' Height = 150');
- Add(' HorizontalOffset = 547');
- Add(' VerticalOffset = 323');
- Add(' Width = 150');
- Add('end');
- end;
- end;
- procedure TServerProxyServiceModuleCodeGen.Execute(aData: TAPIData);
- begin
- SetTypeData(aData);
- GenerateModule;
- if FFormFile then
- GenerateFormFile;
- end;
- end.
|