jsondataset.pas 49 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2019 by Michael Van Canneyt, member of the
  4. Free Pascal development team
  5. Simple JSON dataset component.
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {$mode objfpc}
  13. unit JSONDataset;
  14. interface
  15. uses
  16. Types, JS, DB, Classes, SysUtils, typinfo, fpexprpars;
  17. type
  18. TBaseJSONDataset = Class;
  19. TJSONIndexDef = class;
  20. // How are rows encoded in the JSON ?
  21. TJSONRowType = (rtJSONObject, // Each row is an object.
  22. rtJSONArray // Each row is an array.
  23. );
  24. { TJSONFieldMapper }
  25. // This class is responsible for mapping the field objects of the records.
  26. TJSONFieldMapper = Class(TObject)
  27. Public
  28. Function CopyRow(aRow : JSValue) : JSValue; virtual;
  29. // Remove a field from the
  30. Procedure RemoveField(Const FieldName : String; FieldIndex : Integer; Row : JSValue); virtual; abstract;
  31. // Return row TJSONData instance with data for field 'FieldName' or 'FieldIndex'.
  32. Function GetJSONDataForField(Const FieldName : String; FieldIndex : Integer; Row : JSValue) : JSValue; virtual; abstract;
  33. // Same, but now based on TField.
  34. Function GetJSONDataForField(F : TField; Row : JSValue) : JSValue; virtual;
  35. // Set data for field 'FieldName' or 'FieldIndex' to supplied TJSONData instance in row
  36. procedure SetJSONDataForField(Const FieldName : String; FieldIndex : Integer; Row,Data : JSValue); virtual; abstract;
  37. // Set data for field TField to supplied TJSONData instance
  38. procedure SetJSONDataForField(F : TField; Row,Data : JSValue); virtual;
  39. // Create a new row.
  40. Function CreateRow : JSValue; virtual; abstract;
  41. end;
  42. // JSON has no date/time type, so we use a string field.
  43. // ExtJS provides the date/time format in it's field config: 'dateFormat'
  44. // The below field classes store this in the NNNFormat field.
  45. { TJSONDateField }
  46. TJSONDateField = Class(TDateField)
  47. private
  48. FDateFormat: String;
  49. Published
  50. Property DateFormat : String Read FDateFormat Write FDateFormat;
  51. end;
  52. { TJSONTimeField }
  53. TJSONTimeField = Class(TTimeField)
  54. private
  55. FTimeFormat: String;
  56. Published
  57. Property TimeFormat : String Read FTimeFormat Write FTimeFormat;
  58. end;
  59. { TJSONDateTimeField }
  60. TJSONDateTimeField = Class(TDateTimeField)
  61. private
  62. FDateTimeFormat: String;
  63. Published
  64. Property DateTimeFormat : String Read FDateTimeFormat Write FDateTimeFormat;
  65. end;
  66. { TFieldComparer }
  67. TFieldComparer = Class
  68. Private
  69. FDesc: Boolean;
  70. FValue : JSValue;
  71. FField : TField;
  72. FOptions : TLocateOptions;
  73. FDataset : TBaseJSONDataset;
  74. Public
  75. Constructor Create(aDataset : TBaseJSONDataset; aField : TField; aValue : JSValue; aOptions : TLocateOptions);
  76. Function GetFieldValue(RowIndex : integer) : JSValue;
  77. Function CompareRows (RowIndex1,RowIndex2 : Integer) : Integer; virtual;
  78. // First value is always dataset value.
  79. Function Compare (RowIndex : Integer; aValue : JSValue) : Integer; virtual; abstract;
  80. Function Compare (RowIndex : Integer) : Integer; virtual;
  81. Property Value : JSValue read FValue Write FValue;
  82. Property Options : TLocateOptions Read FOptions Write FOptions;
  83. Property Dataset : TBaseJSONDataset Read FDataset;
  84. Property Field : TField Read FField;
  85. Property Desc : Boolean Read FDesc Write FDesc;
  86. end;
  87. TFieldComparerClass = Class of TFieldComparer;
  88. { TStringFieldComparer }
  89. TStringFieldComparer = Class (TFieldComparer)
  90. Function Compare (RowIndex : Integer; aValue : JSValue) : Integer; override;
  91. end;
  92. { TNativeIntFieldComparer }
  93. TNativeIntFieldComparer = Class (TFieldComparer)
  94. Function Compare (RowIndex : Integer; aValue : JSValue) : Integer; override;
  95. end;
  96. { TBooleanFieldComparer }
  97. TBooleanFieldComparer = Class (TFieldComparer)
  98. Function Compare (RowIndex : Integer; aValue : JSValue) : Integer; override;
  99. end;
  100. { TDateTimeFieldComparer }
  101. TDateTimeFieldComparer = Class (TFieldComparer)
  102. Function Compare (RowIndex : Integer; aValue : JSValue) : Integer; override;
  103. end;
  104. { TFloatFieldComparer }
  105. TFloatFieldComparer = Class (TFieldComparer)
  106. Function Compare (RowIndex : Integer; aValue : JSValue) : Integer; override;
  107. end;
  108. { TRecordComparer }
  109. TRecordComparer = class
  110. private
  111. FDataset: TBaseJSONDataset;
  112. FIndexBased: Boolean;
  113. FItems : Array of TFieldComparer;
  114. FOptions: TLocateOptions;
  115. FValues: TJSValueDynArray;
  116. function GetFieldComparer(Index : Integer): TFieldComparer;
  117. Protected
  118. procedure ConstructItems(aFields: String); virtual;
  119. function DataTypeToComparerClass(aFieldType: TFieldType): TFieldComparerClass;
  120. Function Compare(aRowindex : integer) : Integer;
  121. Function CompareRows(aRowindex1,aRowIndex2 : integer) : Integer;
  122. procedure updateFromIndex(aIndex : TJSONIndexDef); virtual;
  123. Public
  124. Constructor Create(aDataset : TBaseJSONDataset; aFields : String; aValues : JSValue; aOptions : TLocateOptions);
  125. Constructor Create(aDataset : TBaseJSONDataset; aIndex : TJSONIndexDef);
  126. Destructor Destroy; override;
  127. Property Dataset : TBaseJSONDataset Read FDataset;
  128. property Items [Index : Integer] : TFieldComparer Read GetFieldComparer;
  129. Property Options : TLocateOptions Read FOptions Write FOptions;
  130. Property Values : TJSValueDynArray Read FValues;
  131. Property IndexBased : Boolean Read FIndexBased;
  132. end;
  133. TRecordComparerClass = Class of TRecordComparer;
  134. { TBaseJSONDataSet }
  135. { TJSONIndex }
  136. TJSONIndex = Class
  137. FList : TJSArray; // Indexes of elements in FRows.
  138. FRows : TJSArray;
  139. FDataset : TBaseJSONDataset;
  140. private
  141. function GetRecordIndex(aListIndex : Integer): NativeInt;
  142. protected
  143. Function GetCount: Integer; virtual;
  144. Procedure CreateIndex; Virtual; abstract;
  145. Procedure ClearIndex;
  146. Property List : TJSArray Read FList;
  147. Property Rows : TJSArray Read FRows;
  148. Property Dataset : TBaseJSONDataset Read FDataset;
  149. Public
  150. Constructor Create(aDataset: TBaseJSONDataset; aRows : TJSArray); reintroduce;
  151. // Append remainder of FRows to FList.
  152. Procedure AppendToIndex; virtual; abstract;
  153. // Delete aListIndex from list, not from row. Return Recordindex of deleted record.
  154. Function Delete(aListIndex : Integer) : Integer; virtual;
  155. // Append aRecordIndex to list. Return ListIndex of appended record.
  156. Function Append(aRecordIndex : Integer) : Integer; virtual; abstract;
  157. // Insert record into list. By default, this does an append. Return ListIndex of inserted record
  158. Function Insert(aCurrentIndex{%H-}, aRecordIndex : Integer) : Integer; virtual;
  159. // Record at index aCurrentIndex has changed. Update index and return new listindex.
  160. Function Update(aRecordIndex : Integer) : Integer; virtual; abstract;
  161. // Find list index for Record at index aCurrentIndex. Return -1 if not found.
  162. Function FindRecord(aRecordIndex : Integer) : Integer; virtual; abstract;
  163. // index of record in FRows based on aListIndex in List.
  164. Property RecordIndex[aListIndex : Integer] : NativeInt Read GetRecordIndex;
  165. // Number of records in index. This can differ from FRows, e.g. when filtering.
  166. Property Count : Integer Read GetCount;
  167. end;
  168. { TDefaultJSONIndex }
  169. TDefaultJSONIndex = Class(TJSONIndex)
  170. public
  171. Procedure CreateIndex; override;
  172. Procedure AppendToIndex; override;
  173. Function Append(aRecordIndex : Integer) : Integer; override;
  174. Function Insert(aCurrentIndex, aRecordIndex : Integer) : Integer; override;
  175. Function FindRecord(aRecordIndex : Integer) : Integer; override;
  176. Function Update(aRecordIndex : Integer) : Integer; override;
  177. end;
  178. { TSortedJSONIndex }
  179. TSortedJSONIndex = Class(TJSONIndex)
  180. Private
  181. FComparer : TRecordComparer;
  182. FUnique: Boolean;
  183. function FindPos(aRecordIndex: Integer): Integer;
  184. function MergeSort(aList: TJSArray): TJSArray;
  185. Protected
  186. Property Comparer : TRecordComparer Read FComparer Write FComparer;
  187. public
  188. Destructor Destroy; override;
  189. procedure CreateComparer(aIndex: TJSONIndexDef);
  190. Procedure CreateIndex; override;
  191. Procedure AppendToIndex; override;
  192. Function Append(aRecordIndex : Integer) : Integer; override;
  193. Function FindRecord(aRecordIndex : Integer) : Integer; override;
  194. Function Update(aRecordIndex : Integer) : Integer; override;
  195. Property Unique : Boolean Read FUnique Write FUnique;
  196. end;
  197. { TJSONIndexDef }
  198. TJSONIndexDef = class(TIndexDef)
  199. Private
  200. FIndex : TSortedJSONIndex;
  201. Protected
  202. Procedure ClearIndex;
  203. Property Index : TSortedJSONIndex Read FIndex Write FIndex;
  204. Public
  205. Procedure BuildIndex(aDataset : TBaseJSONDataset);
  206. end;
  207. { TJSONIndexDefs }
  208. TJSONIndexDefs = Class(TIndexDefs)
  209. private
  210. function GetD(aIndex : Integer): TJSONIndexDef;
  211. procedure SetD(aIndex : Integer; AValue: TJSONIndexDef);
  212. Public
  213. Function AddJSONIndexDef: TJSONIndexDef;
  214. Property Defs[aIndex : Integer] : TJSONIndexDef Read GetD Write SetD; default;
  215. end;
  216. // basic JSON dataset. Does nothing ExtJS specific.
  217. TBaseJSONDataSet = class (TDataSet)
  218. private
  219. FActiveIndex: String;
  220. FIndexes: TJSONIndexDefs;
  221. FMUS: Boolean;
  222. FOwnsData : Boolean;
  223. FDefaultIndex : TJSONIndex; // Default index, built from array
  224. FCurrentIndex : TJSONIndex; // Currently active index.
  225. FCurrent: Integer; // Record Index in the current IndexList
  226. // Possible metadata to configure fields from.
  227. FMetaData : TJSObject;
  228. // This will contain the rows.
  229. FRows : TJSArray;
  230. // Deleted rows
  231. FDeletedRows : TJSArray;
  232. FFieldMapper : TJSONFieldMapper;
  233. // When editing, this object is edited.
  234. FEditIdx : Integer;
  235. FEditRow : JSValue;
  236. // When filtering, this is the current row;
  237. FFilterRow : JSValue;
  238. FUseDateTimeFormatFields: Boolean;
  239. FRowType: TJSONRowType;
  240. FFilterExpression : TFPExpressionParser;
  241. function GetFilterField(const AName: String): TFPExpressionResult;
  242. procedure RemoveCalcFields(Buf: JSValue);
  243. procedure SetActiveIndex(AValue: String);
  244. procedure SetIndexes(AValue: TJSONIndexDefs);
  245. procedure SetMetaData(AValue: TJSObject);
  246. procedure SetRows(AValue: TJSArray);
  247. procedure SetRowType(AValue: TJSONRowType);
  248. protected
  249. procedure ActivateIndex(Build : Boolean);
  250. // Determine filter value type based on field type
  251. function FieldTypeToExpressionType(aDataType: TFieldType): TResultType; virtual;
  252. // Callback for IsNull filter function.
  253. function GetFilterIsNull(const Args: TExprParameterArray): TFPExpressionResult; virtual;
  254. // Expression parser class. Override this to create a customized version.
  255. function FilterExpressionClass: TFPExpressionParserClass; virtual;
  256. // Create filter expression.
  257. function CreateFilterExpression: TFPExpressionParser; virtual;
  258. // Function called to check if current buffer should be accepted.
  259. function DoFilterRecord: Boolean; virtual;
  260. // Override this to return customized version.
  261. function CreateIndexDefs: TJSONIndexDefs; virtual;
  262. // override this to return a customized version if you are so inclined
  263. function RecordComparerClass: TRecordComparerClass; virtual;
  264. // Return index of Row in FRows matching keyfields/values. If not found, -1 is returned.
  265. function LocateRecordIndex(const KeyFields: string; const KeyValues: JSValue; Options: TLocateOptions): Integer; virtual;
  266. // dataset virtual methods
  267. function AllocRecordBuffer: TDataRecord; override;
  268. procedure FreeRecordBuffer(var Buffer: TDataRecord); override;
  269. procedure InternalInitRecord(var Buffer: TDataRecord); override;
  270. function GetRecord(Var Buffer: TDataRecord; GetMode: TGetMode; DoCheck{%H-}: Boolean): TGetResult; override;
  271. function GetRecordSize: Word; override;
  272. procedure AddToRows(AValue: TJSArray);
  273. procedure InternalClose; override;
  274. procedure InternalDelete; override;
  275. procedure InternalFirst; override;
  276. procedure InternalLast; override;
  277. procedure InternalOpen; override;
  278. procedure InternalPost; override;
  279. procedure InternalInsert; override;
  280. procedure InternalEdit; override;
  281. procedure InternalCancel; override;
  282. procedure InternalInitFieldDefs; override;
  283. procedure InternalSetToRecord(Buffer: TDataRecord); override;
  284. procedure SetFilterText(const Value: string); override;
  285. procedure SetFiltered(Value: Boolean); override;
  286. function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
  287. function IsCursorOpen: Boolean; override;
  288. // Bookmark operations
  289. procedure GetBookmarkData(Buffer: TDataRecord; var Data: TBookmark); override;
  290. function GetBookmarkFlag(Buffer: TDataRecord): TBookmarkFlag; override;
  291. procedure InternalGotoBookmark(ABookmark: TBookmark); override;
  292. procedure SetBookmarkFlag(Var Buffer: TDataRecord; Value: TBookmarkFlag); override;
  293. procedure SetBookmarkData(Var Buffer: TDataRecord; Data: TBookmark); override;
  294. function GetRecordCount: Integer; override;
  295. procedure SetRecNo(Value: Integer); override;
  296. function GetRecNo: Integer; override;
  297. Protected
  298. // New methods.
  299. // Build all sorted indexes. Default index is not built.
  300. Procedure BuildIndexes;
  301. // Called when dataset is closed. If OwnsData is true, metadata and rows are freed.
  302. Procedure FreeData; virtual;
  303. // Fill default list.
  304. procedure AppendToIndexes; virtual;
  305. Procedure CreateIndexes; virtual;
  306. // Convert MetaData object to FieldDefs.
  307. Procedure MetaDataToFieldDefs; virtual; abstract;
  308. // Initialize Date/Time info in all date/time fields. Called during InternalOpen
  309. procedure InitDateTimeFields; virtual;
  310. // Convert JSON date S to DateTime for Field F
  311. function ConvertDateTimeField(S: String; F: TField): TDateTime; virtual;
  312. // Format JSON date to from DT for Field F
  313. function FormatDateTimeField(DT : TDateTime; F: TField): String; virtual;
  314. // Create fieldmapper. A descendent MUST implement this.
  315. Function CreateFieldMapper : TJSONFieldMapper; virtual;
  316. // If True, then the dataset will free MetaData and FRows when it is closed.
  317. Property OwnsData : Boolean Read FownsData Write FOwnsData;
  318. // set to true if unknown field types should be handled as string fields.
  319. Property MapUnknownToStringType : Boolean Read FMUS Write FMUS;
  320. // Metadata
  321. Property MetaData : TJSObject Read FMetaData Write SetMetaData;
  322. // Rows
  323. Property Rows : TJSArray Read FRows Write SetRows;
  324. // RowType
  325. Property RowType : TJSONRowType Read FRowType Write SetRowType;
  326. // Fieldmapper
  327. Property FieldMapper : TJSONFieldMapper Read FFieldMapper;
  328. // FieldClass
  329. Property UseDateTimeFormatFields : Boolean Read FUseDateTimeFormatFields Write FUseDateTimeFormatFields;
  330. // Indexes
  331. Property Indexes : TJSONIndexDefs Read FIndexes Write SetIndexes;
  332. // Active index name. Set to empty for default index.
  333. Property ActiveIndex : String Read FActiveIndex Write SetActiveIndex;
  334. public
  335. constructor Create (AOwner: TComponent); override;
  336. destructor Destroy; override;
  337. function ConvertDateTimeToNative(aField : TField; aValue : TDateTime) : JSValue; override;
  338. function Locate(const KeyFields: string; const KeyValues: JSValue; Options: TLocateOptions): boolean; override;
  339. function Lookup(const KeyFields: string; const KeyValues: JSValue; const ResultFields: string): JSValue; override;
  340. function GetFieldData(Field: TField; Buffer: TDatarecord): JSValue; override;
  341. procedure SetFieldData(Field: TField; var Buffer{%H-}: TDatarecord; AValue : JSValue); override;
  342. function BookmarkValid(ABookmark: TBookmark): Boolean; override;
  343. function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; override;
  344. end;
  345. TJSONDataset = Class(TBaseJSONDataset)
  346. published
  347. Property FieldDefs;
  348. Property RowType;
  349. Property UseDateTimeFormatFields;
  350. Property Indexes;
  351. Property ActiveIndex;
  352. property Active;
  353. property BeforeOpen;
  354. property AfterOpen;
  355. property BeforeClose;
  356. property AfterClose;
  357. property BeforeInsert;
  358. property AfterInsert;
  359. property BeforeEdit;
  360. property AfterEdit;
  361. property BeforePost;
  362. property AfterPost;
  363. property BeforeCancel;
  364. property AfterCancel;
  365. property BeforeDelete;
  366. property AfterDelete;
  367. property BeforeScroll;
  368. property AfterScroll;
  369. property OnCalcFields;
  370. property OnDeleteError;
  371. property OnEditError;
  372. property OnFilterRecord;
  373. property OnNewRecord;
  374. property OnPostError;
  375. Property OnRecordResolved;
  376. property OnLoadFail;
  377. end;
  378. { TJSONObjectFieldMapper }
  379. // Fieldmapper to be used when the data is in an object
  380. TJSONObjectFieldMapper = Class(TJSONFieldMapper)
  381. Public
  382. Procedure RemoveField(Const FieldName : String; FieldIndex : Integer; Row : JSValue); override;
  383. procedure SetJSONDataForField(Const FieldName : String; FieldIndex{%H-} : Integer; Row,Data : JSValue); override;
  384. Function GetJSONDataForField(Const FieldName : String; FieldIndex{%H-} : Integer; Row : JSValue) : JSValue; override;
  385. Function CreateRow : JSValue; override;
  386. end;
  387. { TJSONArrayFieldMapper }
  388. // Fieldmapper to be used when the data is in an array
  389. TJSONArrayFieldMapper = Class(TJSONFieldMapper)
  390. Public
  391. Procedure RemoveField(Const FieldName : String; FieldIndex : Integer; Row : JSValue); override;
  392. procedure SetJSONDataForField(Const FieldName{%H-} : String; FieldIndex : Integer; Row,Data : JSValue); override;
  393. Function GetJSONDataForField(Const FieldName{%H-} : String; FieldIndex : Integer; Row : JSValue) : JSValue; override;
  394. Function CreateRow : JSValue; override;
  395. end;
  396. EJSONDataset = Class(EDatabaseError);
  397. implementation
  398. uses DateUtils;
  399. { TJSONIndexDef }
  400. procedure TJSONIndexDef.ClearIndex;
  401. begin
  402. FreeAndNil(FIndex);
  403. end;
  404. procedure TJSONIndexDef.BuildIndex(aDataset : TBaseJSONDataset);
  405. begin
  406. if Findex=Nil then
  407. FIndex:=TSortedJSONIndex.Create(aDataset,aDataset.Rows)
  408. else
  409. FIndex.ClearIndex;
  410. FIndex.CreateComparer(Self);
  411. FIndex.CreateIndex;
  412. end;
  413. { TJSONIndexDefs }
  414. function TJSONIndexDefs.GetD(aIndex : Integer): TJSONIndexDef;
  415. begin
  416. Result:=Items[aIndex] as TJSONIndexDef;
  417. end;
  418. procedure TJSONIndexDefs.SetD(aIndex : Integer; AValue: TJSONIndexDef);
  419. begin
  420. Items[aIndex]:=aValue;
  421. end;
  422. function TJSONIndexDefs.AddJSONIndexDef: TJSONIndexDef;
  423. begin
  424. Result:=Add as TJSONIndexDef;
  425. end;
  426. { TSortedJSONIndex }
  427. Function TSortedJSONIndex.MergeSort(aList : TJSArray) : TJSArray;
  428. Var
  429. temp : TJSArray;
  430. l,p,q,e,tail : integer;
  431. insize, nmerges, psize, qsize : Integer;
  432. begin
  433. if aList=Nil then
  434. Exit(Nil);
  435. L:=aList.length;
  436. Result:=TJSArray.new(l);
  437. if L=0 then exit;
  438. insize:=1;
  439. Repeat
  440. p:=0;
  441. Tail:=0;
  442. nmerges := 0; // count number of merges we do in this pass
  443. while (p<L) do
  444. begin
  445. Inc(nmerges); { there exists a merge to be done }
  446. { step `insize' places along from p }
  447. pSize:=L-P;
  448. if Insize<pSize then
  449. pSize:=InSize;
  450. Q:=P+pSize;
  451. qsize:=insize;
  452. //* now we have two lists; merge them */
  453. while (psize>0) or ((qsize > 0) and (Q<L)) do
  454. begin // /* decide whether next element of merge comes from p or q */
  455. if (psize=0) then
  456. begin // * p is empty; e must come from q. */
  457. e := q; Inc(q); Dec(qsize);
  458. end
  459. else if ((qsize = 0) or (q>=L)) then
  460. begin // * q is empty; e must come from p. */
  461. e := p; Inc(p); Dec(psize);
  462. end
  463. else if (FComparer.CompareRows(Integer(aList[p]),Integer(aList[q])) <= 0) then
  464. begin // * First element of p is lower (or same); * e must come from p. */
  465. e:=p; inc(p); Dec(psize);
  466. end
  467. else
  468. begin // * First element of q is lower; e must come from q. */
  469. e := q; Inc(q); Dec(qsize);
  470. end;
  471. Result[Tail]:=aList[e];
  472. Inc(tail);
  473. end;
  474. p:=q;
  475. end;
  476. // * If we have done only one merge, we're finished. */
  477. if (nmerges <= 1) then //* allow for nmerges==0, the empty list case */
  478. exit;
  479. // * Otherwise repeat, merging lists twice the size */
  480. InSize:=Insize * 2;
  481. // Swap lists for next round.
  482. Temp:=Result;
  483. Result:=aList;
  484. aList:=Temp;
  485. until false;
  486. end;
  487. destructor TSortedJSONIndex.Destroy;
  488. begin
  489. FreeAndNil(FComparer);
  490. Inherited;
  491. end;
  492. procedure TSortedJSONIndex.CreateComparer(aIndex: TJSONIndexDef);
  493. begin
  494. FreeAndNil(FComparer);
  495. FComparer:=TRecordComparer.Create(Dataset,aindex);
  496. end;
  497. procedure TSortedJSONIndex.CreateIndex;
  498. Var
  499. Lst : TJSArray;
  500. Len : Integer;
  501. begin
  502. // CreateIndex is called during constructor. We cannot build index then, so we exit
  503. if FComparer=Nil then
  504. exit;
  505. Len:=FRows.Length-1;
  506. // Temp list, mergsort destroys list
  507. Lst:=TJSArray.New(Len+1);
  508. While Len>=0 do
  509. begin
  510. Lst[Len]:=Len;
  511. Dec(Len);
  512. end;
  513. FList:=MergeSort(Lst);
  514. end;
  515. procedure TSortedJSONIndex.AppendToIndex;
  516. begin
  517. // In theory, we could sort the rest of the list, and then merge the 2 sublists.
  518. CreateIndex;
  519. end;
  520. function TSortedJSONIndex.FindPos(aRecordIndex: Integer): Integer;
  521. Var
  522. L,R,I, CompareRes : Integer;
  523. begin
  524. if not Assigned(FComparer) then
  525. exit;
  526. L := 0;
  527. R := Count - 1;
  528. while (L<=R) do
  529. begin
  530. I := L + (R - L) div 2;
  531. CompareRes := FComparer.CompareRows(aRecordIndex, Integer(Flist[I]));
  532. if (CompareRes>0) then
  533. L := I+1
  534. else
  535. begin
  536. R := I-1;
  537. if (CompareRes=0) then
  538. begin
  539. if Unique then
  540. L := I; // forces end of while loop
  541. end;
  542. end;
  543. end;
  544. Result:=L;
  545. end;
  546. function TSortedJSONIndex.Append(aRecordIndex: Integer): Integer;
  547. begin
  548. Result:=FindPos(aRecordIndex);
  549. // insert in list
  550. FList.Splice(Result,0,aRecordIndex);
  551. end;
  552. function TSortedJSONIndex.FindRecord(aRecordIndex: Integer): Integer;
  553. begin
  554. Result:=FList.indexOf(aRecordIndex);
  555. end;
  556. function TSortedJSONIndex.Update(aRecordIndex: Integer): Integer;
  557. Var
  558. aCurrentIndex : Integer;
  559. begin
  560. // Old pos
  561. aCurrentIndex:=FindRecord(aRecordIndex);
  562. // New pos
  563. Result:=FindPos(aRecordIndex);
  564. if Result<>aCurrentIndex then
  565. FList.Splice(Result,0,FList.Splice(aCurrentIndex,1)[0])
  566. end;
  567. { TFloatFieldComparer }
  568. function TFloatFieldComparer.Compare(RowIndex: Integer; aValue: JSValue): Integer;
  569. var
  570. D1,D2 : Double;
  571. begin
  572. D1:=Double(GetFieldValue(Rowindex));
  573. D2:=Double(aValue);
  574. Result:=Round(D1-D2);
  575. end;
  576. { TDateTimeFieldComparer }
  577. function TDateTimeFieldComparer.Compare(RowIndex: Integer; aValue: JSValue): Integer;
  578. var
  579. D1,D2 : TDateTime;
  580. Function ToDate(v: JSValue) : TDateTime;
  581. begin
  582. if IsDate(v) then
  583. Result:= JSDateToDateTime(TJSDate(v))
  584. else
  585. Result:=Dataset.ConvertDateTimeField(String(v),Self.Field);
  586. end;
  587. begin
  588. D1:=ToDate(GetFieldValue(RowIndex));
  589. D2:=ToDate(aValue);
  590. Result:=Round(D1-D2);
  591. end;
  592. { TBooleanFieldComparer }
  593. function TBooleanFieldComparer.Compare(RowIndex: Integer; aValue: JSValue): Integer;
  594. var
  595. B1,B2 : Boolean;
  596. begin
  597. B1:=Boolean(GetFieldValue(Rowindex));
  598. B2:=Boolean(aValue);
  599. Result:=Ord(B1)-Ord(B2);
  600. end;
  601. { TNativeIntFieldComparer }
  602. function TNativeIntFieldComparer.Compare(RowIndex: Integer; aValue: JSValue): Integer;
  603. var
  604. I1,I2 : NativeInt;
  605. begin
  606. I1:=NativeInt(GetFieldValue(Rowindex));
  607. I2:=NativeInt(aValue);
  608. Result:=I1-I2;
  609. end;
  610. { TStringFieldComparer }
  611. function TStringFieldComparer.Compare(RowIndex: Integer; aValue: JSValue): Integer;
  612. var
  613. S1,S2 : String;
  614. begin
  615. S1:=String(GetFieldValue(Rowindex));
  616. S2:=String(aValue);
  617. if loPartialKey in Options then
  618. S1:=Copy(S1,1,Length(S2));
  619. if loCaseInsensitive in options then
  620. Result := CompareText(S1,S2)
  621. else
  622. Result := CompareStr(S1,S2);
  623. end;
  624. { TFieldComparer }
  625. constructor TFieldComparer.Create(aDataset: TBaseJSONDataset; aField: TField; aValue: JSValue; aOptions: TLocateOptions);
  626. begin
  627. FField:=AField;
  628. FValue:=aValue;
  629. FOptions:=aOptions;
  630. FDataset:=aDataset;
  631. end;
  632. function TFieldComparer.GetFieldValue(RowIndex: integer): JSValue;
  633. begin
  634. Result:=FDataset.FieldMapper.GetJSONDataForField(FField,FDataset.FRows[Rowindex]);
  635. end;
  636. function TFieldComparer.CompareRows(RowIndex1, RowIndex2: Integer): Integer;
  637. begin
  638. Result:=Compare(RowIndex1,GetFieldValue(RowIndex2));
  639. end;
  640. function TFieldComparer.Compare(RowIndex: Integer): Integer;
  641. begin
  642. Result:=Compare(RowIndex,FValue);
  643. end;
  644. { TRecordComparer }
  645. function TRecordComparer.GetFieldComparer(Index: Integer): TFieldComparer;
  646. begin
  647. if (Index<0) or (Index>=Length(Fitems)) then
  648. Raise EListError.CreateFmt('Index out of bounds: %d not in [%d,%d]',[Index,0,Length(Fitems)-1]);
  649. Result:=Items[Index];
  650. end;
  651. procedure TRecordComparer.ConstructItems(aFields : String);
  652. Var
  653. L : TFPlist;
  654. FCC : TFieldComparerClass;
  655. F : TField;
  656. I : Integer;
  657. begin
  658. L:=TFPList.Create;
  659. try
  660. Dataset.GetFieldList(L,aFields);
  661. if Not Indexbased and (L.Count<>Length(FValues)) then
  662. Raise EDatabaseError.CreateFmt('Array of values has different length (%d) from array of fields (%d)',[Length(FValues), L.Count]);
  663. SetLength(FItems,L.Count);
  664. For I:=0 to L.Count-1 do
  665. begin
  666. F:=TField(L[i]);
  667. FCC:=DataTypeToComparerClass(F.DataType);
  668. If FCC=Nil then
  669. Raise EDatabaseError.CreateFmt('Cannot locate on field %s of type %s)',[F.FieldName,GetEnumName(TypeInfo(TFieldType),Ord(F.DataType))]);
  670. if IndexBased then
  671. Fitems[i]:=FCC.Create(FDataset,F,Null,FOptions)
  672. else
  673. Fitems[i]:=FCC.Create(FDataset,F,FValues[i],FOptions);
  674. end;
  675. finally
  676. L.Free;
  677. end;
  678. end;
  679. function TRecordComparer.DataTypeToComparerClass(aFieldType: TFieldType): TFieldComparerClass;
  680. begin
  681. Case aFieldType of
  682. ftMemo, ftFixedChar,ftString :
  683. Result:=TStringFieldComparer;
  684. ftAutoInc, ftInteger, ftLargeInt:
  685. Result:=TNativeIntFieldComparer;
  686. ftBoolean:
  687. Result:=TBooleanFieldComparer;
  688. ftFloat:
  689. Result:=TFloatFieldComparer;
  690. ftDate, ftTime, ftDateTime:
  691. Result:=TDateTimeFieldComparer;
  692. else
  693. result:=Nil;
  694. end;
  695. end;
  696. function TRecordComparer.Compare(aRowindex: integer): Integer;
  697. Var
  698. I,L : Integer;
  699. begin
  700. Result:=0;
  701. I:=0;
  702. L:=Length(FItems);
  703. While (Result=0) and (I<L) do
  704. begin
  705. Result:=Fitems[i].Compare(aRowindex);
  706. Inc(I);
  707. end;
  708. end;
  709. function TRecordComparer.CompareRows(aRowindex1, aRowIndex2: integer): Integer;
  710. Var
  711. I,L : Integer;
  712. begin
  713. Result:=0;
  714. I:=0;
  715. L:=Length(FItems);
  716. While (Result=0) and (I<L) do
  717. begin
  718. Result:=Fitems[i].CompareRows(aRowindex1,aRowIndex2);
  719. if (Result<>0) and Fitems[i].Desc then
  720. Result:=-Result;
  721. Inc(I);
  722. end;
  723. end;
  724. procedure TRecordComparer.updateFromIndex(aIndex: TJSONIndexDef);
  725. Var
  726. L : TFPList;
  727. I : Integer;
  728. begin
  729. L:=TFPList.Create;
  730. try
  731. if (aIndex.CaseInsFields<>'') then
  732. begin
  733. Dataset.GetFieldList(L,aIndex.CaseInsFields);
  734. for I:=0 to Length(FItems)-1 do
  735. if L.IndexOf(FItems[i].Field)<>-1 then
  736. Fitems[i].Options:=Fitems[i].Options+[loCaseInsensitive];
  737. end;
  738. L.Clear;
  739. Dataset.GetFieldList(L,aIndex.DescFields);
  740. for I:=0 to Length(FItems)-1 do
  741. Fitems[i].Desc:=(ixDescending in aIndex.Options) or (L.IndexOf(FItems[i].Field)<>-1);
  742. finally
  743. L.Free;
  744. end;
  745. end;
  746. constructor TRecordComparer.Create(aDataset: TBaseJSONDataset; aFields: String; aValues: JSValue; aOptions: TLocateOptions);
  747. begin
  748. FDataset:=aDataset;
  749. if isArray(aValues) then
  750. FValues:=TJSValueDynArray(aValues)
  751. else
  752. begin
  753. SetLength(FValues,1);
  754. FValues[0]:=Avalues;
  755. end;
  756. Foptions:=aOptions;
  757. ConstructItems(aFields);
  758. end;
  759. constructor TRecordComparer.Create(aDataset: TBaseJSONDataset; aIndex: TJSONIndexDef);
  760. begin
  761. FDataset:=aDataset;
  762. FIndexBased:=True;
  763. if ixCaseInsensitive in aIndex.Options then
  764. FOptions:=[loCaseInsensitive];
  765. ConstructItems(aIndex.Fields);
  766. UpdateFromIndex(aIndex);
  767. end;
  768. destructor TRecordComparer.Destroy;
  769. Var
  770. I : Integer;
  771. begin
  772. For I:=0 to Length(FItems)-1 do
  773. FItems[i].Free;
  774. inherited Destroy;
  775. end;
  776. { TDefaultJSONIndex }
  777. procedure TDefaultJSONIndex.CreateIndex;
  778. Var
  779. I : Integer;
  780. begin
  781. For I:=0 to FRows.length-1 do
  782. FList[i]:=I;
  783. end;
  784. procedure TDefaultJSONIndex.AppendToIndex;
  785. Var
  786. I,L : Integer;
  787. begin
  788. L:=FList.Length;
  789. FList.Length:=FRows.Length;
  790. For I:=L to FRows.Length-1 do
  791. FList[i]:=I;
  792. end;
  793. function TDefaultJSONIndex.Append(aRecordIndex: Integer): Integer;
  794. begin
  795. Result:=FList.Push(aRecordIndex)-1;
  796. end;
  797. function TDefaultJSONIndex.Insert(aCurrentIndex, aRecordIndex: Integer
  798. ): Integer;
  799. begin
  800. FList.splice(aCurrentIndex, 0, aRecordIndex);
  801. Result:=aCurrentIndex;
  802. end;
  803. function TDefaultJSONIndex.FindRecord(aRecordIndex: Integer): Integer;
  804. begin
  805. Result:=FList.indexOf(aRecordIndex);
  806. end;
  807. function TDefaultJSONIndex.Update(aRecordIndex: Integer
  808. ): Integer;
  809. begin
  810. Result:=aRecordIndex;
  811. end;
  812. { TJSONIndex }
  813. constructor TJSONIndex.Create(aDataset: TBaseJSONDataset; aRows: TJSArray);
  814. begin
  815. FRows:=aRows;
  816. FList:=TJSArray.New(FRows.length);
  817. FDataset:=aDataset;
  818. CreateIndex;
  819. end;
  820. function TJSONIndex.Delete(aListIndex: Integer): Integer;
  821. Var
  822. a : TJSArray;
  823. begin
  824. A:=FList.Splice(aListIndex,1);
  825. If a.Length>0 then
  826. Result:=Integer(A[0])
  827. else
  828. Result:=-1;
  829. end;
  830. function TJSONIndex.Insert(aCurrentIndex, aRecordIndex: Integer): Integer;
  831. begin
  832. Result:=Append(aRecordIndex);
  833. end;
  834. function TJSONIndex.GetCount: Integer;
  835. begin
  836. Result:=FList.Length;
  837. end;
  838. procedure TJSONIndex.ClearIndex;
  839. begin
  840. FList.Length:=0;
  841. end;
  842. function TJSONIndex.GetRecordIndex(aListIndex : Integer): NativeInt;
  843. begin
  844. if isUndefined(FList[aListIndex]) then
  845. Result:=-1
  846. else
  847. Result:=NativeInt(FList[aListIndex]);
  848. end;
  849. { TJSONFieldMapper }
  850. function TJSONFieldMapper.CopyRow(aRow: JSValue): JSValue;
  851. begin
  852. Result:=TJSJSON.parse(TJSJSON.stringify(aRow));
  853. end;
  854. function TJSONFieldMapper.GetJSONDataForField(F: TField; Row: JSValue ): JSValue;
  855. begin
  856. // This supposes that Index is correct, i.e. the field positions have not been changed.
  857. Result:=GetJSONDataForField(F.FieldName,F.Index,Row);
  858. end;
  859. procedure TJSONFieldMapper.SetJSONDataForField(F: TField; Row,Data: JSValue);
  860. begin
  861. SetJSONDataForField(F.FieldName,F.Index,Row,Data);
  862. end;
  863. { TJSONArrayFieldMapper }
  864. procedure TJSONArrayFieldMapper.RemoveField(const FieldName: String; FieldIndex: Integer; Row: JSValue);
  865. begin
  866. TJSArray(Row).Splice(FieldIndex,1);
  867. end;
  868. procedure TJSONArrayFieldMapper.SetJSONDataForField(const FieldName: String;
  869. FieldIndex: Integer; Row, Data: JSValue);
  870. begin
  871. TJSValueDynArray(Row)[FieldIndex]:=Data;
  872. end;
  873. function TJSONArrayFieldMapper.GetJSONDataForField(const FieldName: String; FieldIndex: Integer; Row: JSValue): JSValue;
  874. begin
  875. Result:=TJSValueDynArray(Row)[FieldIndex];
  876. end;
  877. function TJSONArrayFieldMapper.CreateRow: JSValue;
  878. begin
  879. Result:=TJSArray.New;
  880. end;
  881. { TJSONObjectFieldMapper }
  882. procedure TJSONObjectFieldMapper.RemoveField(const FieldName: String; FieldIndex: Integer; Row: JSValue);
  883. begin
  884. jsDelete(Row,FieldName);
  885. end;
  886. procedure TJSONObjectFieldMapper.SetJSONDataForField(const FieldName: String;
  887. FieldIndex: Integer; Row, Data: JSValue);
  888. begin
  889. TJSObject(Row).Properties[FieldName]:=Data;
  890. end;
  891. function TJSONObjectFieldMapper.GetJSONDataForField(const FieldName: String;
  892. FieldIndex: Integer; Row: JSValue): JSValue;
  893. begin
  894. Result:=TJSObject(Row).Properties[FieldName];
  895. end;
  896. function TJSONObjectFieldMapper.CreateRow: JSValue;
  897. begin
  898. Result:=TJSObject.New;
  899. end;
  900. procedure TBaseJSONDataSet.SetMetaData(AValue: TJSObject);
  901. begin
  902. CheckInActive;
  903. FMetaData:=AValue;
  904. end;
  905. procedure TBaseJSONDataSet.SetIndexes(AValue: TJSONIndexDefs);
  906. begin
  907. if FIndexes=AValue then Exit;
  908. FIndexes.Assign(aValue);
  909. if Active then
  910. BuildIndexes;
  911. end;
  912. procedure TBaseJSONDataSet.SetActiveIndex(AValue: String);
  913. begin
  914. if FActiveIndex=AValue then Exit;
  915. FActiveIndex:=AValue;
  916. if (csLoading in ComponentState) then
  917. exit;
  918. ActivateIndex(Active);
  919. end;
  920. procedure TBaseJSONDataSet.ActivateIndex(Build : Boolean);
  921. Var
  922. Idx : TJSONIndexDef;
  923. begin
  924. if (FActiveIndex<>'') then
  925. Idx:=FIndexes.Find(FActiveIndex) as TJSONIndexDef
  926. else
  927. Idx:=nil;
  928. if Idx=Nil then
  929. FCurrentIndex:=FDefaultIndex
  930. else
  931. begin
  932. if (Idx.Index=Nil) and Build then
  933. Idx.BuildIndex(Self);
  934. FCurrentIndex:=Idx.Index;
  935. end;
  936. if Active then
  937. Resync([rmCenter]);
  938. end;
  939. procedure TBaseJSONDataSet.AddToRows(AValue: TJSArray);
  940. begin
  941. if FRows=Nil then
  942. FRows:=AValue
  943. else
  944. begin
  945. FRows:=FRows.Concat(AValue);
  946. AppendToIndexes;
  947. end;
  948. end;
  949. procedure TBaseJSONDataSet.SetRows(AValue: TJSArray);
  950. begin
  951. if AValue=FRows then exit;
  952. CheckInActive;
  953. FRows:=Nil;
  954. AddToRows(AValue);
  955. end;
  956. procedure TBaseJSONDataSet.SetRowType(AValue: TJSONRowType);
  957. begin
  958. if FRowType=AValue then Exit;
  959. CheckInactive;
  960. FRowType:=AValue;
  961. end;
  962. function TBaseJSONDataSet.ConvertDateTimeToNative(aField : TField; aValue: TDateTime): JSValue;
  963. begin
  964. if jsISNan(aValue) then
  965. Result:=Null
  966. else
  967. Result:=FormatDateTimeField(aValue,aField)
  968. end;
  969. function TBaseJSONDataSet.AllocRecordBuffer: TDataRecord;
  970. begin
  971. Result.data:=TJSObject.New;
  972. Result.bookmark:=null;
  973. Result.state:=rsNew;
  974. end;
  975. // the next two are particularly ugly.
  976. procedure TBaseJSONDataSet.InternalInitRecord(var Buffer: TDataRecord);
  977. begin
  978. // Writeln('TBaseJSONDataSet.InternalInitRecord');
  979. Buffer.Data:=FFieldMapper.CreateRow;
  980. Buffer.bookmark:=null;
  981. Buffer.state:=rsNew;
  982. end;
  983. procedure TBaseJSONDataSet.FreeRecordBuffer (var Buffer: TDataRecord);
  984. begin
  985. Buffer.Data:=Null;
  986. Buffer.bookmark:=null;
  987. Buffer.state:=rsNew;
  988. end;
  989. procedure TBaseJSONDataSet.GetBookmarkData(Buffer: TDataRecord; var Data: TBookmark);
  990. begin
  991. Data.Data:=Buffer.bookmark;
  992. end;
  993. function TBaseJSONDataSet.GetBookmarkFlag(Buffer: TDataRecord): TBookmarkFlag;
  994. begin
  995. Result :=Buffer.BookmarkFlag;
  996. end;
  997. function TBaseJSONDataSet.GetRecNo: Integer;
  998. Var
  999. bkmIdx : Integer;
  1000. begin
  1001. bkmIdx:=Integer(ActiveBuffer.bookmark);
  1002. Result:=FCurrentIndex.FindRecord(bkmIdx)+1;
  1003. end;
  1004. procedure TBaseJSONDataSet.InternalInitFieldDefs;
  1005. begin
  1006. If Assigned(FMetaData) then
  1007. MetaDataToFieldDefs;
  1008. if (FieldDefs.Count=0) then
  1009. Raise EJSONDataset.Create('No fields found');
  1010. end;
  1011. procedure TBaseJSONDataSet.FreeData;
  1012. Var
  1013. I : integer;
  1014. begin
  1015. If FOwnsData then
  1016. begin
  1017. FRows:=Nil;
  1018. FMetaData:=Nil;
  1019. end;
  1020. For I:=0 to FIndexes.Count-1 do
  1021. FIndexes[i].ClearIndex;
  1022. FCurrentIndex:=Nil;
  1023. FreeAndNil(FDefaultindex);
  1024. FreeAndNil(FFieldMapper);
  1025. FCurrentIndex:=Nil;
  1026. FDeletedRows:=Nil;
  1027. end;
  1028. procedure TBaseJSONDataSet.AppendToIndexes;
  1029. begin
  1030. FDefaultIndex.AppendToIndex;
  1031. if Assigned(FCurrentIndex) and (FCurrentIndex<>FDefaultIndex) then
  1032. FCurrentIndex.AppendToIndex;
  1033. end;
  1034. procedure TBaseJSONDataSet.CreateIndexes;
  1035. begin
  1036. FDefaultIndex:=TDefaultJSONIndex.Create(Self,FRows);
  1037. AppendToIndexes;
  1038. if FCurrentIndex=Nil then
  1039. FCurrentIndex:=FDefaultIndex;
  1040. end;
  1041. function TBaseJSONDataSet.FilterExpressionClass : TFPExpressionParserClass;
  1042. begin
  1043. Result:=TFPExpressionParser;
  1044. end;
  1045. function TBaseJSONDataSet.GetFilterIsNull(const Args: TExprParameterArray): TFPExpressionResult;
  1046. begin
  1047. Result.ResultType:=rtBoolean;
  1048. Result.ResValue:=FieldByName(String(Args[0].resValue)).IsNull;
  1049. end;
  1050. function TBaseJSONDataSet.FieldTypeToExpressionType(aDataType : TFieldType) : TResultType;
  1051. begin
  1052. Case aDataType of
  1053. ftMemo,
  1054. ftFixedChar,
  1055. ftString : Result:=rtString;
  1056. ftInteger,
  1057. ftAutoInc,
  1058. ftLargeInt : Result:=rtInteger;
  1059. ftBoolean : Result:=rtBoolean;
  1060. ftFloat : Result:=rtFloat;
  1061. ftDate,
  1062. ftTime,
  1063. ftDateTime : Result:=rtDateTime;
  1064. else
  1065. DatabaseErrorFmt('Fields of type %s are not supported in filter expressions.',[Fieldtypenames[aDataType]],Self);
  1066. end;
  1067. end;
  1068. function TBaseJSONDataSet.GetFilterField(const AName: String): TFPExpressionResult;
  1069. Var
  1070. F : TField;
  1071. C : Currency;
  1072. begin
  1073. F:=FieldByName(aName);
  1074. Result.resultType:=FieldTypeToExpressionType(F.DataType);
  1075. case Result.resultType of
  1076. rtBoolean : Result.resValue:=F.AsBoolean;
  1077. rtInteger : Result.resValue:=F.AsLargeInt;
  1078. rtFloat : Result.resValue:=F.AsFloat;
  1079. rtDateTime : Result.resValue:=F.AsDateTime;
  1080. rtString : Result.resValue:=F.AsString;
  1081. rtCurrency :
  1082. begin
  1083. C:=Currency(F.AsFloat);
  1084. Result.resValue:=C;
  1085. end;
  1086. end;
  1087. // Writeln('Filtering field ',aName,'value: ',result.resValue);
  1088. end;
  1089. function TBaseJSONDataSet.CreateFilterExpression : TFPExpressionParser;
  1090. Var
  1091. I : Integer;
  1092. begin
  1093. Result:=FilterExpressionClass.Create(Self);
  1094. for I:=0 to Fields.Count-1 do
  1095. Result.Identifiers.AddVariable(Fields[i].FieldName,FieldTypeToExpressionType(Fields[i].DataType),@GetFilterField);
  1096. Result.Identifiers.AddFunction('IsNull','B','S',@GetFilterIsNull);
  1097. Result.Expression:=Filter;
  1098. end;
  1099. function TBaseJSONDataSet.DoFilterRecord : Boolean;
  1100. Var
  1101. DS : TDatasetState;
  1102. begin
  1103. // Writeln('Filtering');
  1104. Result:=True;
  1105. DS:=SetTempState(dsFilter);
  1106. try
  1107. if Assigned(OnFilterRecord) then
  1108. begin
  1109. OnFilterRecord(Self,Result);
  1110. if Not Result then
  1111. Exit;
  1112. end;
  1113. if not Filtered or (Filter='') then
  1114. Exit;
  1115. if (FFilterExpression=Nil) then
  1116. FFilterExpression:=CreateFilterExpression;
  1117. Result:=FFilterExpression.AsBoolean;
  1118. finally
  1119. RestoreState(DS);
  1120. end;
  1121. end;
  1122. function TBaseJSONDataSet.GetRecord(var Buffer: TDataRecord; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
  1123. Var
  1124. BkmIdx : Integer;
  1125. recordAccepted : Boolean;
  1126. begin
  1127. Result := grOK; // default
  1128. Repeat
  1129. recordAccepted:=True;
  1130. case GetMode of
  1131. gmNext: // move on
  1132. if fCurrent < fCurrentIndex.Count - 1 then
  1133. Inc (fCurrent)
  1134. else
  1135. Result := grEOF; // end of file
  1136. gmPrior: // move back
  1137. if fCurrent > 0 then
  1138. Dec (fCurrent)
  1139. else
  1140. Result := grBOF; // begin of file
  1141. gmCurrent: // check if empty
  1142. if (FCurrent<0) or (fCurrent >= fCurrentIndex.Count) then
  1143. Result := grEOF;
  1144. end;
  1145. if Result = grOK then // read the data
  1146. begin
  1147. BkmIdx:=FCurrentIndex.RecordIndex[FCurrent];
  1148. Buffer.Data:=FRows[bkmIdx];
  1149. Buffer.BookmarkFlag := bfCurrent;
  1150. Buffer.Bookmark:=BkmIdx;
  1151. CalculateFields(Buffer);
  1152. if Filtered then
  1153. begin
  1154. FFilterRow:=Buffer.Data;
  1155. recordAccepted:=DoFilterRecord;
  1156. if Not RecordAccepted and (GetMode=gmCurrent) then
  1157. begin
  1158. // Transform to EOF.
  1159. RecordAccepted:=True;
  1160. Result:=grEOF;
  1161. end;
  1162. end;
  1163. end;
  1164. until recordAccepted;
  1165. end;
  1166. function TBaseJSONDataSet.GetRecordCount: Integer;
  1167. begin
  1168. if Assigned(FCurrentIndex) then
  1169. Result:=FCurrentIndex.Count
  1170. else
  1171. Result:=0;
  1172. end;
  1173. function TBaseJSONDataSet.GetRecordSize: Word;
  1174. begin
  1175. Result := 0; // actual data without house-keeping
  1176. end;
  1177. procedure TBaseJSONDataSet.InternalClose;
  1178. begin
  1179. // disconnect and destroy field objects
  1180. BindFields (False);
  1181. if DefaultFields then
  1182. DestroyFields;
  1183. FreeData;
  1184. end;
  1185. procedure TBaseJSONDataSet.InternalDelete;
  1186. Var
  1187. Idx : Integer;
  1188. begin
  1189. Idx:=FCurrentIndex.Delete(FCurrent);
  1190. if (Idx<>-1) then
  1191. begin
  1192. // Add code here to Delete from other indexes as well.
  1193. // ...
  1194. // Add to array of deleted records.
  1195. if Not Assigned(FDeletedRows) then
  1196. FDeletedRows:=TJSArray.New(FRows[idx])
  1197. else
  1198. FDeletedRows.Push(FRows[Idx]);
  1199. FRows[Idx]:=Undefined;
  1200. end;
  1201. end;
  1202. procedure TBaseJSONDataSet.InternalFirst;
  1203. begin
  1204. FCurrent := -1;
  1205. end;
  1206. procedure TBaseJSONDataSet.InternalGotoBookmark(ABookmark: TBookmark);
  1207. begin
  1208. if isNumber(ABookmark.Data) then
  1209. FCurrent:=FCurrentIndex.FindRecord(Integer(ABookmark.Data));
  1210. // Writeln('Fcurrent', FCurrent,' from ',ABookmark.Data);
  1211. end;
  1212. procedure TBaseJSONDataSet.InternalInsert;
  1213. Var
  1214. I : Integer;
  1215. D : TFieldDef;
  1216. begin
  1217. // Writeln('TBaseJSONDataSet.InternalInsert');
  1218. FEditRow:=ActiveBuffer.Data;
  1219. For I:=0 to FieldDefs.Count-1 do
  1220. begin
  1221. D:=FieldDefs[i];
  1222. FFieldMapper.SetJSONDataForField(D.Name,D.Index,FEditRow,Null);
  1223. end;
  1224. end;
  1225. procedure TBaseJSONDataSet.RemoveCalcFields(Buf : JSValue);
  1226. Var
  1227. i : integer;
  1228. begin
  1229. For I:=0 to Fields.Count-1 do
  1230. if Fields[i].FieldKind in [fkCalculated,fkInternalCalc,fkLookup] then
  1231. FieldMapper.RemoveField(FIelds[i].FieldName,FIelds[i].Index,Buf);
  1232. end;
  1233. procedure TBaseJSONDataSet.InternalEdit;
  1234. begin
  1235. // Writeln('TBaseJSONDataSet.InternalEdit: ');
  1236. FEditIdx:=FCurrentIndex.RecordIndex[FCurrent];
  1237. if not isUndefined(Rows[FEditIdx]) then
  1238. begin
  1239. FEditRow:=FieldMapper.CopyRow(Rows[FEditIdx]);
  1240. RemoveCalcFields(FEditRow);
  1241. end
  1242. else
  1243. FEditRow:=FFieldMapper.CreateRow;
  1244. // Writeln('TBaseJSONDataSet.InternalEdit: ',FEditRow);
  1245. end;
  1246. procedure TBaseJSONDataSet.InternalCancel;
  1247. begin
  1248. FEditIdx:=-1;
  1249. FEditRow:=Nil;
  1250. end;
  1251. procedure TBaseJSONDataSet.InternalLast;
  1252. begin
  1253. // The first thing that will happen is a GetPrior Record.
  1254. FCurrent:=FCurrentIndex.Count;
  1255. end;
  1256. procedure TBaseJSONDataSet.InitDateTimeFields;
  1257. begin
  1258. // Do nothing
  1259. end;
  1260. procedure TBaseJSONDataSet.InternalOpen;
  1261. begin
  1262. FreeAndNil(FFieldMapper);
  1263. FFieldMapper:=CreateFieldMapper;
  1264. IF (FRows=Nil) then // opening from fielddefs ?
  1265. begin
  1266. FRows:=TJSArray.New;
  1267. OwnsData:=True;
  1268. end;
  1269. CreateIndexes;
  1270. InternalInitFieldDefs;
  1271. if DefaultFields then
  1272. CreateFields;
  1273. BindFields (True);
  1274. InitDateTimeFields;
  1275. if FActiveIndex<>'' then
  1276. ActivateIndex(True);
  1277. FCurrent := -1;
  1278. end;
  1279. procedure TBaseJSONDataSet.InternalPost;
  1280. Var
  1281. I,NewIdx,NewCurrent,Idx : integer;
  1282. B : TBookmark;
  1283. begin
  1284. NewCurrent:=-1;
  1285. GetBookMarkData(ActiveBuffer,B);
  1286. if (State=dsInsert) then
  1287. begin // Insert or Append
  1288. Idx:=FRows.push(FEditRow)-1;
  1289. if GetBookMarkFlag(ActiveBuffer)=bfEOF then
  1290. begin // Append
  1291. FDefaultIndex.Append(Idx);
  1292. for I:=0 to FIndexes.Count-1 do
  1293. if Assigned(FIndexes[i].Findex) then
  1294. begin
  1295. NewIdx:=FIndexes[i].Findex.Append(Idx);
  1296. if FIndexes[i].Findex=FCurrentIndex then
  1297. NewCurrent:=NewIdx;
  1298. end;
  1299. end
  1300. else // insert
  1301. begin
  1302. FCurrent:=FDefaultIndex.Insert(FCurrent,Idx);
  1303. for I:=0 to FIndexes.Count-1 do
  1304. if Assigned(FIndexes[i].Findex) then
  1305. begin
  1306. NewIdx:=FIndexes[i].Findex.Append(Idx);
  1307. if FIndexes[i].Findex=FCurrentIndex then
  1308. NewCurrent:=NewIdx;
  1309. end;
  1310. end;
  1311. end
  1312. else
  1313. begin // Edit
  1314. if (FEditIdx=-1) then
  1315. DatabaseErrorFmt('Failed to retrieve record index for record %d',[FCurrent]);
  1316. // Update source record
  1317. Idx:=FEditIdx;
  1318. FRows[Idx]:=FEditRow;
  1319. FDefaultIndex.Update(Idx);
  1320. // Must replace this by updating all indexes.
  1321. // Note that this will change current index.
  1322. for I:=0 to FIndexes.Count-1 do
  1323. begin
  1324. // Determine old index.
  1325. NewIdx:=FCurrentIndex.Update(Idx);
  1326. if Assigned(FIndexes[i].Findex) then
  1327. if FIndexes[i].Findex=FCurrentIndex then
  1328. NewCurrent:=NewIdx;
  1329. end;
  1330. end;
  1331. // We have an active index, set current to that index.
  1332. if NewCurrent<>-1 then
  1333. FCurrent:=NewCurrent;
  1334. FEditIdx:=-1;
  1335. FEditRow:=Nil;
  1336. end;
  1337. procedure TBaseJSONDataSet.InternalSetToRecord(Buffer: TDataRecord);
  1338. begin
  1339. FCurrent:=FCurrentIndex.FindRecord(Integer(Buffer.Bookmark));
  1340. end;
  1341. procedure TBaseJSONDataSet.SetFilterText(const Value: string);
  1342. begin
  1343. inherited SetFilterText(Value);
  1344. FreeAndNil(FFilterExpression);
  1345. if Active then
  1346. Resync([rmCenter]);
  1347. end;
  1348. procedure TBaseJSONDataSet.SetFiltered(Value: Boolean);
  1349. begin
  1350. inherited SetFiltered(Value);
  1351. FreeAndNil(FFilterExpression);
  1352. if Active then
  1353. Resync([rmCenter]);
  1354. end;
  1355. function TBaseJSONDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
  1356. begin
  1357. If UseDateTimeFormatFields and (FieldType in [ftDate,ftDateTime,ftTime]) then
  1358. case FieldType of
  1359. ftDate : Result:=TJSONDateField;
  1360. ftDateTime : Result:=TJSONDateTimeField;
  1361. ftTime : Result:=TJSONTimeField;
  1362. end
  1363. else
  1364. Result:=inherited GetFieldClass(FieldType);
  1365. end;
  1366. function TBaseJSONDataSet.IsCursorOpen: Boolean;
  1367. begin
  1368. Result := Assigned(FDefaultIndex);
  1369. end;
  1370. function TBaseJSONDataSet.BookmarkValid(ABookmark: TBookmark): Boolean;
  1371. begin
  1372. Result:=isNumber(ABookmark.Data);
  1373. end;
  1374. procedure TBaseJSONDataSet.SetBookmarkData(var Buffer: TDataRecord; Data: TBookmark);
  1375. begin
  1376. Buffer.Bookmark:=Data.Data;
  1377. // Writeln('Set Bookmark from: ',Data.Data);
  1378. end;
  1379. function TBaseJSONDataSet.ConvertDateTimeField(S : String; F : TField) : TDateTime;
  1380. Var
  1381. Ptrn : string;
  1382. begin
  1383. Result:=0;
  1384. Ptrn:='';
  1385. Case F.DataType of
  1386. ftDate : if F is TJSONDateField then
  1387. Ptrn:=(F as TJSONDateField).DateFormat;
  1388. ftTime : if F is TJSONTimeField then
  1389. Ptrn:=(F as TJSONTimeField).TimeFormat;
  1390. ftDateTime : if F is TJSONDateTimeField then
  1391. Ptrn:=(F as TJSONDateTimeField).DateTimeFormat;
  1392. end;
  1393. If (Ptrn='') then
  1394. Result := DefaultConvertToDateTime(F,S,True)
  1395. else
  1396. Result:=ScanDateTime(ptrn,S,1);
  1397. end;
  1398. function TBaseJSONDataSet.FormatDateTimeField(DT: TDateTime; F: TField
  1399. ): String;
  1400. Var
  1401. Ptrn : string;
  1402. begin
  1403. Result:='';
  1404. Ptrn:='';
  1405. Case F.DataType of
  1406. ftDate : if F is TJSONDateField then
  1407. Ptrn:=TJSONDateField(F).DateFormat;
  1408. ftTime : if F is TJSONTimeField then
  1409. Ptrn:=TJSONTimeField(F).TimeFormat;
  1410. ftDateTime : if F is TJSONDateTimeField then
  1411. Ptrn:=TJSONDateTimeField(F).DateTimeFormat;
  1412. end;
  1413. If (Ptrn='') then
  1414. Result := DateTimeToRFC3339(DT)
  1415. else
  1416. Result:=FormatDateTime(ptrn,DT);
  1417. end;
  1418. function TBaseJSONDataSet.CreateFieldMapper: TJSONFieldMapper;
  1419. begin
  1420. if FRowType=rtJSONArray then
  1421. Result:=TJSONArrayFieldMapper.Create
  1422. else
  1423. Result:=TJSONObjectFieldMapper.Create;
  1424. end;
  1425. function TBaseJSONDataSet.GetFieldData(Field: TField; Buffer: TDatarecord): JSValue;
  1426. var
  1427. R : JSValue;
  1428. begin
  1429. if State in [dsCalcFields,dsInternalCalc] then
  1430. R:=CalcBuffer.data
  1431. else if (State=dsFilter) then
  1432. R:=FFilterRow
  1433. else if (FEditIdx=Buffer.Bookmark) then
  1434. begin
  1435. if State=dsOldValue then
  1436. R:=Buffer.data
  1437. else
  1438. R:=FEditRow
  1439. end
  1440. else
  1441. begin
  1442. if State=dsOldValue then
  1443. Exit(Null)
  1444. else
  1445. R:=Buffer.data;
  1446. end;
  1447. Result:=FFieldMapper.GetJSONDataForField(Field,R);
  1448. if isUndefined(Result) then
  1449. Result:=Null;
  1450. end;
  1451. procedure TBaseJSONDataSet.SetFieldData(Field: TField; var Buffer: TDatarecord; AValue : JSValue);
  1452. var
  1453. R : JSValue;
  1454. begin
  1455. if State in [dsCalcFields,dsInternalCalc] then
  1456. R:=CalcBuffer.Data
  1457. else
  1458. R:=FEditRow;
  1459. FFieldMapper.SetJSONDataForField(Field,R,AValue);
  1460. if not(State in [dsCalcFields, dsInternalCalc, dsFilter, dsNewValue]) then
  1461. DataEvent(deFieldChange, Field);
  1462. SetModified(True);
  1463. // FFieldMapper.SetJSONDataForField(Field,Buffer.Data,AValue);
  1464. end;
  1465. procedure TBaseJSONDataSet.SetBookmarkFlag(var Buffer: TDataRecord; Value: TBookmarkFlag);
  1466. begin
  1467. Buffer.BookmarkFlag := Value;
  1468. end;
  1469. function TBaseJSONDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint;
  1470. begin
  1471. if isNumber(Bookmark1.Data) and isNumber(Bookmark2.Data) then
  1472. Result := Integer(Bookmark2.Data) - Integer(Bookmark1.Data)
  1473. else
  1474. begin
  1475. if isNumber(Bookmark1.Data) then
  1476. Result := -1
  1477. else
  1478. if isNumber(Bookmark2.Data) then
  1479. Result := 1
  1480. else
  1481. Result := 0;
  1482. end;
  1483. end;
  1484. procedure TBaseJSONDataSet.SetRecNo(Value: Integer);
  1485. begin
  1486. CheckBrowseMode;
  1487. DoBeforeScroll;
  1488. if (Value < 1) or (Value > FCurrentIndex.Count) then
  1489. raise EJSONDataset.CreateFmt('%s: SetRecNo: index %d out of range',[Name,Value]);
  1490. FCurrent := Value - 1;
  1491. Resync([]);
  1492. DoAfterScroll;
  1493. end;
  1494. constructor TBaseJSONDataSet.Create(AOwner: TComponent);
  1495. begin
  1496. inherited;
  1497. FownsData:=True;
  1498. UseDateTimeFormatFields:=False;
  1499. FEditIdx:=-1;
  1500. FIndexes:=CreateIndexDefs;
  1501. end;
  1502. destructor TBaseJSONDataSet.Destroy;
  1503. begin
  1504. Close;
  1505. FreeAndNil(FFilterExpression);
  1506. FreeAndNil(FIndexes);
  1507. FEditIdx:=-1;
  1508. inherited;
  1509. end;
  1510. function TBaseJSONDataSet.CreateIndexDefs: TJSONIndexDefs;
  1511. begin
  1512. Result:=TJSONIndexDefs.Create(Self,Self,TJSONIndexDef);
  1513. end;
  1514. procedure TBaseJSONDataSet.BuildIndexes;
  1515. Var
  1516. I : integer;
  1517. begin
  1518. For I:=0 to FIndexes.Count-1 do
  1519. FIndexes[i].BuildIndex(Self);
  1520. end;
  1521. function TBaseJSONDataSet.RecordComparerClass : TRecordComparerClass;
  1522. begin
  1523. Result:=TRecordComparer;
  1524. end;
  1525. function TBaseJSONDataSet.LocateRecordIndex(const KeyFields: string; const KeyValues: JSValue; Options: TLocateOptions): Integer;
  1526. Var
  1527. Comp : TRecordComparer;
  1528. RI,I : Integer;
  1529. begin
  1530. Result:=-1;
  1531. Comp:=RecordComparerClass.Create(Self,KeyFields,KeyValues,Options);
  1532. try
  1533. if loFromCurrent in Options then
  1534. I:=FCurrent
  1535. else
  1536. I:=0;
  1537. RI:=FCurrentIndex.GetRecordIndex(I);
  1538. While (Result=-1) and (RI<>-1) do
  1539. begin
  1540. if Comp.Compare(RI)=0 then
  1541. Result:=RI;
  1542. inc(I);
  1543. RI:=FCurrentIndex.GetRecordIndex(I);
  1544. end;
  1545. finally
  1546. Comp.Free;
  1547. end;
  1548. end;
  1549. function TBaseJSONDataSet.Locate(const KeyFields: string; const KeyValues: JSValue; Options: TLocateOptions): boolean;
  1550. Var
  1551. I : Integer;
  1552. BM : TBookMark;
  1553. begin
  1554. Result:=Inherited;
  1555. I:=LocateRecordIndex(KeyFields,KeyValues,Options);
  1556. Result:=I<>-1;
  1557. if Result then
  1558. begin
  1559. // Construct bookmark.
  1560. // Bookmark is always the index in the FRows array.
  1561. BM.Data:=I;
  1562. BM.Flag:=bfCurrent;
  1563. GotoBookMark(BM);
  1564. end;
  1565. end;
  1566. function TBaseJSONDataSet.Lookup(const KeyFields: string; const KeyValues: JSValue; const ResultFields: string): JSValue;
  1567. Var
  1568. RI,I : Integer;
  1569. l : TFPList;
  1570. Vals : TJSValueDynArray;
  1571. begin
  1572. Result:=Null;
  1573. l:=TFPList.Create;
  1574. try
  1575. GetFieldList(L,ResultFields);
  1576. Result:=inherited Lookup(KeyFields, KeyValues, ResultFields);
  1577. RI:=LocateRecordIndex(KeyFields,KeyValues,[]);
  1578. if RI<>-1 then
  1579. begin
  1580. SetLength(Vals,L.Count);
  1581. For I:=0 to L.Count-1 do
  1582. Vals[i]:=FFieldMapper.GetJSONDataForField(TField(L[I]),FRows[RI]);
  1583. if L.Count=1 then
  1584. Result:=Vals[i]
  1585. else
  1586. Result:=Vals;
  1587. end;
  1588. finally
  1589. L.Free;
  1590. end;
  1591. end;
  1592. end.