fpopenapi.generators.pp 42 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566
  1. {
  2. This file is part of the Free Component Library
  3. Copyright (c) 2024 by Michael Van Canneyt [email protected]
  4. Open API code generators
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. unit fpopenapi.generators;
  12. {$mode ObjFPC}{$H+}
  13. interface
  14. uses
  15. {$IFDEF FPC_DOTTEDUNITS}
  16. System.Classes, System.SysUtils, System.DateUtils, System.Contnrs, Pascal.CodeGenerator,
  17. {$ELSE}
  18. Classes, SysUtils, strutils, dateutils, pascodegen, inifiles,
  19. {$ENDIF}
  20. fpjson.schema.types,
  21. fpjson.schema.Pascaltypes,
  22. fpjson.schema.codegen,
  23. fpopenapi.objects,
  24. fpopenapi.types,
  25. fpopenapi.pascaltypes;
  26. Const
  27. DefaultServerProxyName = 'TServerProxy';
  28. DefaultServerProxyParent = 'TDataModule';
  29. DefaultServerProxyParentUnit = 'Classes';
  30. type
  31. { TJSONSchemaCodeGeneratorHelper }
  32. // Helper class to generate an API unit header
  33. // And to get access
  34. TJSONSchemaCodeGeneratorHelper = class helper for TJSONSchemaCodeGenerator
  35. procedure GenerateAPIheader;
  36. function ApiData: TAPIData;
  37. end;
  38. { TOpenApiPascalCodeGen }
  39. TOpenApiPascalCodeGen = class(TJSONSchemaCodeGenerator)
  40. private
  41. function GetData: TAPIData;
  42. protected
  43. procedure GenerateHeader; override;
  44. public
  45. property APIData: TAPIData read GetData;
  46. end;
  47. { TDtoCodeGen }
  48. TDtoCodeGen = class(TTypeCodeGenerator)
  49. protected
  50. procedure GenerateHeader; override;
  51. end;
  52. { TSerializerCodeGen }
  53. TSerializerCodeGen = class(TSerializerCodeGenerator)
  54. protected
  55. procedure GenerateHeader; override;
  56. end;
  57. { TIntfCodeGen }
  58. { TOpenAPIServiceCodeGen }
  59. TOpenAPIServiceCodeGen = class(TOpenApiPascalCodeGen)
  60. private
  61. FDefineServiceResultType: boolean;
  62. FDtoUnit: string;
  63. FSerializerUnit: string;
  64. FServiceName: string;
  65. FAsync: boolean;
  66. FServiceRequestIDType: string;
  67. FServiceResultType: string;
  68. function GetServiceRequestIDType: string;
  69. function GetServiceResultType: string;
  70. protected
  71. procedure WriteResultTypes; virtual;
  72. procedure WriteCallbackTypes; virtual;
  73. procedure GenerateAuxiliaryTypes; virtual;
  74. procedure GenerateServiceResultType; virtual;
  75. function GenerateClientServiceMethodDecl(aMethod: TAPIServiceMethod; const aClassName: string): string; virtual;
  76. procedure GetMethodCallbackTypeNames(aTypes: TStrings); virtual;
  77. procedure GetMethodResultTypeNames(aTypes: TStrings); virtual;
  78. function GetMethodResultType(aMethod: TAPIServiceMethod): string; virtual;
  79. function MethodResultCallBackName(aMethod: TAPIServiceMethod): string; virtual;
  80. function ParameterToArg(Idx: integer; aParam: TAPIServiceMethodParam): string; virtual;
  81. public
  82. constructor Create(AOwner: TComponent); override;
  83. property ServiceName: string read FServiceName write FServiceName;
  84. property DtoUnit: string read FDtoUnit write FDtoUnit;
  85. property SerializerUnit: string read FSerializerUnit write FSerializerUnit;
  86. property AsyncService: boolean read FAsync write FAsync;
  87. property ServiceResultType: string read GetServiceResultType write FServiceResultType;
  88. property DefineServiceResultType: boolean read FDefineServiceResultType write FDefineServiceResultType;
  89. property ServiceRequestIDType: string read GetServiceRequestIDType write FServiceRequestIDType;
  90. end;
  91. { TServiceInterfaceCodeGen }
  92. TServiceInterfaceCodeGen = class(TOpenAPIServiceCodeGen)
  93. protected
  94. procedure GenerateServiceInterface(aService: TAPIService); virtual;
  95. public
  96. procedure Execute(aData: TAPIData); virtual;
  97. end;
  98. { TServiceImplementationCodeGen }
  99. TServiceImplementationCodeGen = class(TOpenAPIServiceCodeGen)
  100. private
  101. FParentHasCancelRequest: boolean;
  102. FServiceInterfaceUnit: string;
  103. FServiceParentClass: string;
  104. FServiceParentUnit: string;
  105. procedure SetServiceInterfaceUnit(AValue: string);
  106. protected
  107. procedure GenerateCancelRequest(aService: TAPIService); virtual;
  108. procedure GenerateConstructor(aService: TAPIService); virtual;
  109. procedure GenerateServiceImplementationImpl(aService: TAPIService); virtual;
  110. procedure GenerateServiceMethodImpl(aService: TAPIService; aMethod: TAPIServiceMethod); virtual;
  111. procedure GenerateURLConstruction(aService: TAPIService; aMethod: TAPIServiceMethod); virtual;
  112. procedure GenerateServiceImplementationDecl(aService: TAPIService); virtual;
  113. public
  114. constructor Create(AOwner: TComponent); override;
  115. procedure Execute(aData: TAPIData); virtual;
  116. property ServiceInterfaceUnit: string read FServiceInterfaceUnit write SetServiceInterfaceUnit;
  117. property ServiceParentClass: string read FServiceParentClass write FServiceParentClass;
  118. property ServiceParentUnit: string read FServiceParentUnit write FServiceParentUnit;
  119. property ParentHasCancelRequest: boolean read FParentHasCancelRequest write FParentHasCancelRequest;
  120. end;
  121. { TServerModuleCodeGen }
  122. { TServerCodeGen }
  123. TServerCodeGen = class(TOpenAPIServiceCodeGen)
  124. private
  125. FModuleParentUnit: string;
  126. function GetModuleParentUnit: string;
  127. protected
  128. procedure GenerateServerServiceMethodImpl(lMethod: TAPIserviceMethod; const aClassName: string);
  129. // needed for service registration
  130. function GetMethodHandleRequestName(aMethod: TAPIServiceMethod; const aClassName: string): string; virtual;
  131. function GetServerServiceHandleMethodDecl(aMethod: TAPIServiceMethod; const aClassName: string = ''): string; virtual;
  132. // Methods for the actual implementation
  133. function GetMethodParameterDecl(aMethod: TAPIServiceMethod; aParam: TAPIServiceMethodParam): string; virtual;
  134. function GetMethodArgs(aMethod: TAPIServiceMethod): string; virtual;
  135. function GetServerServiceMethodDecl(aMethod: TAPIServiceMethod; const aClassName: string = ''): string; virtual;
  136. procedure GenerateServerServiceImplementationImpl(aService: TAPIService; const aModuleName: string; isAbstract: boolean); virtual;
  137. procedure GenerateServerServiceImplementationDecl(aService: TAPIService;
  138. aParentModule, aModuleName: string; isAbstract: boolean; isHandler: boolean); virtual;
  139. public
  140. property ModuleParentUnit: string read GetModuleParentUnit write FModuleParentUnit;
  141. end;
  142. // This module generates a complete module that handles the HTTP Requests and hands them off.
  143. { TServerModuleHandlerCodeGen }
  144. TServerModuleHandlerCodeGen = class(TServerCodeGen)
  145. private
  146. FAbstractServiceCalls: boolean;
  147. FModuleParentClass: string;
  148. class function ConvertToRouteParams(const aPath: string): string;
  149. function GetModuleParentCLass: string;
  150. protected
  151. procedure GenerateRegisterAPIRoutes(aClassName: string; aService: TAPIService); virtual;
  152. procedure GenerateServerServiceImplementationImpl(aService: TAPIService; const aModuleName: string; isAbstract: boolean); override;
  153. procedure WriteConvertArgument(aMethod: TAPIServiceMethod; aParam: TAPIServiceMethodParam); virtual;
  154. procedure GenerateServerServiceHandleMethodImpl(lMethod: TAPIserviceMethod; const aClassName: string); virtual;
  155. public
  156. procedure Execute(aData: TAPIData); virtual;
  157. property AbstractServiceCalls: boolean read FAbstractServiceCalls write FAbstractServiceCalls;
  158. property ModuleParentClass: string read GetModuleParentClass write FModuleParentClass;
  159. end;
  160. // This module generates a descendant of the server module.
  161. // Can be used when TServerModuleCodeGen is used with AbstractServiceCalls = True
  162. { TServerImplementationModuleCodeGen }
  163. TServerImplementationModuleCodeGen = class(TServerCodeGen)
  164. public
  165. procedure Execute(aData: TAPIData); virtual;
  166. end;
  167. { TServerServiceModule }
  168. { TServerProxyServiceModule }
  169. { TServerProxyServiceModuleCodeGen }
  170. TServerProxyServiceModuleCodeGen = class(TOpenApiPascalCodeGen)
  171. private
  172. FFormFile: Boolean;
  173. FProxyClassName: string;
  174. FProxyParentClass: string;
  175. FProxyParentUnit: string;
  176. FProxyVarName: String;
  177. FServiceImplementationUnit: string;
  178. FServiceInterfaceUnit: string;
  179. FUseInterfaceType: Boolean;
  180. FForm : TStrings;
  181. procedure CheckDefaults;
  182. function GetProxyVarName: String;
  183. procedure SetProxyClassName(const aValue: string);
  184. Protected
  185. public
  186. constructor Create(AOwner: TComponent); override;
  187. Destructor Destroy; override;
  188. procedure GenerateModule;
  189. procedure GenerateFormFile;
  190. procedure Execute(aData: TAPIData); virtual;
  191. property ServiceInterfaceUnit: string read FServiceInterfaceUnit write FServiceInterfaceUnit;
  192. property ServiceImplementationUnit: string read FServiceImplementationUnit write FServiceImplementationUnit;
  193. property ProxyParentClass: string read FProxyParentClass write FProxyParentClass;
  194. property ProxyParentUnit: string read FProxyParentUnit write FProxyParentUnit;
  195. Property UseInterfaceType : Boolean Read FUseInterfaceType Write FUseInterfaceType;
  196. Property ProxyClassName : string Read FProxyClassName Write SetProxyClassName;
  197. Property ProxyVarName : String Read GetProxyVarName Write FProxyVarName;
  198. Property FormFile : Boolean Read FFormFile Write FFormFile;
  199. Property Form : TStrings Read FForm Write FForm;
  200. end;
  201. implementation
  202. { TJSONSchemaCodeGeneratorHelper }
  203. procedure TJSONSchemaCodeGeneratorHelper.GenerateAPIheader;
  204. var
  205. S, lTitle, lDate, lVersion: string;
  206. lDescription: TStrings;
  207. I: integer;
  208. begin
  209. lDescription:=nil;
  210. lDate:=FormatDateTime('yyyy"-"mm"-"dd hh":"nn', Now);
  211. lVersion:=APIData.API.Info.Version;
  212. lTitle:=APIData.API.Info.Title;
  213. if VerboseHeader and (APIData.API.Info.Description<>'') then
  214. begin
  215. lDescription:=TStringList.Create;
  216. lDescription.Text:=APIData.API.Info.Description;
  217. end;
  218. Addln('{ -----------------------------------------------------------------------');
  219. Indent;
  220. Addln('Do not edit !');
  221. Addln('');
  222. Addln('This file was automatically generated on %s.', [lDate]);
  223. S:='';
  224. for I:=1 to ParamCount do
  225. S:=S+' '+ParamStr(i);
  226. Addln('Used command-line parameters:');
  227. Indent;
  228. Addln(S);
  229. Undent;
  230. Addln('Source OpenAPI document data:');
  231. Indent;
  232. if lTitle<>'' then
  233. Addln('Title: %s', [lTitle]);
  234. if lVersion<>'' then
  235. Addln('Version: %s', [lVersion]);
  236. if Assigned(lDescription) then
  237. begin
  238. Addln('Description:');
  239. for S in lDescription do
  240. AddLn(S);
  241. end;
  242. Undent;
  243. Undent;
  244. Addln(' -----------------------------------------------------------------------}');
  245. FreeAndNil(lDescription);
  246. end;
  247. function TJSONSchemaCodeGeneratorHelper.ApiData: TAPIData;
  248. begin
  249. Result:=TypeData as TAPIData;
  250. end;
  251. { TOpenAPICodeGen }
  252. function TOpenApiPascalCodeGen.GetData: TAPIData;
  253. begin
  254. Result:=TypeData as TAPIData;
  255. end;
  256. procedure TOpenApiPascalCodeGen.GenerateHeader;
  257. begin
  258. GenerateAPIheader;
  259. end;
  260. { TDtoCodeGen }
  261. procedure TDtoCodeGen.GenerateHeader;
  262. begin
  263. GenerateAPIheader;
  264. end;
  265. { TSerializerCodeGen }
  266. procedure TSerializerCodeGen.GenerateHeader;
  267. begin
  268. GenerateAPIheader;
  269. end;
  270. { TOpenAPIerviceCodeGen }
  271. function TOpenAPIServiceCodeGen.MethodResultCallBackName(aMethod:
  272. TAPIServiceMethod): string;
  273. begin
  274. Result:=GetMethodResultType(aMethod);
  275. if Result<>'' then
  276. Result:=Result+'Callback';
  277. end;
  278. function TOpenAPIServiceCodeGen.ParameterToArg(Idx: integer;
  279. aParam: TAPIServiceMethodParam): string;
  280. begin
  281. Result:=Format('%s : %s', [aParam.Name, aParam.TypeName]);
  282. if aParam.DefaultValue<>'' then
  283. Result:=Result+' = '+aParam.DefaultValue;
  284. end;
  285. constructor TOpenAPIServiceCodeGen.Create(AOwner: TComponent);
  286. begin
  287. inherited Create(AOwner);
  288. DefineServiceResultType:=False;
  289. end;
  290. function TOpenAPIServiceCodeGen.GetServiceResultType: string;
  291. begin
  292. Result:=FServiceResultType;
  293. if Result = '' then
  294. Result:='TServiceResult';
  295. end;
  296. function TOpenAPIServiceCodeGen.GetServiceRequestIDType: string;
  297. begin
  298. Result:=FServiceRequestIDType;
  299. if Result = '' then
  300. Result:='TRESTServiceRequestID';
  301. end;
  302. procedure TOpenAPIServiceCodeGen.GenerateServiceResultType;
  303. begin
  304. if AsyncService then
  305. begin
  306. Addln('%s = string;', [ServiceRequestIDType]);
  307. Addln('');
  308. end;
  309. if not DelphiCode then
  310. Addln('generic %s<T> = record', [ServiceResultType])
  311. else
  312. Addln(' %s<T> = record', [ServiceResultType]);
  313. Indent;
  314. Addln('StatusCode : Integer;');
  315. Addln('StatusText : String;');
  316. if AsyncService then
  317. Addln('RequestID : %s;', [ServiceRequestIDType]);
  318. Addln('Value : T;');
  319. Undent;
  320. AddLn('end;');
  321. AddLn('');
  322. end;
  323. function TOpenAPIServiceCodeGen.GenerateClientServiceMethodDecl(aMethod: TAPIServiceMethod; const aClassName: string): string;
  324. procedure AddTo(var S: string; const T: string);
  325. begin
  326. if T = '' then exit;
  327. if S<>'' then
  328. S:=S+'; ';
  329. S:=S+T;
  330. end;
  331. var
  332. lBodyType, lResultType, lName, lParams: string;
  333. I: integer;
  334. begin
  335. lParams:='';
  336. // Non-optional
  337. for I:=0 to aMethod.ParamCount-1 do
  338. if aMethod.Param[I].DefaultValue = '' then
  339. AddTo(lParams, ParameterToArg(I, aMethod.Param[I]));
  340. if Assigned(aMethod.RequestBodyDataType) then
  341. lBodyType:=aMethod.RequestBodyDataType.GetTypeName(ntPascal);
  342. if lBodyType<>'' then
  343. AddTo(lParams, 'aBody : '+lBodyType);
  344. if AsyncService then
  345. AddTo(lParams, 'aCallback : '+MethodResultCallbackName(aMethod));
  346. // Optional
  347. for I:=0 to aMethod.ParamCount-1 do
  348. if aMethod.Param[I].DefaultValue<>'' then
  349. AddTo(lParams, ParameterToArg(I, aMethod.Param[I]));
  350. lName:=aMethod.MethodName;
  351. if aClassName<>'' then
  352. lName:=aClassName+'.'+lName;
  353. if AsyncService then
  354. Result:=Format('Function %s(%s) : %s;', [lName, lParams, ServiceRequestIDType])
  355. else
  356. begin
  357. lResultType:=GetMethodResultType(aMethod);
  358. Result:=Format('Function %s(%s) : %s;', [lName, lParams, lResultType]);
  359. end;
  360. end;
  361. procedure TOpenAPIServiceCodeGen.GetMethodCallbackTypeNames(aTypes: TStrings);
  362. var
  363. I, J: integer;
  364. lName: string;
  365. lService: TAPIService;
  366. lMethod: TAPIServiceMethod;
  367. begin
  368. for I:=0 to APIData.ServiceCount-1 do
  369. begin
  370. lService:=APIData.Services[I];
  371. if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
  372. for J:=0 to lService.MethodCount-1 do
  373. begin
  374. lMethod:=lService.Methods[J];
  375. if lMethod.ResultDataType<>nil then
  376. begin
  377. lName:=MethodResultCallBackName(lMethod);
  378. if lName<>'TVoidResultCallBack' then
  379. aTypes.AddObject(lName, lMethod);
  380. end;
  381. end;
  382. end;
  383. end;
  384. procedure TOpenAPIServiceCodeGen.GetMethodResultTypeNames(aTypes: TStrings);
  385. var
  386. I, J: integer;
  387. lName: string;
  388. lService: TAPIService;
  389. lMethod: TAPIServiceMethod;
  390. begin
  391. for I:=0 to APIData.ServiceCount-1 do
  392. begin
  393. lService:=APIData.Services[I];
  394. if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
  395. for J:=0 to lService.MethodCount-1 do
  396. begin
  397. lMethod:=lService.Methods[J];
  398. if lMethod.ResultDataType<>nil then
  399. begin
  400. lName:=GetMethodResultType(lMethod);
  401. if lName<>'' then
  402. aTypes.AddObject(lName, lMethod);
  403. end;
  404. end;
  405. end;
  406. end;
  407. function TOpenAPIServiceCodeGen.GetMethodResultType(aMethod: TAPIServiceMethod): string;
  408. begin
  409. Result:=aMethod.ResultDtoType;
  410. if Result<>'' then
  411. Result:=Result+'ServiceResult'
  412. else
  413. Result:='TVoidServiceResult';
  414. end;
  415. { TServiceInterfaceCodeGen }
  416. procedure TServiceInterfaceCodeGen.GenerateServiceInterface(aService: TAPIService);
  417. var
  418. I: integer;
  419. lDecl, lParent: string;
  420. lMethod: TAPIServiceMethod;
  421. begin
  422. DoLog('Generating service interface %s (UUID: %s)',
  423. [aService.ServiceName, aService.ServiceUUID]);
  424. lParent:=aService.ServiceParentInterface;
  425. if lParent<>'' then
  426. lParent:='('+lParent+')';
  427. Addln('// Service %s', [aService.ServiceInterfaceName]);
  428. Addln('');
  429. Addln('%s = interface %s [''%s'']', [aService.ServiceInterfaceName,
  430. lParent, aService.ServiceUUID]);
  431. indent;
  432. for I:=0 to aService.MethodCount-1 do
  433. begin
  434. lMethod:=aService.Methods[I];
  435. lDecl:=GenerateClientServiceMethodDecl(lMethod, '');
  436. Addln(lDecl);
  437. end;
  438. if AsyncService then
  439. Addln('Procedure CancelRequest(aRequestID : %s);', [ServiceRequestIDType]);
  440. undent;
  441. Addln('end;');
  442. Addln('');
  443. end;
  444. procedure TOpenAPIServiceCodeGen.WriteResultTypes;
  445. var
  446. I: integer;
  447. lName, lDef, lResType: string;
  448. lTypes: TStringList;
  449. begin
  450. Addln('// Service result types');
  451. lTypes:=TStringList.Create;
  452. try
  453. lTypes.Sorted:=True;
  454. lTypes.Duplicates:=dupIgnore;
  455. GetMethodResultTypeNames(lTypes);
  456. lTypes.Sorted:=False;
  457. for I:=0 to lTypes.Count-1 do
  458. begin
  459. lName:=lTypes[I];
  460. lResType:=TAPIServiceMethod(lTypes.objects[I]).ResultDtoType;
  461. lDef:=Format('%s<%s>', [ServiceResultType, lResType]);
  462. if not DelphiCode then
  463. lDef:='specialize '+lDef;
  464. Addln('%s = %s;', [lName, lDef]);
  465. end;
  466. Addln('');
  467. finally
  468. lTypes.Free;
  469. end;
  470. end;
  471. procedure TOpenAPIServiceCodeGen.WriteCallbackTypes;
  472. var
  473. I: integer;
  474. lName, lDef: string;
  475. lTypes: TStringList;
  476. begin
  477. Addln('// Service Callback types');
  478. lTypes:=TStringList.Create;
  479. try
  480. lTypes.Sorted:=True;
  481. lTypes.Duplicates:=dupIgnore;
  482. GetMethodCallbackTypeNames(lTypes);
  483. lTypes.Sorted:=False;
  484. for I:=0 to lTypes.Count-1 do
  485. begin
  486. lName:=lTypes[I];
  487. lDef:=Format('reference to procedure(aResult : %s)', [lName]);
  488. Addln('%s = %s;', [lName, lDef]);
  489. end;
  490. Addln('');
  491. finally
  492. lTypes.Free;
  493. end;
  494. end;
  495. procedure TOpenAPIServiceCodeGen.GenerateAuxiliaryTypes;
  496. begin
  497. if DefineServiceResultType then
  498. GenerateServiceResultType;
  499. WriteResultTypes;
  500. if AsyncService then
  501. WriteCallbackTypes;
  502. end;
  503. procedure TServiceInterfaceCodeGen.Execute(aData: TAPIData);
  504. var
  505. I: integer;
  506. lService: TAPIService;
  507. begin
  508. SetTypeData(aData);
  509. try
  510. GenerateHeader;
  511. Addln('unit %s;', [Self.OutputUnitName]);
  512. Addln('');
  513. if AsyncService then
  514. GenerateFPCDirectives(['functionreferences'])
  515. else
  516. GenerateFPCDirectives();
  517. Addln('interface');
  518. Addln('');
  519. Addln('uses');
  520. indent;
  521. Addln(' fpopenapiclient, %s;', [DtoUnit]);
  522. undent;
  523. Addln('');
  524. EnsureSection(csType);
  525. indent;
  526. GenerateAuxiliaryTypes;
  527. for I:=0 to aData.ServiceCount-1 do
  528. begin
  529. lService:=aData.Services[I];
  530. if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
  531. GenerateServiceInterface(lService);
  532. end;
  533. undent;
  534. Addln('');
  535. Addln('implementation');
  536. Addln('');
  537. Addln('end.');
  538. finally
  539. SetTypeData(nil);
  540. end;
  541. end;
  542. { TServiceImplementationCodeGen }
  543. procedure TServiceImplementationCodeGen.GenerateServiceImplementationDecl(aService: TAPIService);
  544. var
  545. I: integer;
  546. lDecl, lParent: string;
  547. lMethod: TAPIServiceMethod;
  548. lName: string;
  549. begin
  550. lName:=aService.ServiceProxyImplementationClassName;
  551. DoLog('Generating class %s to implement service interface %s', [lName,
  552. aService.ServiceName]);
  553. lParent:=ServiceParentClass;
  554. Addln('// Service %s', [aService.ServiceInterfaceName]);
  555. Addln('');
  556. if ServiceInterfaceUnit<>'' then
  557. Addln('%s = Class (%s,%s)', [lName, lParent, aService.ServiceInterfaceName])
  558. else
  559. Addln('%s = Class (%s)', [lName, lParent]);
  560. Indent;
  561. for I:=0 to aService.MethodCount-1 do
  562. begin
  563. lMethod:=aService.Methods[I];
  564. lDecl:=GenerateClientServiceMethodDecl(lMethod, '');
  565. Addln(lDecl);
  566. end;
  567. if not ParentHasCancelRequest then
  568. Addln('Procedure CancelRequest(aRequestID : TServiceRequestID);');
  569. undent;
  570. Addln('end;');
  571. Addln('');
  572. end;
  573. constructor TServiceImplementationCodeGen.Create(AOwner: TComponent);
  574. begin
  575. inherited Create(AOwner);
  576. ServiceParentClass:='TFPOpenAPIServiceClient';
  577. ServiceParentUnit:='fpopenapiclient';
  578. end;
  579. procedure TServiceImplementationCodeGen.GenerateConstructor(aService: TAPIService);
  580. var
  581. lName: string;
  582. begin
  583. lName:=aService.ServiceProxyImplementationClassName;
  584. Addln('Constructor %s.Create(aOwner : TComponent; aWebClient : TFPAbstractWebClient);',
  585. [lName]);
  586. Addln('begin');
  587. indent;
  588. Addln('Inherited Create(aOwner);');
  589. // We can try to put http/authenticator in a parent class ?
  590. Addln('WebClient:=aWebClient;');
  591. undent;
  592. Addln('end;');
  593. Addln('');
  594. end;
  595. procedure TServiceImplementationCodeGen.SetServiceInterfaceUnit(AValue: string);
  596. begin
  597. if FServiceInterfaceUnit = AValue then Exit;
  598. FServiceInterfaceUnit:=AValue;
  599. end;
  600. procedure TServiceImplementationCodeGen.GenerateCancelRequest(aService: TAPIService);
  601. var
  602. lName: string;
  603. begin
  604. lName:=aService.ServiceProxyImplementationClassName;
  605. Addln('Procedure %s.CancelRequest(aRequestID : TServiceRequestID);', [lName]);
  606. Addln('');
  607. Addln('begin');
  608. indent;
  609. Addln('WebClient.CancelRequest(aRequestID);');
  610. undent;
  611. Addln('end;');
  612. Addln('');
  613. end;
  614. procedure TServiceImplementationCodeGen.GenerateURLConstruction(aService: TAPIService; aMethod: TAPIServiceMethod);
  615. var
  616. I: integer;
  617. lParam: TAPIServiceMethodParam;
  618. lParamName: string;
  619. begin
  620. Addln('lURL:=BuildEndPointURL(lMethodURL);');
  621. if aMethod.HasQueryParam then
  622. Addln('lQuery:='''';');
  623. if aMethod.Operation.HasKeyWord(okParameters) then
  624. begin
  625. for I:=0 to aMethod.Operation.Parameters.Count-1 do
  626. begin
  627. lParam:=aMethod.Param[I];
  628. if lParam.Location = plPath then
  629. begin
  630. lParamName:=lParam.OriginalName;
  631. Addln('lUrl:=ReplacePathParam(lURL,''%s'',%s);',
  632. [lParamName, lParam.AsStringValue]);
  633. end;
  634. end;
  635. for I:=0 to aMethod.Operation.Parameters.Count-1 do
  636. begin
  637. lParam:=aMethod.Param[I];
  638. if lParam.Location = plQuery then
  639. begin
  640. lParamName:=lParam.OriginalName;
  641. Addln('lQuery:=ConcatRestParam(lQuery,''%s'',%s);', [lParamName, lParam.AsStringValue]);
  642. end;
  643. end;
  644. end;
  645. if aMethod.HasQueryParam then
  646. Addln('lURL:=lURL+lQuery;');
  647. end;
  648. procedure TServiceImplementationCodeGen.GenerateServiceMethodImpl(aService: TAPIService; aMethod: TAPIServiceMethod);
  649. var
  650. lDecl: string;
  651. lHTTPMethod: string;
  652. lBodyArg: string;
  653. lName: string;
  654. begin
  655. lName:=aService.ServiceProxyImplementationClassName;
  656. lDecl:=GenerateClientServiceMethodDecl(aMethod, lName);
  657. Addln(lDecl);
  658. Addln('');
  659. Addln('const');
  660. indent;
  661. Addln('lMethodURL = ''%s'';', [aMethod.Path.PathComponent]);
  662. undent;
  663. Addln('');
  664. Addln('var');
  665. indent;
  666. Addln('lURL : String;');
  667. Addln('lResponse : TServiceResponse;');
  668. if aMethod.HasQueryParam then
  669. Addln('lQuery : String;');
  670. undent;
  671. Addln('');
  672. Addln('begin');
  673. indent;
  674. Addln('Result:=Default(%s);', [GetMethodResultType(aMethod)]);
  675. GenerateURLConstruction(aService, aMethod);
  676. lHTTPMethod:=aMethod.Operation.PathComponent;
  677. if aMethod.RequestBodyDataType<>nil then
  678. lBodyArg:='aBody.Serialize'
  679. else
  680. lBodyArg:='''''';
  681. Addln('lResponse:=ExecuteRequest(''%s'',lURL,%s);', [lHTTPMethod, lBodyArg]);
  682. AddLn('Result:=%s.Create(lResponse);', [GetMethodResultType(aMethod)]);
  683. if aMethod.ResultDataType<>nil then
  684. begin
  685. Addln('if Result.Success then');
  686. indent;
  687. Addln('Result.Value:=%s.Deserialize(lResponse.Content);', [aMethod.ResultDtoType]);
  688. Undent;
  689. end
  690. else
  691. Addln('Result.Value:=Result.Success;');
  692. undent;
  693. Addln('end;');
  694. Addln('');
  695. end;
  696. procedure TServiceImplementationCodeGen.GenerateServiceImplementationImpl(aService: TAPIService);
  697. var
  698. I: integer;
  699. lName: string;
  700. begin
  701. lName:=aService.ServiceProxyImplementationClassName;
  702. DoLog('Generating implementation for class %s', [lName]);
  703. if AsyncService then
  704. GenerateCancelRequest(aService);
  705. for I:=0 to aService.MethodCount-1 do
  706. GenerateServiceMethodImpl(aService, aService.Methods[I]);
  707. end;
  708. procedure TServiceImplementationCodeGen.Execute(aData: TAPIData);
  709. var
  710. I: integer;
  711. lService: TAPIService;
  712. begin
  713. SetTypeData(aData);
  714. GenerateHeader;
  715. Addln('unit %s;', [Self.OutputUnitName]);
  716. Addln('');
  717. if AsyncService then
  718. GenerateFPCDirectives(['functionreferences, anonymousfunctions'])
  719. else
  720. GenerateFPCDirectives();
  721. Addln('interface');
  722. Addln('');
  723. Addln('uses');
  724. indent;
  725. AddLn('fpopenapiclient');
  726. if ServiceInterfaceUnit<>'' then
  727. Addln(', %s // Service definition ', [ServiceInterfaceUnit]);
  728. if (ServiceParentUnit<>'') and not SameText(ServiceParentUnit, 'fpopenapiclient') then
  729. Addln(', %s // Service parent class ', [ServiceParentUnit]);
  730. Addln(', %s;', [DtoUnit]);
  731. undent;
  732. Addln('');
  733. EnsureSection(csType);
  734. indent;
  735. if ServiceInterfaceUnit = '' then
  736. GenerateAuxiliaryTypes;
  737. for I:=0 to aData.ServiceCount-1 do
  738. begin
  739. lService:=aData.Services[I];
  740. if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
  741. GenerateServiceImplementationDecl(lService);
  742. end;
  743. undent;
  744. Addln('');
  745. Addln('implementation');
  746. Addln('');
  747. Addln('uses');
  748. indent;
  749. if DelphiCode then
  750. Addln('System.SysUtils')
  751. else
  752. Addln('SysUtils');
  753. Addln(', %s;', [SerializerUnit]);
  754. undent;
  755. Addln('');
  756. for I:=0 to aData.ServiceCount-1 do
  757. begin
  758. lService:=aData.Services[I];
  759. if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
  760. GenerateServiceImplementationImpl(lService);
  761. end;
  762. Addln('');
  763. Addln('end.');
  764. end;
  765. { TServerModuleCodeGen }
  766. function TServerCodeGen.GetMethodHandleRequestName(aMethod: TAPIServiceMethod; const aClassName: string): string;
  767. var
  768. lMethodName: string;
  769. begin
  770. lMethodName:=aMethod.MethodName;
  771. lMethodName:='Handle'+lMethodName+'Request';
  772. if aClassName<>'' then
  773. lMethodName:=aClassName+'.'+lMethodName;
  774. Result:=lMethodName;
  775. end;
  776. function TServerCodeGen.GetServerServiceHandleMethodDecl(aMethod: TAPIServiceMethod; const aClassName: string): string;
  777. var
  778. lMethodName: string;
  779. begin
  780. lMethodName:=GetMethodHandleRequestName(aMethod, aClassName);
  781. Result:=Format('Procedure %s(aRequest : TRequest; aResponse : TResponse);',
  782. [lMethodName]);
  783. if aclassName = '' then
  784. Result:=Result+' virtual;';
  785. end;
  786. function TServerCodeGen.GetMethodParameterDecl(aMethod: TAPIServiceMethod;
  787. aParam: TAPIServiceMethodParam): string;
  788. begin
  789. Result:=aParam.Name+': ';
  790. Result:=Result+aParam.TypeName;
  791. end;
  792. function TServerCodeGen.GetMethodArgs(aMethod: TAPIServiceMethod): string;
  793. var
  794. I: integer;
  795. begin
  796. Result:='';
  797. for I:=0 to aMethod.ParamCount-1 do
  798. begin
  799. if Result<>'' then
  800. Result:=Result+'; ';
  801. Result:=Result+GetMethodParameterDecl(aMethod, aMethod.Param[i]);
  802. end;
  803. if aMethod.RequestBodyDataType<>nil then
  804. begin
  805. if Result<>'' then
  806. Result:=Result+'; ';
  807. Result:=Result+'aBody : '+aMethod.RequestBodyDataType.PascalName;
  808. end;
  809. end;
  810. function TServerCodeGen.GetServerServiceMethodDecl(aMethod: TAPIServiceMethod; const aClassName: string): string;
  811. var
  812. lMethodArgs: string;
  813. lMethodName: string;
  814. lResultType: string;
  815. begin
  816. lMethodName:=aMethod.MethodName;
  817. if aClassName<>'' then
  818. lMethodName:=aClassName+'.'+lMethodName;
  819. lResultType:=aMethod.ResultDtoType;
  820. lMethodArgs:=GetMethodArgs(aMethod);
  821. if lResultType = '' then
  822. Result:=Format('procedure %s(%s);', [lMethodName, lMethodArgs])
  823. else
  824. Result:=Format('function %s(%s) : %s;', [lMethodName, lMethodArgs, lResultType]);
  825. end;
  826. procedure TServerCodeGen.GenerateServerServiceImplementationDecl(aService: TAPIService;
  827. aParentModule, aModuleName: string; isAbstract: boolean; isHandler: boolean);
  828. var
  829. lDecl: string;
  830. lMethod: TAPIServiceMethod;
  831. I: integer;
  832. begin
  833. Addln('%s = class(%s)', [aModuleName, aParentModule]);
  834. Addln('Public');
  835. Indent;
  836. if IsHandler then
  837. begin
  838. Addln('class Procedure RegisterAPIRoutes(aBaseURL : String; aUseStreaming : Boolean = False); override;');
  839. for I:=0 to aService.MethodCount-1 do
  840. begin
  841. lMethod:=aService.Methods[i];
  842. lDecl:=GetServerServiceHandleMethodDecl(lMethod, '');
  843. Addln(lDecl);
  844. end;
  845. end;
  846. AddLn('');
  847. for I:=0 to aService.MethodCount-1 do
  848. begin
  849. lMethod:=aService.Methods[i];
  850. lDecl:=GetServerServiceMethodDecl(lMethod, '');
  851. if isHandler then
  852. begin
  853. lDecl:=lDecl+' virtual;';
  854. if isAbstract then
  855. lDecl:=lDecl+' abstract;';
  856. end
  857. else
  858. lDecl:=lDecl+' override;';
  859. Addln(lDecl);
  860. end;
  861. undent;
  862. AddLn('end;');
  863. AddLn('');
  864. end;
  865. class function TServerModuleHandlerCodeGen.ConvertToRouteParams(const aPath: string): string;
  866. begin
  867. Result:=StringReplace(aPath, '{', ':', [rfReplaceAll]);
  868. Result:=StringReplace(Result, '}', '', [rfReplaceAll]);
  869. end;
  870. procedure TServerModuleHandlerCodeGen.GenerateRegisterAPIRoutes(aClassName: string; aService: TAPIService);
  871. const
  872. lRegisterCall = 'RegisterOpenAPIRoute(aBaseURL,''%s'',@%s,aUseStreaming);';
  873. var
  874. I: integer;
  875. lMethod: TAPIServiceMethod;
  876. lDecl, lEndPoint: string;
  877. begin
  878. Addln('class Procedure %s.RegisterAPIRoutes(aBaseURL : String; aUseStreaming : Boolean = False);', [aClassName]);
  879. Addln('begin');
  880. Indent;
  881. for I:=0 to aService.MethodCount-1 do
  882. begin
  883. lMethod:=aService.Methods[i];
  884. lDecl:=GetMethodHandleRequestName(lMethod, '');
  885. lEndPoint:=ConvertToRouteParams(lMethod.Path.PathComponent);
  886. Addln(lRegisterCall, [lEndPoint, lDecl]);
  887. end;
  888. Undent;
  889. Addln('end;');
  890. Addln('');
  891. end;
  892. procedure TServerModuleHandlerCodeGen.WriteConvertArgument(aMethod: TAPIServiceMethod;
  893. aParam: TAPIServiceMethodParam);
  894. const
  895. LocationNames: array[TParamLocation] of string =
  896. ('alQuery', 'alPath', 'alHeader', 'alCookie');
  897. var
  898. lDefault: string;
  899. lLocation: string;
  900. lLocalName: string;
  901. lParamName: string;
  902. begin
  903. lParamName:=aParam.OriginalName;
  904. lLocalName:='_'+aParam.Name;
  905. lDefault:=aParam.DefaultValue;
  906. if lDefault = '' then
  907. case aParam.ArgType of
  908. ptString: lDefault:='''''';
  909. ptInteger: lDefault:='0';
  910. ptInt64: lDefault:='Int64(0)';
  911. ptDateTime: lDefault:='TDateTime(0.0)';
  912. ptFloat32: lDefault:='0.0';
  913. ptFloat64: lDefault:='0.0';
  914. end;
  915. lLocation:=LocationNames[aParam.Location];
  916. AddLn('%s:=ExtractRequestArgument(aRequest,%s,''%s'',%s);',
  917. [lLocalName, lLocation, lParamName, lDefault]);
  918. end;
  919. procedure TServerModuleHandlerCodeGen.GenerateServerServiceHandleMethodImpl(lMethod: TAPIserviceMethod; const aClassName: string);
  920. var
  921. lResultType: string;
  922. lCallArgs: string;
  923. i: integer;
  924. procedure AddToArgs(aName: string);
  925. begin
  926. if lCallArgs<>'' then
  927. lCallargs:=lCallArgs+';';
  928. lCallargs:=lCallArgs+aName;
  929. end;
  930. begin
  931. AddLn(GetServerServiceHandleMethodDecl(lMethod, aClassName));
  932. lResultType:=lMethod.ResultDtoType;
  933. Addln('');
  934. Addln('var');
  935. indent;
  936. Addln('lResult : %s;', [lResultType]);
  937. for I:=0 to lMethod.ParamCount-1 do
  938. begin
  939. Addln('_%s;', [GetMethodParameterDecl(lMethod, lMethod.Param[i])]);
  940. AddToArgs('_'+lMethod.Param[I].Name);
  941. end;
  942. if lMethod.RequestBodyDataType<>nil then
  943. begin
  944. Addln('_Body : %s;', [lMethod.RequestBodyDataType.PascalName]);
  945. AddToArgs('_lBody');
  946. end;
  947. undent;
  948. Addln('');
  949. Addln('begin');
  950. indent;
  951. Addln('lResult:=Default(%s);', [lResultType]);
  952. Addln('try');
  953. Indent;
  954. Addln('if PrepareRequest(aRequest,aResponse) then');
  955. Indent;
  956. Addln('begin');
  957. if lResultType<>'' then
  958. begin
  959. for I:=0 to lMethod.ParamCount-1 do
  960. WriteConvertArgument(lMethod, lMethod.Param[i]);
  961. if lMethod.RequestBodyDataType<>nil then
  962. AddLn('_lBody:=%s.Deserialize;', [lMethod.RequestBodyDataType.PascalName]);
  963. Addln('lResult:=%s(%s);', [lMethod.MethodName, lCallArgs]);
  964. if WriteClassType then
  965. begin
  966. Addln('try');
  967. Indent;
  968. Addln('aResponse.Content:=lResult.Serialize;');
  969. end;
  970. end
  971. else
  972. Addln('%s;', [lMethod.MethodName]);
  973. if (lResultType<>'') and WriteClassType then
  974. begin
  975. Undent;
  976. Addln('finally');
  977. Indent;
  978. Addln('FreeAndNil(lResult);');
  979. Undent;
  980. Addln('end;'); // Finally
  981. end;
  982. Addln('end;'); // if PrepareRequest
  983. Undent;
  984. Addln('ProcessResponse(aRequest,aResponse);');
  985. Undent;
  986. Addln('except');
  987. Indent;
  988. Addln('on E : Exception do');
  989. Indent;
  990. Addln('HandleRequestError(E,aRequest,aResponse);');
  991. Undent;
  992. Undent;
  993. Addln('end;'); // except
  994. undent;
  995. Addln('end;'); // handlerequest
  996. Addln('');
  997. end;
  998. procedure TServerCodeGen.GenerateServerServiceMethodImpl(lMethod: TAPIserviceMethod; const aClassName: string);
  999. var
  1000. lResultType, lDecl: string;
  1001. begin
  1002. lDecl:=GetServerServiceMethodDecl(lMethod, aClassName);
  1003. lResultType:=lMethod.ResultDtoType;
  1004. AddLn(lDecl);
  1005. Addln('');
  1006. Addln('begin');
  1007. Indent;
  1008. AddLn('Result:=Default(%s);', [lResultType]);
  1009. Undent;
  1010. Addln('end;');
  1011. Addln('');
  1012. end;
  1013. procedure TServerCodeGen.GenerateServerServiceImplementationImpl(aService: TAPIService; const aModuleName: string; isAbstract: boolean);
  1014. var
  1015. lMethod: TAPIServiceMethod;
  1016. I: integer;
  1017. begin
  1018. AddLn('');
  1019. if not IsAbstract then
  1020. begin
  1021. for I:=0 to aService.MethodCount-1 do
  1022. begin
  1023. lMethod:=aService.Methods[i];
  1024. GenerateServerServiceMethodImpl(lMethod, aModuleName);
  1025. end;
  1026. AddLn('');
  1027. end;
  1028. end;
  1029. function TServerModuleHandlerCodeGen.GetModuleParentCLass: string;
  1030. begin
  1031. Result:=FModuleParentClass;
  1032. if Result = '' then
  1033. Result:='TFPOpenAPIModule';
  1034. end;
  1035. function TServerCodeGen.GetModuleParentUnit: string;
  1036. begin
  1037. Result:=FModuleParentUnit;
  1038. if Result = '' then
  1039. Result:='fpopenapimodule';
  1040. end;
  1041. procedure TServerModuleHandlerCodeGen.GenerateServerServiceImplementationImpl(aService: TAPIService; const aModuleName: string; IsAbstract: boolean);
  1042. var
  1043. I: integer;
  1044. lMethod: TAPIServiceMethod;
  1045. begin
  1046. GenerateRegisterAPIRoutes(aModuleName, aService);
  1047. for I:=0 to aService.MethodCount-1 do
  1048. begin
  1049. lMethod:=aService.Methods[i];
  1050. GenerateServerServiceHandleMethodImpl(lMethod, aModuleName);
  1051. end;
  1052. inherited GenerateServerServiceImplementationImpl(aService, aModuleName, isAbstract);
  1053. end;
  1054. procedure TServerModuleHandlerCodeGen.Execute(aData: TAPIData);
  1055. var
  1056. I: integer;
  1057. lService: TAPIService;
  1058. lName: string;
  1059. begin
  1060. SetTypeData(aData);
  1061. GenerateHeader;
  1062. GenerateFPCDirectives();
  1063. Addln('unit %s;', [Self.OutputUnitName]);
  1064. Addln('');
  1065. if AsyncService then
  1066. GenerateFPCDirectives();
  1067. Addln('interface');
  1068. Addln('');
  1069. Addln('uses');
  1070. indent;
  1071. AddLn('%s, httpprotocol, httpdefs, fphttpapp, httproute, %s;',
  1072. [ModuleParentUnit, DtoUnit]);
  1073. undent;
  1074. Addln('');
  1075. EnsureSection(csType);
  1076. indent;
  1077. for I:=0 to aData.ServiceCount-1 do
  1078. begin
  1079. lService:=aData.Services[I];
  1080. if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
  1081. begin
  1082. if AbstractServiceCalls then
  1083. lName:='TAbstract'+lService.ServiceName+'Module'
  1084. else
  1085. lName:='T'+lService.ServiceName+'Module';
  1086. GenerateServerServiceImplementationDecl(
  1087. lService, ModuleParentClass, lName, AbstractServiceCalls, True);
  1088. end;
  1089. end;
  1090. undent;
  1091. Addln('');
  1092. Addln('implementation');
  1093. Addln('');
  1094. Addln('uses');
  1095. indent;
  1096. if DelphiCode then
  1097. Addln('System.SysUtils')
  1098. else
  1099. Addln('SysUtils');
  1100. Addln(', %s;', [SerializerUnit]);
  1101. undent;
  1102. Addln('');
  1103. for I:=0 to aData.ServiceCount-1 do
  1104. begin
  1105. lService:=aData.Services[I];
  1106. if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
  1107. begin
  1108. if AbstractServiceCalls then
  1109. lName:='TAbstract'+lService.ServiceName+'Module'
  1110. else
  1111. lName:='T'+lService.ServiceName+'Module';
  1112. GenerateServerServiceImplementationImpl(lService, lName, AbstractServiceCalls);
  1113. end;
  1114. end;
  1115. Addln('');
  1116. Addln('end.');
  1117. end;
  1118. { TServerImplementationModuleCodeGen }
  1119. procedure TServerImplementationModuleCodeGen.Execute(aData: TAPIData);
  1120. var
  1121. I: integer;
  1122. lService: TAPIService;
  1123. lName, lParentName: string;
  1124. begin
  1125. SetTypeData(aData);
  1126. GenerateHeader;
  1127. GenerateFPCDirectives();
  1128. Addln('unit %s;', [Self.OutputUnitName]);
  1129. Addln('');
  1130. if AsyncService then
  1131. GenerateFPCDirectives();
  1132. Addln('interface');
  1133. Addln('');
  1134. Addln('uses');
  1135. indent;
  1136. AddLn('%s, %s;', [ModuleParentUnit, DtoUnit]);
  1137. undent;
  1138. Addln('');
  1139. EnsureSection(csType);
  1140. indent;
  1141. for I:=0 to aData.ServiceCount-1 do
  1142. begin
  1143. lService:=aData.Services[I];
  1144. if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
  1145. begin
  1146. lName:='T'+lService.ServiceName+'Module';
  1147. lParentName:='TAbstract'+lService.ServiceName+'Module';
  1148. GenerateServerServiceImplementationDecl(lService, lParentName, lName, False, False);
  1149. end;
  1150. end;
  1151. undent;
  1152. Addln('');
  1153. Addln('implementation');
  1154. Addln('');
  1155. Addln('uses');
  1156. indent;
  1157. if DelphiCode then
  1158. Addln('System.SysUtils')
  1159. else
  1160. Addln('SysUtils');
  1161. Addln(', %s;', [SerializerUnit]);
  1162. undent;
  1163. Addln('');
  1164. for I:=0 to aData.ServiceCount-1 do
  1165. begin
  1166. lService:=aData.Services[I];
  1167. if (Self.ServiceName = '') or SameText(lService.ServiceName, Self.ServiceName) then
  1168. begin
  1169. lName:='T'+lService.ServiceName+'Module';
  1170. GenerateServerServiceImplementationImpl(lService, lName, False);
  1171. end;
  1172. end;
  1173. Addln('');
  1174. Addln('end.');
  1175. end;
  1176. { TServerServiceModule }
  1177. function TServerProxyServiceModuleCodeGen.GetProxyVarName: String;
  1178. begin
  1179. Result:=FProxyVarName;
  1180. if Result='' then
  1181. Result:=Copy(ProxyClassName,2,Length(ProxyClassName)-1);
  1182. end;
  1183. procedure TServerProxyServiceModuleCodeGen.SetProxyClassName(const aValue: string);
  1184. begin
  1185. if FProxyClassName=aValue then Exit;
  1186. FProxyClassName:=aValue;
  1187. CheckDefaults;
  1188. end;
  1189. constructor TServerProxyServiceModuleCodeGen.Create(AOwner: TComponent);
  1190. begin
  1191. inherited Create(AOwner);
  1192. FForm:=TStringList.Create;
  1193. CheckDefaults;
  1194. end;
  1195. destructor TServerProxyServiceModuleCodeGen.Destroy;
  1196. begin
  1197. FreeAndNil(FForm);
  1198. inherited Destroy;
  1199. end;
  1200. procedure TServerProxyServiceModuleCodeGen.CheckDefaults;
  1201. begin
  1202. if FProxyClassName='' then
  1203. FProxyClassName:=DefaultServerProxyName;
  1204. if FProxyParentClass='' then
  1205. FProxyParentClass:=DefaultServerProxyParent;
  1206. if FProxyParentUnit='' then
  1207. FProxyParentUnit:=DefaultServerProxyParentUnit;
  1208. end;
  1209. procedure TServerProxyServiceModuleCodeGen.GenerateModule;
  1210. var
  1211. I: integer;
  1212. lClass,lUnits : String;
  1213. lService: TAPIService;
  1214. begin
  1215. GenerateFPCDirectives();
  1216. CheckDefaults;
  1217. Addln('unit %s;', [Self.OutputUnitName]);
  1218. Addln('');
  1219. Addln('interface');
  1220. Addln('');
  1221. Addln('uses');
  1222. indent;
  1223. lUnits:=ServiceInterfaceUnit+', '+ServiceImplementationUnit;
  1224. if not (SameText(ProxyParentUnit,'Classes') or SameText(ProxyParentUnit,'System.Classes')) then
  1225. if DelphiCode then
  1226. lUnits:='System.Classes, '+lUnits
  1227. else
  1228. lUnits:='Classes, fpWebClient, '+lUnits;
  1229. AddLn('%s, %s;', [ProxyParentUnit, lUnits]);
  1230. undent;
  1231. Addln('');
  1232. EnsureSection(csType);
  1233. indent;
  1234. Addln('%s = class(%s)',[ProxyClassName,ProxyParentClass]);
  1235. Addln('private');
  1236. indent;
  1237. Addln('FWebClient : TAbstractWebClient;');
  1238. Addln('FBaseURL : TAbstractWebClient;');
  1239. for I:=0 to APIData.ServiceCount-1 do
  1240. begin
  1241. lService:=APIData.Services[I];
  1242. lClass:=lService.ServiceProxyImplementationClassName;
  1243. Addln('F%s : %s;',[lService.ServiceName,lClass]);
  1244. end;
  1245. if UseInterfaceType then
  1246. for I:=0 to APIData.ServiceCount-1 do
  1247. begin
  1248. lService:=APIData.Services[I];
  1249. lClass:=lService.ServiceProxyImplementationClassName;
  1250. Addln('function Get%s : %s;',[lService.ServiceName,lService.ServiceInterfaceName]);
  1251. end;
  1252. Addln('Procedure SetBaseURL(const aValue : string);');
  1253. undent;
  1254. Addln('protected');
  1255. indent;
  1256. Addln('Procedure CreateServices; virtual;');
  1257. undent;
  1258. Addln('public');
  1259. indent;
  1260. Addln('constructor Create(aOwner : TComponent); override;');
  1261. for I:=0 to APIData.ServiceCount-1 do
  1262. begin
  1263. lService:=APIData.Services[I];
  1264. if UseInterfaceType then
  1265. Addln('Property %s : %s read Get%s;',[lService.ServiceName,lService.ServiceInterfaceName,lService.ServiceName])
  1266. else
  1267. Addln('Property %s : %s read F%s;',[lService.ServiceName,lService.ServiceProxyImplementationClassName,lService.ServiceName]);
  1268. end;
  1269. Addln('Property BaseURL : String Read FBaseURL Write SetBaseURL;',[lService.ServiceName,lService.ServiceInterfaceName,lService.ServiceName]);
  1270. undent;
  1271. Addln('end;');
  1272. undent;
  1273. Addln('');
  1274. if FormFile then
  1275. begin
  1276. Addln('var %s : %s;',[ProxyVarName,ProxyClassName]);
  1277. Addln('');
  1278. end;
  1279. Addln('implementation');
  1280. Addln('');
  1281. Addln('uses');
  1282. indent;
  1283. if DelphiCode then
  1284. Addln('System.SysUtils;')
  1285. else
  1286. Addln('SysUtils;');
  1287. undent;
  1288. if FormFile then
  1289. begin
  1290. Addln('');
  1291. Addln('{$R *.lfm}');
  1292. end;
  1293. Addln('');
  1294. Addln('constructor %s.Create(aOwner : TComponent);',[ProxyClassName]);
  1295. Addln('');
  1296. Addln('begin');
  1297. indent;
  1298. Addln('Inherited;');
  1299. Addln('FWebClient:=DefaultWebClientClass.Create(Self);');
  1300. Addln('CreateServices;');
  1301. undent;
  1302. Addln('end;');
  1303. Addln('');
  1304. Addln('');
  1305. Addln('procedure %s.CreateServices;',[ProxyClassName]);
  1306. Addln('');
  1307. Addln('begin');
  1308. Indent;
  1309. for I:=0 to APIData.ServiceCount-1 do
  1310. begin
  1311. lService:=APIData.Services[I];
  1312. lClass:=lService.ServiceProxyImplementationClassName;
  1313. Addln('F%s:=%s.create(Self);',[lService.ServiceName,lClass]);
  1314. Addln('%s(F%s).WebClient:=FWebClient',[lClass,lService.ServiceName]);
  1315. end;
  1316. undent;
  1317. Addln('end;');
  1318. Addln('');
  1319. Addln('');
  1320. Addln('Procedure %s.SetBaseURL(const aValue : string);',[ProxyClassName]);
  1321. Addln('');
  1322. Addln('begin');
  1323. Indent;
  1324. Addln('FBaseURL:=aValue;');
  1325. for I:=0 to APIData.ServiceCount-1 do
  1326. begin
  1327. lService:=APIData.Services[I];
  1328. Addln('F%s.BaseURL:=aValue;',[lService.ServiceName]);
  1329. end;
  1330. undent;
  1331. Addln('end;');
  1332. Addln('');
  1333. Addln('');
  1334. for I:=0 to APIData.ServiceCount-1 do
  1335. begin
  1336. lService:=APIData.Services[I];
  1337. lClass:=lService.ServiceProxyImplementationClassName;
  1338. Addln('function %s.Get%s : %s;',[ProxyClassName,lService.ServiceName,lService.ServiceInterfaceName]);
  1339. Addln('');
  1340. Addln('begin');
  1341. Indent;
  1342. Addln('Result:=F%s;',[lService.ServiceName]);
  1343. Undent;
  1344. Addln('end;');
  1345. Addln('');
  1346. Addln('');
  1347. end;
  1348. Addln('');
  1349. Addln('end.');
  1350. end;
  1351. procedure TServerProxyServiceModuleCodeGen.GenerateFormFile;
  1352. begin
  1353. With FForm Do
  1354. begin
  1355. Add('object %s: %s',[ProxyVarName,ProxyClassName]);
  1356. Add(' OldCreateOrder = False');
  1357. Add(' Height = 150');
  1358. Add(' HorizontalOffset = 547');
  1359. Add(' VerticalOffset = 323');
  1360. Add(' Width = 150');
  1361. Add('end');
  1362. end;
  1363. end;
  1364. procedure TServerProxyServiceModuleCodeGen.Execute(aData: TAPIData);
  1365. begin
  1366. SetTypeData(aData);
  1367. GenerateModule;
  1368. if FFormFile then
  1369. GenerateFormFile;
  1370. end;
  1371. end.