2
0

sqldbrestschema.pp 45 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2019 by the Free Pascal development team
  4. SQLDB REST bridge : REST Schema.
  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 sqldbrestschema;
  12. {$mode objfpc}
  13. {$H+}
  14. {$modeswitch typehelpers}
  15. {$modeswitch advancedrecords}
  16. interface
  17. uses
  18. Classes, SysUtils, contnrs, db, sqldb, fpjson;
  19. Type
  20. TRestFieldType = (rftUnknown,rftInteger,rftLargeInt,rftFloat,rftDate,rftTime,rftDateTime,rftString,rftBoolean,rftBlob);
  21. TRestFieldTypes = set of TRestFieldType;
  22. TRestFieldOption = (foInKey,foInInsert, foInUpdate,foRequired,foFilter,foOrderBy,foOrderByDesc);
  23. TRestFieldOptions = Set of TRestFieldOption;
  24. TRestFieldFilter = (rfEqual,rfLessThan,rfGreaterThan,rfLessThanEqual,rfGreaterThanEqual,rfNull);
  25. TRestFieldFilters = set of TRestFieldFilter;
  26. TSQLKind = (skSelect,skInsert,skUpdate,skDelete); // Must follow Index used below.
  27. TSQLKinds = set of TSQLKind;
  28. TRestOperation = (roUnknown,roGet,roPost,roPut,roDelete,roOptions,roHead,roPatch);
  29. TRestOperations = Set of TRestOperation;
  30. TFieldListKind = (flSelect,flInsert,flInsertParams,flUpdate,flWhereKey,flFilter,flOrderby);
  31. TFieldListKinds = set of TFieldListKind;
  32. TVariableSource = (vsNone,vsQuery,vsContent,vsRoute,vsHeader,vsData);
  33. TVariableSources = Set of TVariableSource;
  34. Const
  35. AllRestOperations = [Succ(Low(TRestOperation))..High(TRestOperation)];
  36. AllFieldFilters = [Low(TRestFieldFilter)..High(TRestFieldFilter)];
  37. JSONSchemaRoot = 'schema';
  38. JSONResourcesRoot = 'resources';
  39. JSONConnectionsRoot = 'connections';
  40. JSONConnectionName = 'connectionName';
  41. Type
  42. { TBaseRestContext }
  43. TBaseRestContext = Class(TObject)
  44. private
  45. FData: TObject;
  46. FUserID: UTF8String;
  47. FFreeList : TFPObjectList;
  48. Protected
  49. Procedure AddToFreeList(aData : TJSONData);
  50. // The result of this function will be freed.
  51. function DoGetInputData(aName: UTF8string): TJSONData; virtual; abstract;
  52. Function GetConnection : TSQLConnection; virtual; abstract;
  53. Function GetTransaction : TSQLTransaction; virtual; abstract;
  54. Public
  55. Destructor Destroy; override;
  56. // Call this to get a HTTP Query variable, header,...
  57. Function GetVariable(Const aName : UTF8String; aSources : TVariableSources; Out aValue : UTF8String) : Boolean; virtual; abstract;
  58. // Get data from input data. Do not free the result !
  59. Function GetInputData(aName : UTF8string) : TJSONData;
  60. // This will be set when calling.
  61. Property UserID : UTF8String Read FUserID Write FUserID;
  62. // You can attach data to this if you want to. It will be kept for the duration of the request.
  63. // You are responsible for freeing this data, though.
  64. Property Data : TObject Read FData Write FData;
  65. // Get connection in use
  66. Property Connection : TSQLConnection Read GetConnection;
  67. // Get transaction in use
  68. Property Transaction : TSQLTransaction Read GetTransaction;
  69. end;
  70. { ESQLDBRest }
  71. ESQLDBRest = Class(Exception)
  72. private
  73. FResponseCode: Integer;
  74. Public
  75. Constructor Create(aCode : Integer; Const aMessage : String);
  76. Constructor CreateFmt(aCode : Integer; Const Fmt : String; COnst Args: Array of const);
  77. Property ResponseCode : Integer Read FResponseCode Write FResponseCode;
  78. end;
  79. TRestSQLQuery = Class(TSQLQuery)
  80. Public
  81. Property TableName;
  82. end;
  83. TSQLDBRestSchema = Class;
  84. TSQLDBRestCustomBusinessProcessor = Class;
  85. TSQLDBRestBusinessProcessor = Class;
  86. { TSQLDBRestField }
  87. TSQLDBRestField = class(TCollectionItem)
  88. private
  89. FFieldName: UTF8String;
  90. FFieldType: TRestFieldType;
  91. FFilters: TRestFieldFilters;
  92. fGeneratorName: String;
  93. FMaxLen: Integer;
  94. FNativeFieldType: TFieldType;
  95. FOptions: TRestFieldOptions;
  96. FPublicName: UTF8String;
  97. function GetPublicName: UTF8String;
  98. Protected
  99. Function GetDisplayName: string; override;
  100. Public
  101. Constructor Create(ACollection: TCollection); override;
  102. Procedure Assign(Source: TPersistent); override;
  103. Function UseInFieldList(aListKind : TFieldListKind) : Boolean; virtual;
  104. Published
  105. Property FieldName : UTF8String Read FFieldName Write FFieldName;
  106. Property PublicName : UTF8String Read GetPublicName Write FPublicName;
  107. Property GeneratorName : String Read fGeneratorName Write FGeneratorName;
  108. Property FieldType : TRestFieldType Read FFieldType Write FFieldType;
  109. Property NativeFieldType : TFieldType Read FNativeFieldType Write FNativeFieldType;
  110. Property Options : TRestFieldOptions Read FOptions Write FOptions;
  111. Property Filters : TRestFieldFilters Read FFilters Write FFilters default AllFieldFilters;
  112. Property MaxLen : Integer Read FMaxLen Write FMaxLen;
  113. end;
  114. TSQLDBRestFieldClass = Class of TSQLDBRestField;
  115. TSQLDBRestFieldArray = Array of TSQLDBRestField;
  116. { TSQLDBRestFieldArrayHelper }
  117. TSQLDBRestFieldArrayHelper = type helper for TSQLDBRestFieldArray
  118. Function IndexOf(aField : TSQLDBRestField) : Integer;
  119. Function Has(aField : TSQLDBRestField) : Boolean;
  120. end;
  121. TRestFieldPair = Record
  122. DBField : TField;
  123. RestField :TSQLDBRestField;
  124. end;
  125. TRestFieldPairArray = Array of TRestFieldPair;
  126. TRestFieldOrderPair = Record
  127. RestField :TSQLDBRestField;
  128. Desc : Boolean;
  129. end;
  130. TRestFieldOrderPairArray = Array of TRestFieldOrderPair;
  131. { TSQLDBRestFieldList }
  132. { TSQLDBRestFieldListEnumerator }
  133. TSQLDBRestFieldListEnumerator = Class(TCollectionEnumerator)
  134. Public
  135. function GetCurrent: TSQLDBRestField; reintroduce;
  136. property Current: TSQLDBRestField read GetCurrent;
  137. end;
  138. TSQLDBRestFieldList = class(TCollection)
  139. private
  140. function GetFields(aIndex : Integer): TSQLDBRestField;
  141. procedure SetFields(aIndex : Integer; AValue: TSQLDBRestField);
  142. Public
  143. Function GetEnumerator: TSQLDBRestFieldListEnumerator;
  144. Function AddField(Const aFieldName : UTF8String; aFieldType : TRestFieldType; aOptions : TRestFieldOptions) : TSQLDBRestField;
  145. function indexOfFieldName(const aFieldName: UTF8String): Integer;
  146. Function FindByFieldName(const aFieldName: UTF8String):TSQLDBRestField;
  147. function indexOfPublicName(const aPublicName: UTF8String): Integer;
  148. Function FindByPublicName(const aFieldName: UTF8String):TSQLDBRestField;
  149. Property Fields[aIndex : Integer] : TSQLDBRestField read GetFields write SetFields; default;
  150. end;
  151. TSQLDBRestFieldListClass = Class of TSQLDBRestFieldList;
  152. { TSQLDBRestResource }
  153. TSQLDBRestGetDatasetEvent = Procedure (aSender : TObject; aContext : TBaseRestContext; aFieldList : TRestFieldPairArray; aOrderBy : TRestFieldOrderPairArray; aLimit, aOffset : Int64; Var aDataset : TDataset) of object;
  154. TSQLDBRestCheckParamsEvent = Procedure (aSender : TObject; aContext : TBaseRestContext; aOperation : TRestOperation; Params : TParams) of object;
  155. TSQLDBRestAllowRecordEvent = Procedure (aSender : TObject; aContext : TBaseRestContext; aDataSet : TDataset; var allowRecord : Boolean) of object;
  156. TSQLDBRestAllowResourceEvent = Procedure (aSender : TObject; aContext : TBaseRestContext; var allowResource : Boolean) of object;
  157. TSQLDBRestAllowedOperationsEvent = Procedure (aSender : TObject; aContext : TBaseRestContext; var aOperations : TRestOperations) of object;
  158. TProcessIdentifier = Function (const S: UTF8String): UTF8String of object;
  159. TSQLDBRestResource = class(TCollectionItem)
  160. private
  161. FBusinessProcessor: TSQLDBRestCustomBusinessProcessor;
  162. FAllowedOperations: TRestOperations;
  163. FConnectionName: UTF8String;
  164. FEnabled: Boolean;
  165. FFields: TSQLDBRestFieldList;
  166. FInMetadata: Boolean;
  167. FOnAllowedOperations: TSQLDBRestAllowedOperationsEvent;
  168. FOnAllowRecord: TSQLDBRestAllowRecordEvent;
  169. FOnCheckParams: TSQLDBRestCheckParamsEvent;
  170. FOnGetDataset: TSQLDBRestGetDatasetEvent;
  171. FOnResourceAllowed: TSQLDBRestAllowResourceEvent;
  172. FResourceName: UTF8String;
  173. FTableName: UTF8String;
  174. FSQL : Array[TSQLKind] of TStrings;
  175. function GetResourceName: UTF8String;
  176. function GetSQL(AIndex: Integer): TStrings;
  177. function GetSQLTyped(aKind : TSQLKind): TStrings;
  178. procedure SetAllowedOperations(AValue: TRestOperations);
  179. procedure SetFields(AValue: TSQLDBRestFieldList);
  180. procedure SetSQL(AIndex: Integer; AValue: TStrings);
  181. Protected
  182. Function GetDisplayName: string; override;
  183. Public
  184. Class var
  185. DefaultFieldListClass : TSQLDBRestFieldListClass;
  186. DefaultFieldClass: TSQLDBRestFieldClass;
  187. Class function CreateFieldList : TSQLDBRestFieldList; virtual;
  188. Class function FieldTypeToRestFieldType(aFieldType: TFieldType): TRestFieldType; virtual;
  189. Public
  190. Constructor Create(ACollection: TCollection); override;
  191. Destructor Destroy; override;
  192. Procedure CheckParams(aContext : TBaseRestContext; aOperation : TRestoperation; P : TParams);
  193. Function GetDataset(aContext : TBaseRestContext; aFieldList : TRestFieldPairArray; aOrderBy : TRestFieldOrderPairArray; aLimit, aOffset : Int64) : TDataset;
  194. Function GetSchema : TSQLDBRestSchema;
  195. function GenerateDefaultSQL(aKind: TSQLKind; OnlyFields: TSQLDBRestFieldArray = nil): UTF8String; virtual;
  196. Procedure Assign(Source: TPersistent); override;
  197. Function AllowRecord(aContext : TBaseRestContext; aDataset : TDataset) : Boolean;
  198. Function AllowResource(aContext : TBaseRestContext) : Boolean;
  199. Function GetAllowedOperations(aContext : TBaseRestContext) : TRestOperations;
  200. Function GetHTTPAllow : String; virtual;
  201. function GetFieldList(aListKind: TFieldListKind; ASep : String = ''; OnlyFields : TSQLDBRestFieldArray = Nil): UTF8String;
  202. function GetFieldArray(aListKind: TFieldListKind): TSQLDBRestFieldArray;
  203. Function GetResolvedSQl(aKind : TSQLKind; Const AWhere : UTF8String; Const aOrderBy : UTF8String = ''; aLimit : UTF8String = ''; OnlyFields : TSQLDBRestFieldArray = nil) : UTF8String;
  204. Function ProcessSQl(aSQL : String; Const AWhere : UTF8String; Const aOrderBy : UTF8String = ''; aLimit : UTF8String = '') : UTF8String;
  205. Procedure PopulateFieldsFromFieldDefs(Defs : TFieldDefs; aIndexFields : TStringArray; aProcessIdentifier : TProcessIdentifier; aMinFieldOpts : TRestFieldOptions);
  206. Property SQL [aKind : TSQLKind] : TStrings Read GetSQLTyped;
  207. Property BusinessProcessor : TSQLDBRestCustomBusinessProcessor Read FBusinessProcessor;
  208. Published
  209. Property Fields : TSQLDBRestFieldList Read FFields Write SetFields;
  210. Property Enabled : Boolean Read FEnabled Write FEnabled default true;
  211. Property InMetadata : Boolean Read FInMetadata Write FInMetadata default true;
  212. Property ConnectionName : UTF8String read FConnectionName Write FConnectionName;
  213. Property TableName : UTF8String read FTableName Write FTableName;
  214. Property ResourceName : UTF8String read GetResourceName Write FResourceName;
  215. Property AllowedOperations : TRestOperations Read FAllowedOperations Write SetAllowedOperations;
  216. Property SQLSelect : TStrings Index 0 Read GetSQL Write SetSQL;
  217. Property SQLInsert : TStrings Index 1 Read GetSQL Write SetSQL;
  218. Property SQLUpdate : TStrings Index 2 Read GetSQL Write SetSQL;
  219. Property SQLDelete : TStrings Index 3 Read GetSQL Write SetSQL;
  220. Property OnResourceAllowed : TSQLDBRestAllowResourceEvent Read FOnResourceAllowed Write FOnResourceAllowed;
  221. Property OnAllowedOperations : TSQLDBRestAllowedOperationsEvent Read FOnAllowedOperations Write FOnAllowedOperations;
  222. Property OnGetDataset : TSQLDBRestGetDatasetEvent Read FOnGetDataset Write FOnGetDataset;
  223. Property OnCheckParams : TSQLDBRestCheckParamsEvent Read FOnCheckParams Write FOnCheckParams;
  224. Property OnAllowRecord : TSQLDBRestAllowRecordEvent Read FOnAllowRecord Write FOnAllowRecord;
  225. end;
  226. { TSQLDBRestResourceList }
  227. TSQLDBRestResourceList = Class(TOwnedCollection)
  228. private
  229. function GetResource(aIndex : Integer): TSQLDBRestResource;
  230. procedure SetResource(aIndex : Integer; AValue: TSQLDBRestResource);
  231. Public
  232. Function Schema : TSQLDBRestSchema;
  233. Function AddResource(Const aTableName : UTF8String; Const aResourceName : UTF8String) : TSQLDBRestResource;
  234. Function indexOfTableName(Const aTableName : UTF8String) : Integer;
  235. Function indexOfResourceName(Const aResourceName : UTF8String) : Integer;
  236. Function FindResourceByName(Const aResourceName : UTF8String) : TSQLDBRestResource;
  237. Function FindResourceByTableName(Const aTableName : UTF8String) : TSQLDBRestResource;
  238. Procedure SaveToFile(Const aFileName : UTF8String);
  239. Procedure SaveToStream(Const aStream : TStream);
  240. function AsJSON(const aPropName: UTF8String=''): TJSONData;
  241. Procedure LoadFromFile(Const aFileName : UTF8String);
  242. Procedure LoadFromStream(Const aStream : TStream);
  243. Procedure FromJSON(aData: TJSONData;const aPropName: UTF8String='');
  244. Property Resources[aIndex : Integer] : TSQLDBRestResource read GetResource write SetResource; default;
  245. end;
  246. { TSQLDBRestSchema }
  247. TSQLDBRestSchema = Class(TComponent)
  248. private
  249. FConnectionName: UTF8String;
  250. FResources: TSQLDBRestResourceList;
  251. FProcessors : TFPList;
  252. procedure SetResources(AValue: TSQLDBRestResourceList);
  253. Protected
  254. function CreateResourceList: TSQLDBRestResourceList; virtual;
  255. function ProcessIdentifier(const S: UTF8String): UTF8String; virtual;
  256. Function AttachProcessor(aProcessor : TSQLDBRestCustomBusinessProcessor) : Boolean; Virtual;
  257. Function DetachProcessor(aProcessor : TSQLDBRestCustomBusinessProcessor) : Boolean; Virtual;
  258. Procedure AttachAllProcessors; virtual;
  259. Procedure DetachAllProcessors; virtual;
  260. Public
  261. Constructor Create(AOwner: TComponent); override;
  262. Destructor Destroy; override;
  263. Procedure RemoveBusinessProcessor(aProcessor : TSQLDBRestCustomBusinessProcessor);
  264. Procedure AddBusinessProcessor(aProcessor : TSQLDBRestCustomBusinessProcessor);
  265. Procedure SaveToFile(Const aFileName : UTF8String);
  266. Procedure SaveToStream(Const aStream : TStream);
  267. function AsJSON(const aPropName: UTF8String=''): TJSONData;
  268. Procedure LoadFromFile(Const aFileName : UTF8String);
  269. Procedure LoadFromStream(Const aStream : TStream);
  270. Procedure FromJSON(aData: TJSONData;const aPropName: UTF8String='');
  271. Class function GetPrimaryIndexFields(Q: TSQLQuery): TStringArray; virtual;
  272. procedure PopulateResourceFields(aConn: TSQLConnection; aRes: TSQLDBRestResource; aMinFieldOpts : TRestFieldOptions = []); virtual;
  273. procedure PopulateResources(aConn: TSQLConnection; aTables: array of string; aMinFieldOpts: TRestFieldOptions= []);
  274. Procedure PopulateResources(aConn : TSQLConnection; aTables : TStrings = Nil; aMinFieldOpts : TRestFieldOptions = []);
  275. Published
  276. Property Resources : TSQLDBRestResourceList Read FResources Write SetResources;
  277. Property ConnectionName : UTF8String Read FConnectionName Write FConnectionName;
  278. end;
  279. TCustomViewResource = Class(TSQLDBRestResource)
  280. end;
  281. { TSQLDBRestCustomBusinessProcessor }
  282. TSQLDBRestCustomBusinessProcessor = Class(TComponent)
  283. private
  284. FResource: TSQLDBRestResource;
  285. FResourceName: UTF8String;
  286. procedure SetResourceName(AValue: UTF8String);
  287. Protected
  288. Function GetSchema : TSQLDBRestSchema; virtual;
  289. Function GetAllowedOperations(aContext : TBaseRestContext; aDefault : TRestOperations) : TRestOperations; virtual; abstract;
  290. Function AllowResource(aContext : TBaseRestContext) : Boolean; virtual; abstract;
  291. Procedure CheckParams(aContext : TBaseRestContext; aOperation : TRestoperation; P : TParams); virtual; abstract;
  292. Function GetDataset(aContext : TBaseRestContext; aFieldList : TRestFieldPairArray; aOrderBy : TRestFieldOrderPairArray; aLimit, aOffset : Int64) : TDataset; virtual;abstract;
  293. Function AllowRecord(aContext : TBaseRestContext;aDataset : TDataset) : Boolean; virtual; abstract;
  294. Public
  295. Property Resource : TSQLDBRestResource Read FResource;
  296. Property ResourceName : UTF8String Read FResourceName Write SetResourceName;
  297. end;
  298. { TSQLDBRestBusinessProcessor }
  299. TOnGetHTTPAllow = Procedure(Sender : TObject; Var aHTTPAllow) of object;
  300. TRestDatabaseEvent = Procedure(Sender : TObject; aOperation : TRestOperation; aContext: TBaseRestContext; aResource : TSQLDBRestResource) of object;
  301. TSQLDBRestBusinessProcessor = class(TSQLDBRestCustomBusinessProcessor)
  302. private
  303. FOnAllowedOperations: TSQLDBRestAllowedOperationsEvent;
  304. FOnAllowRecord: TSQLDBRestAllowRecordEvent;
  305. FOnCheckParams: TSQLDBRestCheckParamsEvent;
  306. FOnGetDataset: TSQLDBRestGetDatasetEvent;
  307. FOnResourceAllowed: TSQLDBRestAllowResourceEvent;
  308. FSchema: TSQLDBRestSchema;
  309. FAfterDatabaseRead: TRestDatabaseEvent;
  310. FAfterDatabaseUpdate: TRestDatabaseEvent;
  311. FBeforeDatabaseRead: TRestDatabaseEvent;
  312. FBeforeDatabaseUpdate: TRestDatabaseEvent;
  313. procedure SetSchema(AValue: TSQLDBRestSchema);
  314. Protected
  315. Function GetSchema : TSQLDBRestSchema; override;
  316. Function AllowResource(aContext : TBaseRestContext) : Boolean; override;
  317. Function GetAllowedOperations(aContext : TBaseRestContext; aDefault : TRestOperations) : TRestOperations; override;
  318. Procedure CheckParams(aContext : TBaseRestContext; aOperation : TRestoperation; P : TParams); override;
  319. Function GetDataset(aContext : TBaseRestContext; aFieldList : TRestFieldPairArray; aOrderBy : TRestFieldOrderPairArray; aLimit, aOffset : Int64) : TDataset; override;
  320. Function AllowRecord(aContext : TBaseRestContext; aDataset : TDataset) : Boolean; override;
  321. Published
  322. Property Schema : TSQLDBRestSchema Read GetSchema Write SetSchema;
  323. Property ResourceName;
  324. Property OnGetDataset : TSQLDBRestGetDatasetEvent Read FOnGetDataset Write FOnGetDataset;
  325. Property OnCheckParams : TSQLDBRestCheckParamsEvent Read FOnCheckParams Write FOnCheckParams;
  326. Property OnAllowResource : TSQLDBRestAllowResourceEvent Read FOnResourceAllowed Write FOnResourceAllowed;
  327. Property OnAllowedOperations : TSQLDBRestAllowedOperationsEvent Read FOnAllowedOperations Write FOnAllowedOperations;
  328. Property OnAllowRecord : TSQLDBRestAllowRecordEvent Read FOnAllowRecord Write FOnAllowRecord;
  329. Published
  330. Property BeforeDatabaseUpdate : TRestDatabaseEvent Read FBeforeDatabaseUpdate Write FBeforeDatabaseUpdate;
  331. Property AfterDatabaseUpdate : TRestDatabaseEvent Read FAfterDatabaseUpdate Write FAfterDatabaseUpdate;
  332. Property BeforeDatabaseRead: TRestDatabaseEvent Read FBeforeDatabaseRead Write FBeforeDatabaseRead;
  333. Property AfterDatabaseRead : TRestDatabaseEvent Read FAfterDatabaseRead Write FAfterDatabaseRead;
  334. end;
  335. Const
  336. TypeNames : Array[TRestFieldType] of string = ('?','int','bigint','float','date','time','datetime','string','bool','blob');
  337. RestMethods : Array[TRestOperation] of string = ('','GET','POST','PUT','DELETE','OPTIONS','HEAD','PATCH');
  338. implementation
  339. uses strutils, fpjsonrtti,dbconst, sqldbrestconst;
  340. { TSQLDBRestFieldListEnumerator }
  341. function TSQLDBRestFieldListEnumerator.GetCurrent: TSQLDBRestField;
  342. begin
  343. Result:=TSQLDBRestField(Inherited GetCurrent);
  344. end;
  345. { TSQLDBRestFieldArrayHelper }
  346. function TSQLDBRestFieldArrayHelper.IndexOf(aField: TSQLDBRestField): Integer;
  347. begin
  348. Result:=Length(Self)-1;
  349. While (Result>=0) and (Self[Result]<>aField) do
  350. Dec(Result);
  351. end;
  352. function TSQLDBRestFieldArrayHelper.Has(aField: TSQLDBRestField): Boolean;
  353. begin
  354. Result:=IndexOf(aField)<>-1;
  355. end;
  356. { TBaseRestContext }
  357. destructor TBaseRestContext.Destroy;
  358. begin
  359. FreeAndNil(FFreeList);
  360. inherited Destroy;
  361. end;
  362. procedure TBaseRestContext.AddToFreeList(aData: TJSONData);
  363. begin
  364. If Not Assigned(FFreeList) then
  365. FFreeList:=TFPObjectList.Create(True);
  366. FFreeList.Add(aData)
  367. end;
  368. function TBaseRestContext.GetInputData(aName: UTF8string): TJSONData;
  369. begin
  370. Result:=DoGetInputData(aName);
  371. // Don't burden the user with freeing this.
  372. if Assigned(Result) then
  373. AddToFreeList(Result);
  374. end;
  375. { TSQLDBRestCustomBusinessProcessor }
  376. procedure TSQLDBRestCustomBusinessProcessor.SetResourceName(AValue: UTF8String);
  377. Var
  378. S : TSQLDBRestSchema;
  379. begin
  380. if FResourceName=AValue then Exit;
  381. // Reregister, so the attachment happens to the correct resource
  382. S:=GetSchema;
  383. If (FResourceName<>'') and Assigned(S) then
  384. S.RemoveBusinessProcessor(Self);
  385. FResourceName:=AValue;
  386. S:=GetSchema;
  387. If (FResourceName<>'') and Assigned(S) then
  388. S.AddBusinessProcessor(Self);
  389. end;
  390. function TSQLDBRestCustomBusinessProcessor.GetSchema: TSQLDBRestSchema;
  391. begin
  392. Result:=Nil;
  393. end;
  394. { TSQLDBRestBusinessProcessor }
  395. procedure TSQLDBRestBusinessProcessor.SetSchema(AValue: TSQLDBRestSchema);
  396. begin
  397. if FSchema=AValue then Exit;
  398. if Assigned(FSchema) and (ResourceName<>'') then
  399. begin
  400. FSchema.RemoveBusinessProcessor(Self);
  401. FSchema.RemoveFreeNotification(Self);
  402. end;
  403. FSchema:=AValue;
  404. if Assigned(FSchema) and (ResourceName<>'') then
  405. begin
  406. FSchema.AddBusinessProcessor(Self);
  407. FSchema.FreeNotification(Self);
  408. end
  409. end;
  410. function TSQLDBRestBusinessProcessor.GetSchema: TSQLDBRestSchema;
  411. begin
  412. Result:=FSchema;
  413. end;
  414. function TSQLDBRestBusinessProcessor.AllowResource(aContext: TBaseRestContext
  415. ): Boolean;
  416. begin
  417. Result:=True;
  418. if Assigned(FOnResourceAllowed) then
  419. FOnResourceAllowed(Self,aContext,Result);
  420. end;
  421. function TSQLDBRestBusinessProcessor.GetAllowedOperations(
  422. aContext: TBaseRestContext; aDefault: TRestOperations): TRestOperations;
  423. begin
  424. Result:=aDefault;
  425. if Assigned(FOnAllowedOperations) then
  426. FOnAllowedOperations(Self,aContext,Result);
  427. end;
  428. procedure TSQLDBRestBusinessProcessor.CheckParams(aContext: TBaseRestContext;
  429. aOperation: TRestoperation; P: TParams);
  430. begin
  431. if Assigned(FOnCheckParams) then
  432. FOnCheckParams(Self,aContext,aOperation,P);
  433. end;
  434. function TSQLDBRestBusinessProcessor.GetDataset(aContext : TBaseRestContext;
  435. aFieldList: TRestFieldPairArray; aOrderBy: TRestFieldOrderPairArray; aLimit,
  436. aOffset: Int64): TDataset;
  437. begin
  438. Result:=nil;
  439. if Assigned(FOnGetDataset) then
  440. FOnGetDataset(Self,aContext,aFieldList,aOrderBy,aLimit,aOffset,Result);
  441. end;
  442. function TSQLDBRestBusinessProcessor.AllowRecord(aContext : TBaseRestContext; aDataset: TDataset): Boolean;
  443. begin
  444. Result:=True;
  445. if Assigned(FOnAllowRecord) then
  446. FOnAllowRecord(Self,acontext,aDataset,Result);
  447. end;
  448. { ESQLDBRest }
  449. constructor ESQLDBRest.Create(aCode: Integer; const aMessage: String);
  450. begin
  451. FResponseCode:=aCode;
  452. HelpContext:=aCode;
  453. Inherited create(aMessage);
  454. end;
  455. constructor ESQLDBRest.CreateFmt(aCode: Integer; const Fmt: String;
  456. const Args: array of const);
  457. begin
  458. FResponseCode:=aCode;
  459. HelpContext:=aCode;
  460. Inherited CreateFmt(Fmt,Args);
  461. end;
  462. { TSQLDBRestSchema }
  463. procedure TSQLDBRestSchema.SetResources(AValue: TSQLDBRestResourceList);
  464. begin
  465. if FResources=AValue then Exit;
  466. FResources.Assign(AValue);
  467. end;
  468. constructor TSQLDBRestSchema.Create(AOwner: TComponent);
  469. begin
  470. inherited Create(AOwner);
  471. FResources:=CreateResourceList;
  472. FProcessors:=TFPList.Create;
  473. end;
  474. function TSQLDBRestSchema.CreateResourceList: TSQLDBRestResourceList;
  475. begin
  476. Result:=TSQLDBRestResourceList.Create(Self,TSQLDBRestResource);
  477. end;
  478. destructor TSQLDBRestSchema.Destroy;
  479. begin
  480. FreeAndNil(FProcessors);
  481. FreeAndNil(FResources);
  482. inherited Destroy;
  483. end;
  484. procedure TSQLDBRestSchema.RemoveBusinessProcessor(
  485. aProcessor: TSQLDBRestCustomBusinessProcessor);
  486. begin
  487. DetachProcessor(aProcessor);
  488. FProcessors.Remove(aProcessor);
  489. end;
  490. procedure TSQLDBRestSchema.AddBusinessProcessor(
  491. aProcessor: TSQLDBRestCustomBusinessProcessor);
  492. begin
  493. FProcessors.Remove(aProcessor);
  494. AttachProcessor(aProcessor);
  495. end;
  496. procedure TSQLDBRestSchema.SaveToFile(const aFileName: UTF8String);
  497. Var
  498. F : TFileStream;
  499. begin
  500. F:=TFileStream.Create(aFileName,fmCreate);
  501. try
  502. SaveToStream(F);
  503. finally
  504. F.Free;
  505. end;
  506. end;
  507. procedure TSQLDBRestSchema.SaveToStream(const aStream: TStream);
  508. Var
  509. D : TJSONData;
  510. S : TJSONStringType;
  511. begin
  512. D:=asJSON(JSONSchemaRoot);
  513. try
  514. S:=D.FormatJSON();
  515. finally
  516. D.Free;
  517. end;
  518. aStream.WriteBuffer(S[1],Length(S)*SizeOf(TJSONCharType));
  519. end;
  520. function TSQLDBRestSchema.AsJSON(const aPropName: UTF8String): TJSONData;
  521. begin
  522. Result:=TJSONObject.Create([JSONResourcesRoot,Resources.AsJSON(),JSONConnectionName,ConnectionName]);
  523. if (aPropName<>'') then
  524. Result:=TJSONObject.Create([aPropName,Result]);
  525. end;
  526. procedure TSQLDBRestSchema.LoadFromFile(const aFileName: UTF8String);
  527. Var
  528. F : TFileStream;
  529. begin
  530. F:=TFileStream.Create(aFileName,fmOpenRead or fmShareDenyWrite);
  531. try
  532. LoadFromStream(F);
  533. finally
  534. F.Free;
  535. end;
  536. end;
  537. procedure TSQLDBRestSchema.LoadFromStream(const aStream: TStream);
  538. Var
  539. D : TJSONData;
  540. begin
  541. D:=GetJSON(aStream);
  542. try
  543. FromJSON(D,JSONSchemaRoot);
  544. finally
  545. D.Free;
  546. end;
  547. end;
  548. procedure TSQLDBRestSchema.FromJSON(aData: TJSONData; const aPropName: UTF8String);
  549. Var
  550. J : TJSONObject;
  551. begin
  552. J:=aData as TJSONObject;
  553. if (aPropName<>'') then
  554. J:=J.Objects[aPropName];
  555. Resources.FromJSON(J,JSONResourcesRoot);
  556. ConnectionName:=J.Get(JSONConnectionName,'');
  557. AttachAllProcessors;
  558. end;
  559. function TSQLDBRestSchema.ProcessIdentifier(const S: UTF8String): UTF8String;
  560. begin
  561. Result:=S;
  562. end;
  563. function TSQLDBRestSchema.AttachProcessor(aProcessor: TSQLDBRestCustomBusinessProcessor): Boolean;
  564. Var
  565. Res : TSQLDBRestResource;
  566. begin
  567. if aProcessor.ResourceName='' then
  568. exit;
  569. Res:=FResources.FindResourceByName(aProcessor.ResourceName);
  570. Result:=Assigned(Res);
  571. if Result then
  572. begin
  573. Res.FBusinessProcessor:=aProcessor;
  574. aProcessor.FResource:=Res;
  575. end;
  576. end;
  577. function TSQLDBRestSchema.DetachProcessor(aProcessor: TSQLDBRestCustomBusinessProcessor): Boolean;
  578. Var
  579. Res : TSQLDBRestResource;
  580. begin
  581. if aProcessor.ResourceName='' then
  582. exit;
  583. Res:=FResources.FindResourceByName(aProcessor.ResourceName);
  584. Result:=Assigned(Res);
  585. if Result then
  586. begin
  587. Res.FBusinessProcessor:=Nil;
  588. aProcessor.FResource:=Nil;
  589. end;
  590. end;
  591. procedure TSQLDBRestSchema.AttachAllProcessors;
  592. Var
  593. I : integer;
  594. begin
  595. For I:=0 to FProcessors.Count-1 do
  596. AttachProcessor(TSQLDBRestCustomBusinessProcessor(FProcessors[i]));
  597. end;
  598. procedure TSQLDBRestSchema.DetachAllProcessors;
  599. Var
  600. I : integer;
  601. begin
  602. For I:=0 to FProcessors.Count-1 do
  603. DetachProcessor(TSQLDBRestCustomBusinessProcessor(FProcessors[i]));
  604. end;
  605. class function TSQLDBRestSchema.GetPrimaryIndexFields(Q: TSQLQuery): TStringArray;
  606. Var
  607. C,I : Integer;
  608. Fields : UTF8String;
  609. begin
  610. Result:=Default(TStringArray);
  611. Q.ServerIndexDefs.Update;
  612. I:=0;
  613. Fields:='';
  614. With Q.ServerIndexDefs do
  615. While (Fields='') and (i<Count) do
  616. begin
  617. if (ixPrimary in Items[i].Options) then
  618. Fields:=Items[i].Fields;
  619. Inc(I);
  620. end;
  621. C:=WordCount(Fields,[';',' ']);
  622. SetLength(Result,C);
  623. For I:=1 to C do
  624. Result[I-1]:=ExtractWord(I,Fields,[';',' ']);
  625. end;
  626. procedure TSQLDBRestSchema.PopulateResourceFields(aConn : TSQLConnection; aRes : TSQLDBRestResource; aMinFieldOpts : TRestFieldOptions = []);
  627. Var
  628. Q : TRestSQLQuery;
  629. IndexFields : TStringArray;
  630. begin
  631. IndexFields:=Default(TStringArray);
  632. Q:=TRestSQLQuery.Create(Self);
  633. try
  634. Q.Database:=aConn;
  635. Q.ParseSQL:=True; // we want the table name
  636. if (aRes.SQLSelect.Count=0) then
  637. Q.SQL.Text:='SELECT * FROM '+aRes.TableName+' WHERE (1=0)' // Not very efficient :(
  638. else
  639. Q.SQL.Text:=aRes.GetResolvedSQL(skSelect,'(1=0)','');
  640. Q.TableName:=aRes.TableName;
  641. Q.UniDirectional:=True;
  642. Q.UsePrimaryKeyAsKey:=False;
  643. Q.Open;
  644. if (Q.TableName<>'') then
  645. IndexFields:=GetPrimaryIndexFields(Q);
  646. aRes.PopulateFieldsFromFieldDefs(Q.FieldDefs,IndexFields,@ProcessIdentifier,aMinFieldOpts)
  647. finally
  648. Q.Free;
  649. end;
  650. end;
  651. procedure TSQLDBRestSchema.PopulateResources(aConn: TSQLConnection;
  652. aTables: array of string; aMinFieldOpts: TRestFieldOptions);
  653. Var
  654. L : TStringList;
  655. S : String;
  656. begin
  657. L:=TStringList.Create;
  658. try
  659. L.Capacity:=Length(aTables);
  660. For S in aTables do
  661. L.Add(S);
  662. L.Sorted:=True;
  663. PopulateResources(aConn,L,aMinFieldOpts);
  664. finally
  665. l.Free;
  666. end;
  667. end;
  668. procedure TSQLDBRestSchema.PopulateResources(aConn: TSQLConnection; aTables : TStrings = Nil; aMinFieldOpts : TRestFieldOptions = []);
  669. Var
  670. L : TStrings;
  671. S,N : UTF8String;
  672. R : TSQLDBRestResource;
  673. begin
  674. L:=TStringList.Create;
  675. try
  676. aConn.Connected:=True;
  677. aConn.GetTableNames(L);
  678. For S in L do
  679. begin
  680. N:=ProcessIdentifier(S);
  681. if SameStr(N,S) then // No SameText, Allow to change case
  682. N:='';
  683. if (aTables=Nil) or (aTables.IndexOf(S)=-1) then
  684. begin
  685. R:=Resources.AddResource(S,N);
  686. PopulateResourceFields(aConn,R,aMinFieldOpts);
  687. end;
  688. end;
  689. finally
  690. L.Free;
  691. end;
  692. end;
  693. { TSQLDBRestResourceList }
  694. function TSQLDBRestResourceList.GetResource(aIndex : Integer): TSQLDBRestResource;
  695. begin
  696. Result:=TSQLDBRestResource(Items[aIndex])
  697. end;
  698. procedure TSQLDBRestResourceList.SetResource(aIndex : Integer; AValue: TSQLDBRestResource);
  699. begin
  700. Items[aIndex]:=aValue;
  701. end;
  702. function TSQLDBRestResourceList.Schema: TSQLDBRestSchema;
  703. begin
  704. If (Owner is TSQLDBRestSchema) then
  705. Result:=Owner as TSQLDBRestSchema
  706. else
  707. Result:=Nil;
  708. end;
  709. function TSQLDBRestResourceList.AddResource(const aTableName: UTF8String; const aResourceName: UTF8String): TSQLDBRestResource;
  710. Var
  711. N : UTF8String;
  712. begin
  713. N:=aResourceName;
  714. if N='' then
  715. N:=aTableName;
  716. if (N='') then
  717. Raise ESQLDBRest.Create(500,SErrResourceNameEmpty);
  718. if indexOfResourceName(N)<>-1 then
  719. Raise ESQLDBRest.CreateFmt(500,SErrDuplicateResource,[N]);
  720. Result:=add as TSQLDBRestResource;
  721. Result.TableName:=aTableName;
  722. Result.ResourceName:=aResourceName;
  723. end;
  724. function TSQLDBRestResourceList.indexOfTableName(const aTableName: UTF8String): Integer;
  725. begin
  726. Result:=Count-1;
  727. While (Result>=0) and not SameText(aTableName,GetResource(Result).TableName) do
  728. Dec(Result);
  729. end;
  730. function TSQLDBRestResourceList.indexOfResourceName(const aResourceName: UTF8String): Integer;
  731. begin
  732. Result:=Count-1;
  733. While (Result>=0) and not SameText(aResourceName,GetResource(Result).ResourceName) do
  734. Dec(Result);
  735. end;
  736. function TSQLDBRestResourceList.FindResourceByName(const aResourceName: UTF8String): TSQLDBRestResource;
  737. Var
  738. Idx : Integer;
  739. begin
  740. idx:=indexOfResourceName(aResourceName);
  741. if Idx=-1 then
  742. Result:=nil
  743. else
  744. Result:=GetResource(Idx);
  745. end;
  746. function TSQLDBRestResourceList.FindResourceByTableName(const aTableName: UTF8String): TSQLDBRestResource;
  747. Var
  748. Idx : Integer;
  749. begin
  750. idx:=indexOfTableName(aTableName);
  751. if Idx=-1 then
  752. Result:=nil
  753. else
  754. Result:=GetResource(Idx);
  755. end;
  756. procedure TSQLDBRestResourceList.SaveToFile(const aFileName: UTF8String);
  757. Var
  758. F : TFileStream;
  759. begin
  760. F:=TFileStream.Create(aFileName,fmCreate);
  761. try
  762. SaveToStream(F);
  763. finally
  764. F.Free;
  765. end;
  766. end;
  767. procedure TSQLDBRestResourceList.SaveToStream(const aStream: TStream);
  768. Var
  769. D : TJSONData;
  770. S : TJSONStringType;
  771. begin
  772. D:=asJSON(JSONResourcesRoot);
  773. try
  774. S:=D.FormatJSON();
  775. finally
  776. D.Free;
  777. end;
  778. aStream.WriteBuffer(S[1],Length(S)*SizeOf(TJSONCharType));
  779. end;
  780. function TSQLDBRestResourceList.AsJSON(const aPropName: UTF8String = ''): TJSONData;
  781. Var
  782. S : TJSONStreamer;
  783. A : TJSONArray;
  784. begin
  785. S:=TJSONStreamer.Create(Nil);
  786. try
  787. A:=S.StreamCollection(Self);
  788. finally
  789. S.Free;
  790. end;
  791. if aPropName='' then
  792. Result:=A
  793. else
  794. Result:=TJSONObject.Create([aPropName,A]);
  795. end;
  796. procedure TSQLDBRestResourceList.LoadFromFile(const aFileName: UTF8String);
  797. Var
  798. F : TFileStream;
  799. begin
  800. F:=TFileStream.Create(aFileName,fmOpenRead or fmShareDenyWrite);
  801. try
  802. LoadFromStream(F);
  803. finally
  804. F.Free;
  805. end;
  806. end;
  807. procedure TSQLDBRestResourceList.LoadFromStream(const aStream: TStream);
  808. Var
  809. D : TJSONData;
  810. begin
  811. D:=GetJSON(aStream);
  812. try
  813. FromJSON(D,JSONResourcesRoot);
  814. finally
  815. D.Free;
  816. end;
  817. end;
  818. procedure TSQLDBRestResourceList.FromJSON(aData: TJSONData; const aPropName: UTF8String);
  819. Var
  820. A : TJSONArray;
  821. D : TJSONDestreamer;
  822. begin
  823. if (aPropName<>'') then
  824. A:=(aData as TJSONObject).Arrays[aPropName]
  825. else
  826. A:=aData as TJSONArray;
  827. D:=TJSONDestreamer.Create(Nil);
  828. try
  829. Clear;
  830. D.JSONToCollection(A,Self);
  831. finally
  832. D.Free;
  833. end;
  834. end;
  835. { TSQLDBRestResource }
  836. function TSQLDBRestResource.GetResourceName: UTF8String;
  837. begin
  838. Result:=FResourceName;
  839. if Result='' then
  840. Result:=FTableName;
  841. end;
  842. function TSQLDBRestResource.GetSQL(AIndex: Integer): TStrings;
  843. begin
  844. Result:=FSQL[TSQLKind(aIndex)];
  845. end;
  846. function TSQLDBRestResource.GetSQLTyped(aKind : TSQLKind): TStrings;
  847. begin
  848. Result:=FSQL[aKind];
  849. end;
  850. procedure TSQLDBRestResource.SetAllowedOperations(AValue: TRestOperations);
  851. begin
  852. if FAllowedOperations=AValue then Exit;
  853. FAllowedOperations:=AValue;
  854. end;
  855. procedure TSQLDBRestResource.SetFields(AValue: TSQLDBRestFieldList);
  856. begin
  857. if FFields=AValue then Exit;
  858. FFields:=AValue;
  859. end;
  860. procedure TSQLDBRestResource.SetSQL(AIndex: Integer; AValue: TStrings);
  861. begin
  862. FSQL[TSQLKind(aIndex)].Assign(aValue);
  863. end;
  864. function TSQLDBRestResource.GetDisplayName: string;
  865. begin
  866. Result:=ResourceName;
  867. end;
  868. constructor TSQLDBRestResource.Create(ACollection: TCollection);
  869. Var
  870. K : TSQLKind;
  871. begin
  872. inherited Create(ACollection);
  873. FFields:=CreateFieldList;
  874. FEnabled:=True;
  875. FInMetadata:=True;
  876. for K in TSQLKind do
  877. FSQL[K]:=TStringList.Create;
  878. FAllowedOperations:=AllRestOperations;
  879. end;
  880. destructor TSQLDBRestResource.Destroy;
  881. Var
  882. K : TSQLKind;
  883. begin
  884. If Assigned(FBusinessProcessor) then
  885. FBusinessProcessor.FResource:=Nil;
  886. FreeAndNil(FFields);
  887. for K in TSQLKind do
  888. FreeAndNil(FSQL[K]);
  889. inherited Destroy;
  890. end;
  891. procedure TSQLDBRestResource.CheckParams(aContext : TBaseRestContext; aOperation: TRestoperation; P: TParams);
  892. begin
  893. if Assigned(FOnCheckParams) then
  894. FOnCheckParams(Self,aContext,aOperation,P)
  895. else if Assigned(FBusinessProcessor) then
  896. FBusinessProcessor.CheckParams(aContext,aOperation,P)
  897. end;
  898. function TSQLDBRestResource.GetDataset(aContext : TBaseRestContext; aFieldList: TRestFieldPairArray; aOrderBy: TRestFieldOrderPairArray; aLimit, aOffset: Int64): TDataset;
  899. begin
  900. Result:=Nil;
  901. If Assigned(FOnGetDataset) then
  902. FOnGetDataset(Self,aContext,aFieldList,aOrderBy,aLimit,aOffset,Result)
  903. else if Assigned(FBusinessProcessor) then
  904. Result:=FBusinessProcessor.GetDataset(aContext,aFieldList,aOrderBy,aLimit,aOffset);
  905. end;
  906. function TSQLDBRestResource.GetSchema: TSQLDBRestSchema;
  907. begin
  908. If Assigned(Collection) and (Collection is TSQLDBRestResourceList) then
  909. Result:=TSQLDBRestResourceList(Collection).Schema
  910. else
  911. Result:=Nil;
  912. end;
  913. procedure TSQLDBRestResource.Assign(Source: TPersistent);
  914. Var
  915. R : TSQLDBRestResource;
  916. K : TSQLKind;
  917. begin
  918. if (Source is TSQLDBRestResource) then
  919. begin
  920. R:=Source as TSQLDBRestResource;
  921. for K in TSQLKind do
  922. SQL[K].Assign(R.SQL[K]);
  923. Fields.Assign(R.Fields);
  924. TableName:=R.TableName;
  925. FResourceName:=R.FResourceName;
  926. ConnectionName:=R.ConnectionName;
  927. Enabled:=R.Enabled;
  928. InMetadata:=R.InMetadata;
  929. FAllowedOperations:=R.AllowedOperations;
  930. OnResourceAllowed:=R.OnResourceAllowed;
  931. OnAllowedOperations:=R.OnAllowedOperations;
  932. OnGetDataset:=R.OnGetDataset;
  933. OnCheckParams:=R.OnCheckParams;
  934. OnAllowRecord:=R.OnAllowRecord;
  935. end
  936. else
  937. inherited Assign(Source);
  938. end;
  939. function TSQLDBRestResource.AllowRecord(aContext : TBaseRestContext; aDataset: TDataset): Boolean;
  940. begin
  941. Result:=True;
  942. if Assigned(FOnAllowRecord) then
  943. FOnAllowRecord(Self,aContext,aDataset,Result)
  944. else if Assigned(FBusinessProcessor) then
  945. Result:=FBusinessProcessor.AllowRecord(aContext,aDataset);
  946. end;
  947. function TSQLDBRestResource.AllowResource(aContext : TBaseRestContext): Boolean;
  948. begin
  949. Result:=True;
  950. If Assigned(FOnResourceAllowed) then
  951. FOnResourceAllowed(Self,aContext,Result)
  952. else If Assigned(FBusinessProcessor) then
  953. Result:=FBusinessProcessor.AllowResource(aContext);
  954. end;
  955. function TSQLDBRestResource.GetAllowedOperations(aContext: TBaseRestContext
  956. ): TRestOperations;
  957. begin
  958. Result:=AllowedOperations;
  959. if Assigned(FOnAllowedOperations) then
  960. FOnAllowedOperations(Self,aContext,Result)
  961. else if Assigned(FBusinessProcessor) then
  962. Result:=FBusinessProcessor.GetAllowedOperations(aContext,Result);
  963. end;
  964. function TSQLDBRestResource.GetHTTPAllow: String;
  965. Procedure AddR(s : String);
  966. begin
  967. if (Result<>'') then
  968. Result:=Result+', ';
  969. Result:=Result+S;
  970. end;
  971. Var
  972. O : TRestOperation;
  973. begin
  974. Result:='';
  975. For O in TRestOperation do
  976. if (O<>roUnknown) and (O in AllowedOperations) then
  977. AddR(RestMethods[O]);
  978. end;
  979. function TSQLDBRestResource.GetFieldList(aListKind: TFieldListKind;
  980. ASep: String; OnlyFields: TSQLDBRestFieldArray): UTF8String;
  981. Const
  982. SepComma = ', ';
  983. SepAND = ' AND ';
  984. SepSpace = ' ';
  985. Const
  986. DefaultSeps : Array[TFieldListKind] of string = (sepComma,sepComma,sepComma,sepComma,sepAnd,sepSpace,sepComma);
  987. Const
  988. Wheres = [flWhereKey];
  989. Colons = Wheres + [flInsertParams,flUpdate];
  990. UseEqual = Wheres+[flUpdate];
  991. Function AllowField (F :TSQLDBRestField) : Boolean; inline;
  992. begin
  993. Result:=F.UseInFieldList(aListKind) and ((Length(OnlyFields)=0) or (OnlyFields.Has(F)));
  994. end;
  995. Var
  996. Sep,Term,Res,Prefix : UTF8String;
  997. I : Integer;
  998. F : TSQLDBRestField;
  999. begin
  1000. Prefix:='';
  1001. Sep:=aSep;
  1002. if Sep='' then
  1003. begin
  1004. Sep:=DefaultSeps[aListKind];
  1005. If aListKind in Colons then
  1006. Prefix:=':';
  1007. end;
  1008. Res:='';
  1009. For I:=0 to Fields.Count-1 do
  1010. begin
  1011. Term:='';
  1012. F:=Fields[i];
  1013. if allowfield(F) then
  1014. begin
  1015. Term:=Prefix+F.FieldName;
  1016. if (aSep='') and (aListKind in UseEqual) then
  1017. begin
  1018. Term := F.FieldName+' = '+Term;
  1019. if (aListKind in Wheres) then
  1020. Term:='('+Term+')';
  1021. end;
  1022. end;
  1023. if (Term<>'') then
  1024. begin
  1025. If (Res<>'') then
  1026. Res:=Res+Sep;
  1027. Res:=Res+Term;
  1028. end;
  1029. end;
  1030. Result:=Res;
  1031. end;
  1032. function TSQLDBRestResource.GetFieldArray(aListKind: TFieldListKind
  1033. ): TSQLDBRestFieldArray;
  1034. Var
  1035. I,aCount : Integer;
  1036. F : TSQLDBRestField;
  1037. begin
  1038. Result:=Default(TSQLDBRestFieldArray);
  1039. aCount:=0;
  1040. SetLength(Result,Fields.Count);
  1041. For I:=0 to Fields.Count-1 do
  1042. begin
  1043. F:=Fields[i];
  1044. if F.UseInFieldList(aListKind) then
  1045. begin
  1046. Result[aCount]:=F;
  1047. Inc(aCount);
  1048. end;
  1049. end;
  1050. SetLength(Result,aCount);
  1051. end;
  1052. function TSQLDBRestResource.GenerateDefaultSQL(aKind: TSQLKind; OnlyFields : TSQLDBRestFieldArray = nil) : UTF8String;
  1053. begin
  1054. Case aKind of
  1055. skSelect :
  1056. Result:='SELECT '+GetFieldList(flSelect,'',OnlyFields)+' FROM '+TableName+' %FULLWHERE% %FULLORDERBY% %LIMIT%';
  1057. skInsert :
  1058. Result:='INSERT INTO '+TableName+' ('+GetFieldList(flInsert,'',OnlyFields)+') VALUES ('+GetFieldList(flInsertParams)+')';
  1059. skUpdate :
  1060. Result:='UPDATE '+TableName+' SET '+GetFieldList(flUpdate,'',OnlyFields)+' %FULLWHERE%';
  1061. skDelete :
  1062. Result:='DELETE FROM '+TableName+' %FULLWHERE%';
  1063. else
  1064. Raise ESQLDBRest.CreateFmt(500,SErrUnknownStatement,[Ord(aKind)]);
  1065. end;
  1066. end;
  1067. function TSQLDBRestResource.GetResolvedSQl(aKind: TSQLKind;
  1068. const AWhere: UTF8String; const aOrderBy: UTF8String; aLimit: UTF8String;
  1069. OnlyFields: TSQLDBRestFieldArray): UTF8String;
  1070. begin
  1071. Result:=SQL[aKind].Text;
  1072. if (Result='') then
  1073. Result:=GenerateDefaultSQL(aKind,OnlyFields);
  1074. Result:=ProcessSQL(Result,aWhere,aOrderBy,aLimit);
  1075. end;
  1076. function TSQLDBRestResource.ProcessSQl(aSQL: String; const AWhere: UTF8String;
  1077. const aOrderBy: UTF8String; aLimit: UTF8String): UTF8String;
  1078. Var
  1079. S : UTF8String;
  1080. begin
  1081. Result:=aSQL;
  1082. // from tables %FULLWHERE%
  1083. if (aWhere<>'') then
  1084. S:='WHERE '+aWhere
  1085. else
  1086. S:='';
  1087. Result:=StringReplace(Result,'%FULLWHERE%',S,[rfReplaceAll]);
  1088. // from tables WHERE %REQUIREDWHERE%
  1089. if (aWhere<>'') then
  1090. S:=aWhere
  1091. else
  1092. S:='(1=0)';
  1093. Result:=StringReplace(Result,'%REQUIREDWHERE%',S,[rfReplaceAll]);
  1094. // from tables WHERE X=Y %OPTIONALWHERE%
  1095. if (aWhere<>'') then
  1096. S:='AND ('+aWhere+')'
  1097. else
  1098. S:='';
  1099. Result:=StringReplace(Result,'%OPTIONALWHERE%',S,[rfReplaceAll]);
  1100. // from tables WHERE X=Y AND %WHERE%
  1101. if (aWhere<>'') then
  1102. S:='('+aWhere+')'
  1103. else
  1104. S:='';
  1105. Result:=StringReplace(Result,'%WHERE%',S,[rfReplaceAll]);
  1106. if (aOrderBy<>'') then
  1107. S:='ORDER BY '+AOrderBy
  1108. else
  1109. S:='';
  1110. Result:=StringReplace(Result,'%FULLORDERBY%',S,[rfReplaceAll]);
  1111. Result:=StringReplace(Result,'%ORDERBY%',aOrderBy,[rfReplaceAll]);
  1112. Result:=StringReplace(Result,'%LIMIT%',aLimit,[rfReplaceAll]);
  1113. end;
  1114. class function TSQLDBRestResource.FieldTypeToRestFieldType(
  1115. aFieldType: TFieldType): TRestFieldType;
  1116. Const
  1117. Map : Array[TFieldType] of TRestFieldType =
  1118. (rftUnknown, rftString, rftInteger, rftInteger, rftInteger, // ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
  1119. rftBoolean, rftFloat, rftFloat, rftFloat, rftDate, rftTime, rftDateTime, // ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,
  1120. rftBlob, rftBlob, rftInteger, rftBlob, rftString, rftUnknown, rftString, // ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
  1121. rftUnknown, rftUnknown, rftUnknown, rftUnknown, rftString, // ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar,
  1122. rftString, rftLargeInt, rftUnknown, rftUnknown, rftUnknown, // ftWideString, ftLargeint, ftADT, ftArray, ftReference,
  1123. rftUnknown, rftBlob, rftBlob, rftUnknown, rftUnknown, // ftDataSet, ftOraBlob, ftOraClob, ftVariant, ftInterface,
  1124. rftUnknown, rftString, rftDateTime, rftFloat, rftString, rftString // ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd, ftFixedWideChar, ftWideMemo
  1125. {$IFNDEF VER3_2_2}
  1126. ,rftDateTime, rftDateTime, rftInteger, rftInteger, rftInteger, rftFloat, // ftOraTimeStamp, ftOraInterval, ftLongWord, ftShortint, ftByte, ftExtended
  1127. rftFloat // Single
  1128. {$ENDIF}
  1129. );
  1130. begin
  1131. Result:=Map[aFieldType];
  1132. end;
  1133. procedure TSQLDBRestResource.PopulateFieldsFromFieldDefs(Defs: TFieldDefs; aIndexFields: TStringArray;
  1134. aProcessIdentifier: TProcessIdentifier; aMinFieldOpts: TRestFieldOptions);
  1135. Var
  1136. I : Integer;
  1137. F : TSQLDBRestField;
  1138. FN,PN : UTF8String;
  1139. O : TRestFieldOptions;
  1140. RFT : TRestFieldType;
  1141. FD : TFieldDef;
  1142. begin
  1143. For I:=0 to Defs.Count-1 do
  1144. begin
  1145. FD:=Defs[i];
  1146. RFT:=FieldTypeToRestFieldType(FD.DataType);
  1147. if RFT=rftUnknown then
  1148. Continue;
  1149. FN:=FD.Name;
  1150. if Assigned(aProcessIdentifier) then
  1151. PN:=aProcessIdentifier(FN);
  1152. if SameStr(PN,FN) then // No SameText, Allow to change case
  1153. PN:='';
  1154. O:=aMinFieldOpts;
  1155. if FD.Required then
  1156. Include(O,foRequired);
  1157. If AnsiIndexStr(FN,aIndexFields)<>-1 then
  1158. begin
  1159. Include(O,foInKey);
  1160. Exclude(O,foFilter);
  1161. end;
  1162. F:=Fields.AddField(FN,RFT,O);
  1163. F.NativeFieldType:=FD.DataType;
  1164. if F.FieldType=rftString then
  1165. F.MaxLen:=FD.Size;
  1166. F.PublicName:=PN;
  1167. end;
  1168. end;
  1169. class function TSQLDBRestResource.CreateFieldList: TSQLDBRestFieldList;
  1170. begin
  1171. Result:=DefaultFieldListClass.Create(DefaultFieldClass);
  1172. end;
  1173. { TSQLDBRestFieldList }
  1174. function TSQLDBRestFieldList.GetFields(aIndex: Integer): TSQLDBRestField;
  1175. begin
  1176. Result:=TSQLDBRestField(Items[aIndex])
  1177. end;
  1178. procedure TSQLDBRestFieldList.SetFields(aIndex : Integer; AValue: TSQLDBRestField);
  1179. begin
  1180. Items[aIndex]:=aValue;
  1181. end;
  1182. function TSQLDBRestFieldList.GetEnumerator: TSQLDBRestFieldListEnumerator;
  1183. begin
  1184. Result:=TSQLDBRestFieldListEnumerator.Create(Self);
  1185. end;
  1186. function TSQLDBRestFieldList.AddField(const aFieldName: UTF8String; aFieldType: TRestFieldType; aOptions: TRestFieldOptions
  1187. ): TSQLDBRestField;
  1188. begin
  1189. if IndexOfFieldName(aFieldName)<>-1 then
  1190. Raise ESQLDBRest.CreateFmt(500,SDuplicateFieldName,[aFieldName]);
  1191. Result:=Add as TSQLDBRestField;
  1192. Result.FieldName:=aFieldName;
  1193. Result.FieldType:=aFieldType;
  1194. Result.Options:=aOptions;
  1195. end;
  1196. function TSQLDBRestFieldList.indexOfFieldName(const aFieldName : UTF8String): Integer;
  1197. begin
  1198. Result:=Count-1;
  1199. While (Result>=0) and not SameText(aFieldName,GetFields(Result).FieldName) do
  1200. Dec(Result);
  1201. end;
  1202. function TSQLDBRestFieldList.FindByFieldName(const aFieldName: UTF8String
  1203. ): TSQLDBRestField;
  1204. Var
  1205. I : Integer;
  1206. begin
  1207. I:=indexOfFieldName(aFieldName);
  1208. if (I=-1) then
  1209. Result:=Nil
  1210. else
  1211. Result:=GetFields(I);
  1212. end;
  1213. function TSQLDBRestFieldList.indexOfPublicName(const aPublicName : UTF8String): Integer;
  1214. begin
  1215. Result:=Count-1;
  1216. While (Result>=0) and not SameText(aPublicName,GetFields(Result).PublicName) do
  1217. Dec(Result);
  1218. end;
  1219. function TSQLDBRestFieldList.FindByPublicName(const aFieldName: UTF8String
  1220. ): TSQLDBRestField;
  1221. Var
  1222. I : Integer;
  1223. begin
  1224. I:=indexOfPublicName(aFieldName);
  1225. if (I=-1) then
  1226. Result:=Nil
  1227. else
  1228. Result:=GetFields(I);
  1229. end;
  1230. { TSQLDBRestField }
  1231. function TSQLDBRestField.GetPublicName: UTF8String;
  1232. begin
  1233. Result:=FPublicName;
  1234. if (Result='') then
  1235. Result:=FFieldName;
  1236. end;
  1237. constructor TSQLDBRestField.Create(ACollection: TCollection);
  1238. begin
  1239. inherited Create(ACollection);
  1240. FFilters:=AllFieldFilters;
  1241. end;
  1242. procedure TSQLDBRestField.Assign(Source: TPersistent);
  1243. Var
  1244. F : TSQLDBRestField;
  1245. begin
  1246. if (Source is TSQLDBRestField) then
  1247. begin
  1248. F:=source as TSQLDBRestField;
  1249. FieldName:=F.FieldName;
  1250. FPublicName:=F.FPublicName;
  1251. FieldType:=F.FieldType;
  1252. NativeFieldType:=F.NativeFieldType;
  1253. Options:=F.Options;
  1254. Filters:=F.Filters;
  1255. MaxLen:=F.MaxLen;
  1256. GeneratorName:=F.GeneratorName;
  1257. end
  1258. else
  1259. inherited Assign(Source);
  1260. end;
  1261. function TSQLDBRestField.GetDisplayName: string;
  1262. begin
  1263. Result:=PublicName;
  1264. end;
  1265. function TSQLDBRestField.UseInFieldList(aListKind: TFieldListKind): Boolean;
  1266. begin
  1267. Result:=True;
  1268. Case aListKind of
  1269. flSelect : Result:=True;
  1270. flInsert : Result:=foInInsert in Options;
  1271. flInsertParams : Result:=(foInInsert in Options) and not (NativeFieldType=ftAutoInc);
  1272. flUpdate : Result:=foInUpdate in Options;
  1273. flWhereKey : Result:=foInKey in Options;
  1274. flFilter : Result:=foFilter in Options;
  1275. flOrderby : Result:=([foOrderBy,foOrderByDesc]*options)<>[];
  1276. end;
  1277. end;
  1278. end.