jsondataset.pas 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841
  1. {$mode objfpc}
  2. {$h+}
  3. unit JSONDataset;
  4. interface
  5. uses
  6. Types, JS, DB, Classes, SysUtils;
  7. type
  8. { TJSONFieldMapper }
  9. // This class is responsible for mapping the field objects of the records.
  10. TJSONFieldMapper = Class(TObject)
  11. Public
  12. // Return row TJSONData instance with data for field 'FieldName' or 'FieldIndex'.
  13. Function GetJSONDataForField(Const FieldName : String; FieldIndex : Integer; Row : JSValue) : JSValue; virtual; abstract;
  14. // Same, but now based on TField.
  15. Function GetJSONDataForField(F : TField; Row : JSValue) : JSValue; virtual;
  16. // Set data for field 'FieldName' or 'FieldIndex' to supplied TJSONData instance in row
  17. procedure SetJSONDataForField(Const FieldName : String; FieldIndex : Integer; Row,Data : JSValue); virtual; abstract;
  18. // Set data for field TField to supplied TJSONData instance
  19. procedure SetJSONDataForField(F : TField; Row,Data : JSValue); virtual;
  20. // Create a new row.
  21. Function CreateRow : JSValue; virtual; abstract;
  22. end;
  23. // JSON has no date/time type, so we use a string field.
  24. // ExtJS provides the date/time format in it's field config: 'dateFormat'
  25. // The below field classes store this in the NNNFormat field.
  26. { TJSONDateField }
  27. TJSONDateField = Class(TDateField)
  28. private
  29. FDateFormat: String;
  30. Published
  31. Property DateFormat : String Read FDateFormat Write FDateFormat;
  32. end;
  33. { TJSONTimeField }
  34. TJSONTimeField = Class(TTimeField)
  35. private
  36. FTimeFormat: String;
  37. Published
  38. Property TimeFormat : String Read FTimeFormat Write FTimeFormat;
  39. end;
  40. { TJSONDateTimeField }
  41. TJSONDateTimeField = Class(TDateTimeField)
  42. private
  43. FDateTimeFormat: String;
  44. Published
  45. Property DateTimeFormat : String Read FDateTimeFormat Write FDateTimeFormat;
  46. end;
  47. { TBaseJSONDataSet }
  48. { TJSONIndex }
  49. TJSONIndex = Class
  50. FList : TJSArray; // Indexes of elements in FRows.
  51. FRows : TJSArray;
  52. FDataset : TDataset;
  53. private
  54. function GetRecordIndex(aListIndex : Integer): NativeInt;
  55. protected
  56. Function GetCount: Integer; virtual;
  57. Procedure CreateIndex; Virtual; abstract;
  58. Property List : TJSArray Read FList;
  59. Property Rows : TJSArray Read FRows;
  60. Property Dataset : TDataset Read FDataset;
  61. Public
  62. Constructor Create(aDataset: TDataset; aRows : TJSArray);
  63. // Append remainder of FRows to FList.
  64. Procedure AppendToIndex; virtual; abstract;
  65. // Delete aListIndex from list, not from row. Return Recordindex of deleted record.
  66. Function Delete(aListIndex : Integer) : Integer; virtual;
  67. // Append aRecordIndex to list. Return ListIndex of appended record.
  68. Function Append(aRecordIndex : Integer) : Integer; virtual; abstract;
  69. // Insert record into list. By default, this does an append. Return ListIndex of inserted record
  70. Function Insert(aCurrentIndex, aRecordIndex : Integer) : Integer; virtual;
  71. // Record at index aCurrentIndex has changed. Update index and return new listindex.
  72. Function Update(aCurrentIndex, aRecordIndex : Integer) : Integer; virtual; abstract;
  73. // Find list index for Record at index aCurrentIndex. Return -1 if not found.
  74. Function FindRecord(aRecordIndex : Integer) : Integer; virtual; abstract;
  75. // index of record in FRows based on aListIndex in List.
  76. Property RecordIndex[aListIndex : Integer] : NativeInt Read GetRecordIndex;
  77. // Number of records in index. This can differ from FRows, e.g. when filtering.
  78. Property Count : Integer Read GetCount;
  79. end;
  80. { TDefaultJSONIndex }
  81. TDefaultJSONIndex = Class(TJSONIndex)
  82. public
  83. Procedure CreateIndex; override;
  84. Procedure AppendToIndex; override;
  85. Function Append(aRecordIndex : Integer) : Integer; override;
  86. Function Insert(aCurrentIndex, aRecordIndex : Integer) : Integer; override;
  87. Function FindRecord(aRecordIndex : Integer) : Integer; override;
  88. Function Update(aCurrentIndex, aRecordIndex : Integer) : Integer; override;
  89. end;
  90. // basic JSON dataset. Does nothing ExtJS specific.
  91. TBaseJSONDataSet = class (TDataSet)
  92. private
  93. FMUS: Boolean;
  94. FOwnsData : Boolean;
  95. FDefaultIndex : TJSONIndex; // Default index, built from array
  96. FCurrentIndex : TJSONIndex; // Currently active index.
  97. FCurrent: Integer; // Record Index in the current IndexList
  98. // Possible metadata to configure fields from.
  99. FMetaData : TJSObject;
  100. // This will contain the rows.
  101. FRows : TJSArray;
  102. // Deleted rows
  103. FDeletedRows : TJSArray;
  104. FFieldMapper : TJSONFieldMapper;
  105. // When editing, this object is edited.
  106. FEditIdx : Integer;
  107. FEditRow : JSValue;
  108. FUseDateTimeFormatFields: Boolean;
  109. procedure SetMetaData(AValue: TJSObject);
  110. procedure SetRows(AValue: TJSArray);
  111. protected
  112. // dataset virtual methods
  113. function AllocRecordBuffer: TDataRecord; override;
  114. procedure FreeRecordBuffer(var Buffer: TDataRecord); override;
  115. procedure InternalInitRecord(var Buffer: TDataRecord); override;
  116. function GetRecord(Var Buffer: TDataRecord; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
  117. function GetRecordSize: Word; override;
  118. procedure AddToRows(AValue: TJSArray);
  119. procedure InternalClose; override;
  120. procedure InternalDelete; override;
  121. procedure InternalFirst; override;
  122. procedure InternalLast; override;
  123. procedure InternalOpen; override;
  124. procedure InternalPost; override;
  125. procedure InternalInsert; override;
  126. procedure InternalEdit; override;
  127. procedure InternalCancel; override;
  128. procedure InternalInitFieldDefs; override;
  129. procedure InternalSetToRecord(Buffer: TDataRecord); override;
  130. function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
  131. function IsCursorOpen: Boolean; override;
  132. // Bookmark operations
  133. function BookmarkValid(ABookmark: TBookmark): Boolean; override;
  134. procedure GetBookmarkData(Buffer: TDataRecord; var Data: TBookmark); override;
  135. function GetBookmarkFlag(Buffer: TDataRecord): TBookmarkFlag; override;
  136. procedure InternalGotoBookmark(ABookmark: TBookmark); override;
  137. procedure SetBookmarkFlag(Var Buffer: TDataRecord; Value: TBookmarkFlag); override;
  138. procedure SetBookmarkData(Var Buffer: TDataRecord; Data: TBookmark); override;
  139. function GetRecordCount: Integer; override;
  140. procedure SetRecNo(Value: Integer); override;
  141. function GetRecNo: Integer; override;
  142. Protected
  143. // New methods.
  144. // Called when dataset is closed. If OwnsData is true, metadata and rows are freed.
  145. Procedure FreeData; virtual;
  146. // Fill default list.
  147. procedure AppendToIndexes; virtual;
  148. Procedure CreateIndexes; virtual;
  149. // Convert MetaData object to FieldDefs.
  150. Procedure MetaDataToFieldDefs; virtual; abstract;
  151. // Initialize Date/Time info in all date/time fields. Called during InternalOpen
  152. procedure InitDateTimeFields; virtual;
  153. // Convert JSON date S to DateTime for Field F
  154. function ConvertDateTimeField(S: String; F: TField): TDateTime; virtual;
  155. // Format JSON date to from DT for Field F
  156. function FormatDateTimeField(DT : TDateTime; F: TField): String; virtual;
  157. // Create fieldmapper. A descendent MUST implement this.
  158. Function CreateFieldMapper : TJSONFieldMapper; virtual; abstract;
  159. // If True, then the dataset will free MetaData and FRows when it is closed.
  160. Property OwnsData : Boolean Read FownsData Write FOwnsData;
  161. // set to true if unknown field types should be handled as string fields.
  162. Property MapUnknownToStringType : Boolean Read FMUS Write FMUS;
  163. // Metadata
  164. Property MetaData : TJSObject Read FMetaData Write SetMetaData;
  165. // Rows
  166. Property Rows : TJSArray Read FRows Write SetRows;
  167. // Fieldmapper
  168. Property FieldMapper : TJSONFieldMapper Read FFieldMapper;
  169. // FieldClass
  170. Property UseDateTimeFormatFields : Boolean Read FUseDateTimeFormatFields Write FUseDateTimeFormatFields;
  171. public
  172. constructor Create (AOwner: TComponent); override;
  173. destructor Destroy; override;
  174. function GetFieldData(Field: TField; Buffer: TDatarecord): JSValue; override;
  175. procedure SetFieldData(Field: TField; var Buffer: TDatarecord; AValue : JSValue); override;
  176. function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; override;
  177. end;
  178. TJSONDataset = Class(TBaseJSONDataset)
  179. published
  180. Property FieldDefs;
  181. // redeclared data set properties
  182. property Active;
  183. property BeforeOpen;
  184. property AfterOpen;
  185. property BeforeClose;
  186. property AfterClose;
  187. property BeforeInsert;
  188. property AfterInsert;
  189. property BeforeEdit;
  190. property AfterEdit;
  191. property BeforePost;
  192. property AfterPost;
  193. property BeforeCancel;
  194. property AfterCancel;
  195. property BeforeDelete;
  196. property AfterDelete;
  197. property BeforeScroll;
  198. property AfterScroll;
  199. property OnCalcFields;
  200. property OnDeleteError;
  201. property OnEditError;
  202. property OnFilterRecord;
  203. property OnNewRecord;
  204. property OnPostError;
  205. end;
  206. { TJSONObjectFieldMapper }
  207. // Fieldmapper to be used when the data is in an object
  208. TJSONObjectFieldMapper = Class(TJSONFieldMapper)
  209. Public
  210. procedure SetJSONDataForField(Const FieldName : String; FieldIndex : Integer; Row,Data : JSValue); override;
  211. Function GetJSONDataForField(Const FieldName : String; FieldIndex : Integer; Row : JSValue) : JSValue; override;
  212. Function CreateRow : JSValue; override;
  213. end;
  214. { TJSONArrayFieldMapper }
  215. // Fieldmapper to be used when the data is in an array
  216. TJSONArrayFieldMapper = Class(TJSONFieldMapper)
  217. Public
  218. procedure SetJSONDataForField(Const FieldName : String; FieldIndex : Integer; Row,Data : JSValue); override;
  219. Function GetJSONDataForField(Const FieldName : String; FieldIndex : Integer; Row : JSValue) : JSValue; override;
  220. Function CreateRow : JSValue; override;
  221. end;
  222. EJSONDataset = Class(EDatabaseError);
  223. implementation
  224. uses DateUtils;
  225. { TDefaultJSONIndex }
  226. procedure TDefaultJSONIndex.CreateIndex;
  227. Var
  228. I : Integer;
  229. begin
  230. For I:=0 to FRows.length-1 do
  231. FList[i]:=I;
  232. end;
  233. procedure TDefaultJSONIndex.AppendToIndex;
  234. Var
  235. I,L : Integer;
  236. begin
  237. L:=FList.Length;
  238. FList.Length:=FRows.Length;
  239. For I:=L to FRows.Length-1 do
  240. FList[i]:=I;
  241. end;
  242. function TDefaultJSONIndex.Append(aRecordIndex: Integer): Integer;
  243. begin
  244. Result:=FList.Push(aRecordIndex)-1;
  245. end;
  246. function TDefaultJSONIndex.Insert(aCurrentIndex, aRecordIndex: Integer
  247. ): Integer;
  248. begin
  249. FList.splice(aCurrentIndex, 0, aRecordIndex);
  250. Result:=aCurrentIndex;
  251. end;
  252. function TDefaultJSONIndex.FindRecord(aRecordIndex: Integer): Integer;
  253. begin
  254. Result:=FList.indexOf(aRecordIndex);
  255. end;
  256. function TDefaultJSONIndex.Update(aCurrentIndex, aRecordIndex: Integer
  257. ): Integer;
  258. begin
  259. If RecordIndex[aCurrentIndex]<>aRecordIndex then
  260. DatabaseErrorFmt('Inconsistent record index in default index, expected %d, got %d.',[aCurrentIndex,RecordIndex[aCurrentIndex]],Dataset);
  261. end;
  262. { TJSONIndex }
  263. constructor TJSONIndex.Create(aDataset: TDataset; aRows: TJSArray);
  264. begin
  265. FRows:=aRows;
  266. FList:=TJSArray.New(FRows.length);
  267. FDataset:=aDataset;
  268. CreateIndex;
  269. end;
  270. function TJSONIndex.Delete(aListIndex: Integer): Integer;
  271. Var
  272. a : TJSArray;
  273. begin
  274. A:=FList.Splice(aListIndex,1);
  275. If a.Length>0 then
  276. Result:=Integer(A[0])
  277. else
  278. Result:=-1;
  279. end;
  280. function TJSONIndex.Insert(aCurrentIndex, aRecordIndex: Integer): Integer;
  281. begin
  282. Result:=Append(aRecordIndex);
  283. end;
  284. function TJSONIndex.GetCount: Integer;
  285. begin
  286. Result:=FList.Length;
  287. end;
  288. function TJSONIndex.GetRecordIndex(aListIndex : Integer): NativeInt;
  289. begin
  290. if isUndefined(FList[aListIndex]) then
  291. Result:=-1
  292. else
  293. Result:=NativeInt(FList[aListIndex]);
  294. end;
  295. { TJSONFieldMapper }
  296. function TJSONFieldMapper.GetJSONDataForField(F: TField; Row: JSValue ): JSValue;
  297. begin
  298. // This supposes that Index is correct, i.e. the field positions have not been changed.
  299. Result:=GetJSONDataForField(F.FieldName,F.Index,Row);
  300. end;
  301. procedure TJSONFieldMapper.SetJSONDataForField(F: TField; Row,Data: JSValue);
  302. begin
  303. SetJSONDataForField(F.FieldName,F.Index,Row,Data);
  304. end;
  305. { TJSONArrayFieldMapper }
  306. procedure TJSONArrayFieldMapper.SetJSONDataForField(const FieldName: String;
  307. FieldIndex: Integer; Row, Data: JSValue);
  308. begin
  309. TJSValueDynArray(Row)[FieldIndex]:=Data;
  310. end;
  311. function TJSONArrayFieldMapper.GetJSONDataForField(Const FieldName: String;
  312. FieldIndex: Integer; Row: JSValue): JSValue;
  313. begin
  314. Result:=TJSValueDynArray(Row)[FieldIndex];
  315. end;
  316. function TJSONArrayFieldMapper.CreateRow: JSValue;
  317. begin
  318. Result:=TJSArray.New;
  319. end;
  320. { TJSONObjectFieldMapper }
  321. procedure TJSONObjectFieldMapper.SetJSONDataForField(const FieldName: String;
  322. FieldIndex: Integer; Row, Data: JSValue);
  323. begin
  324. TJSObject(Row).Properties[FieldName]:=Data;
  325. end;
  326. function TJSONObjectFieldMapper.GetJSONDataForField(const FieldName: String;
  327. FieldIndex: Integer; Row: JSValue): JSValue;
  328. begin
  329. Result:=TJSObject(Row).Properties[FieldName];
  330. end;
  331. function TJSONObjectFieldMapper.CreateRow: JSValue;
  332. begin
  333. Result:=TJSObject.New;
  334. end;
  335. procedure TBaseJSONDataSet.SetMetaData(AValue: TJSObject);
  336. begin
  337. CheckInActive;
  338. FMetaData:=AValue;
  339. end;
  340. procedure TBaseJSONDataSet.AddToRows(AValue: TJSArray);
  341. begin
  342. if FRows=Nil then
  343. FRows:=AValue
  344. else
  345. begin
  346. FRows:=FRows.Concat(AValue);
  347. AppendToIndexes;
  348. end;
  349. end;
  350. procedure TBaseJSONDataSet.SetRows(AValue: TJSArray);
  351. begin
  352. if AValue=FRows then exit;
  353. CheckInActive;
  354. FRows:=Nil;
  355. AddToRows(AValue);
  356. end;
  357. function TBaseJSONDataSet.AllocRecordBuffer: TDataRecord;
  358. begin
  359. Result.data:=TJSObject.New;
  360. Result.bookmark:=null;
  361. Result.state:=rsNew;
  362. end;
  363. // the next two are particularly ugly.
  364. procedure TBaseJSONDataSet.InternalInitRecord(var Buffer: TDataRecord);
  365. begin
  366. // Writeln('TBaseJSONDataSet.InternalInitRecord');
  367. Buffer.Data:=FFieldMapper.CreateRow;
  368. Buffer.bookmark:=null;
  369. Buffer.state:=rsNew;
  370. end;
  371. procedure TBaseJSONDataSet.FreeRecordBuffer (var Buffer: TDataRecord);
  372. begin
  373. Buffer.Data:=Null;
  374. Buffer.bookmark:=null;
  375. Buffer.state:=rsNew;
  376. end;
  377. procedure TBaseJSONDataSet.GetBookmarkData(Buffer: TDataRecord; var Data: TBookmark);
  378. begin
  379. Data.Data:=Buffer.bookmark;
  380. end;
  381. function TBaseJSONDataSet.GetBookmarkFlag(Buffer: TDataRecord): TBookmarkFlag;
  382. begin
  383. Result :=Buffer.BookmarkFlag;
  384. end;
  385. function TBaseJSONDataSet.GetRecNo: Integer;
  386. Var
  387. bkmIdx : Integer;
  388. begin
  389. bkmIdx:=Integer(ActiveBuffer.bookmark);
  390. Result:=FCurrentIndex.FindRecord(bkmIdx)+1;
  391. end;
  392. procedure TBaseJSONDataSet.InternalInitFieldDefs;
  393. begin
  394. If Assigned(FMetaData) then
  395. MetaDataToFieldDefs;
  396. if (FieldDefs.Count=0) then
  397. Raise EJSONDataset.Create('No fields found');
  398. end;
  399. procedure TBaseJSONDataSet.FreeData;
  400. begin
  401. If FOwnsData then
  402. begin
  403. FRows:=Nil;
  404. FMetaData:=Nil;
  405. end;
  406. if (FCurrentIndex<>FDefaultIndex) then
  407. FreeAndNil(FCurrentIndex)
  408. else
  409. FCurrentIndex:=Nil;
  410. FreeAndNil(FDefaultindex);
  411. FreeAndNil(FFieldMapper);
  412. FCurrentIndex:=Nil;
  413. FDeletedRows:=Nil;
  414. end;
  415. procedure TBaseJSONDataSet.AppendToIndexes;
  416. begin
  417. FDefaultIndex.AppendToIndex;
  418. end;
  419. procedure TBaseJSONDataSet.CreateIndexes;
  420. begin
  421. FDefaultIndex:=TDefaultJSONIndex.Create(Self,FRows);
  422. AppendToIndexes;
  423. FCurrentIndex:=FDefaultIndex;
  424. end;
  425. function TBaseJSONDataSet.GetRecord(Var Buffer: TDataRecord; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
  426. Var
  427. BkmIdx : Integer;
  428. begin
  429. Result := grOK; // default
  430. case GetMode of
  431. gmNext: // move on
  432. if fCurrent < fCurrentIndex.Count - 1 then
  433. Inc (fCurrent)
  434. else
  435. Result := grEOF; // end of file
  436. gmPrior: // move back
  437. if fCurrent > 0 then
  438. Dec (fCurrent)
  439. else
  440. Result := grBOF; // begin of file
  441. gmCurrent: // check if empty
  442. if fCurrent >= fCurrentIndex.Count then
  443. Result := grEOF;
  444. end;
  445. if Result = grOK then // read the data
  446. begin
  447. BkmIdx:=FCurrentIndex.RecordIndex[FCurrent];
  448. Buffer.Data:=FRows[bkmIdx];
  449. Buffer.BookmarkFlag := bfCurrent;
  450. Buffer.Bookmark:=BkmIdx;
  451. end;
  452. end;
  453. function TBaseJSONDataSet.GetRecordCount: Integer;
  454. begin
  455. Result:=FCurrentIndex.Count;
  456. end;
  457. function TBaseJSONDataSet.GetRecordSize: Word;
  458. begin
  459. Result := 0; // actual data without house-keeping
  460. end;
  461. procedure TBaseJSONDataSet.InternalClose;
  462. begin
  463. // disconnet and destroy field objects
  464. BindFields (False);
  465. if DefaultFields then
  466. DestroyFields;
  467. FreeData;
  468. end;
  469. procedure TBaseJSONDataSet.InternalDelete;
  470. Var
  471. Idx : Integer;
  472. begin
  473. Idx:=FCurrentIndex.Delete(FCurrent);
  474. if (Idx<>-1) then
  475. begin
  476. // Add code here to Delete from other indexes as well.
  477. // ...
  478. // Add to array of deleted records.
  479. if Not Assigned(FDeletedRows) then
  480. FDeletedRows:=TJSArray.New(FRows[idx])
  481. else
  482. FDeletedRows.Push(FRows[Idx]);
  483. FRows[Idx]:=Undefined;
  484. end;
  485. end;
  486. procedure TBaseJSONDataSet.InternalFirst;
  487. begin
  488. FCurrent := -1;
  489. end;
  490. procedure TBaseJSONDataSet.InternalGotoBookmark(ABookmark: TBookmark);
  491. begin
  492. if isNumber(ABookmark.Data) then
  493. FCurrent:=FCurrentIndex.FindRecord(Integer(ABookmark.Data));
  494. // Writeln('Fcurrent', FCurrent,' from ',ABookmark.Data);
  495. end;
  496. procedure TBaseJSONDataSet.InternalInsert;
  497. Var
  498. I : Integer;
  499. D : TFieldDef;
  500. begin
  501. // Writeln('TBaseJSONDataSet.InternalInsert');
  502. FEditRow:=ActiveBuffer.Data;
  503. For I:=0 to FieldDefs.Count-1 do
  504. begin
  505. D:=FieldDefs[i];
  506. FFieldMapper.SetJSONDataForField(D.Name,D.Index,FEditRow,Null);
  507. end;
  508. end;
  509. procedure TBaseJSONDataSet.InternalEdit;
  510. begin
  511. // Writeln('TBaseJSONDataSet.InternalEdit: ');
  512. FEditIdx:=FCurrentIndex.RecordIndex[FCurrent];
  513. if not isUndefined(Rows[FEditIdx]) then
  514. FEditRow:=TJSJSON.parse(TJSJSON.stringify(Rows[FEditIdx]))
  515. else
  516. FEditRow:=TJSObject.new;
  517. // Writeln('TBaseJSONDataSet.InternalEdit: ',FEditRow);
  518. end;
  519. procedure TBaseJSONDataSet.InternalCancel;
  520. begin
  521. FEditIdx:=-1;
  522. FEditRow:=Nil;
  523. end;
  524. procedure TBaseJSONDataSet.InternalLast;
  525. begin
  526. // The first thing that will happen is a GetPrior Record.
  527. FCurrent:=FCurrentIndex.Count;
  528. end;
  529. procedure TBaseJSONDataSet.InitDateTimeFields;
  530. begin
  531. // Do nothing
  532. end;
  533. procedure TBaseJSONDataSet.InternalOpen;
  534. begin
  535. FreeAndNil(FFieldMapper);
  536. FFieldMapper:=CreateFieldMapper;
  537. IF (FRows=Nil) then // opening from fielddefs ?
  538. begin
  539. FRows:=TJSArray.New;
  540. OwnsData:=True;
  541. end;
  542. CreateIndexes;
  543. InternalInitFieldDefs;
  544. if DefaultFields then
  545. CreateFields;
  546. BindFields (True);
  547. InitDateTimeFields;
  548. FCurrent := -1;
  549. end;
  550. procedure TBaseJSONDataSet.InternalPost;
  551. Var
  552. Idx : integer;
  553. B : TBookmark;
  554. begin
  555. GetBookMarkData(ActiveBuffer,B);
  556. if (State=dsInsert) then
  557. begin // Insert or Append
  558. Idx:=FRows.push(FEditRow)-1;
  559. if GetBookMarkFlag(ActiveBuffer)=bfEOF then
  560. begin // Append
  561. FDefaultIndex.Append(Idx);
  562. // Must replace this by updating all indexes
  563. if (FCurrentIndex<>FDefaultIndex) then
  564. FCurrentIndex.Append(Idx);
  565. end
  566. else // insert
  567. begin
  568. FCurrent:=FDefaultIndex.Insert(FCurrent,Idx);
  569. // Must replace this by updating all indexes.
  570. // Note that this will change current index.
  571. if (FCurrentIndex<>FDefaultIndex) then
  572. FCurrent:=FCurrentIndex.Insert(FCurrent,Idx);
  573. end;
  574. end
  575. else
  576. begin // Edit
  577. if (FEditIdx=-1) then
  578. DatabaseErrorFmt('Failed to retrieve record index for record %d',[FCurrent]);
  579. // Update source record
  580. Idx:=FEditIdx;
  581. FRows[Idx]:=FEditRow;
  582. FDefaultIndex.Update(FCurrent,Idx);
  583. // Must replace this by updating all indexes.
  584. // Note that this will change current index.
  585. if (FCurrentIndex<>FDefaultIndex) then
  586. FCurrentIndex.Update(FCurrent,Idx);
  587. end;
  588. FEditIdx:=-1;
  589. FEditRow:=Nil;
  590. end;
  591. procedure TBaseJSONDataSet.InternalSetToRecord(Buffer: TDataRecord);
  592. begin
  593. FCurrent:=FCurrentIndex.FindRecord(Integer(Buffer.Bookmark));
  594. end;
  595. function TBaseJSONDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
  596. begin
  597. If UseDateTimeFormatFields and (FieldType in [ftDate,ftDateTime,ftTime]) then
  598. case FieldType of
  599. ftDate : Result:=TJSONDateField;
  600. ftDateTime : Result:=TJSONDateTimeField;
  601. ftTime : Result:=TJSONTimeField;
  602. end
  603. else
  604. Result:=inherited GetFieldClass(FieldType);
  605. end;
  606. function TBaseJSONDataSet.IsCursorOpen: Boolean;
  607. begin
  608. Result := Assigned(FDefaultIndex);
  609. end;
  610. function TBaseJSONDataSet.BookmarkValid(ABookmark: TBookmark): Boolean;
  611. begin
  612. Result:=isNumber(ABookmark.Data);
  613. end;
  614. procedure TBaseJSONDataSet.SetBookmarkData(var Buffer: TDataRecord; Data: TBookmark);
  615. begin
  616. Buffer.Bookmark:=Data.Data;
  617. // Writeln('Set Bookmark from: ',Data.Data);
  618. end;
  619. function TBaseJSONDataSet.ConvertDateTimeField(S : String; F : TField) : TDateTime;
  620. Var
  621. Ptrn : string;
  622. begin
  623. Result:=0;
  624. Case F.DataType of
  625. ftDate : Ptrn:=TJSONDateField(F).DateFormat;
  626. ftTime : Ptrn:=TJSONTimeField(F).TimeFormat;
  627. ftDateTime : Ptrn:=TJSONDateTimeField(F).DateTimeFormat;
  628. end;
  629. If (Ptrn='') then
  630. Case F.DataType of
  631. ftDate : Result:=StrToDate(S);
  632. ftTime : Result:=StrToTime(S);
  633. ftDateTime : Result:=StrToDateTime(S);
  634. end
  635. else
  636. begin
  637. Result:=ScanDateTime(ptrn,S,1);
  638. end;
  639. end;
  640. function TBaseJSONDataSet.FormatDateTimeField(DT: TDateTime; F: TField
  641. ): String;
  642. Var
  643. Ptrn : string;
  644. begin
  645. Result:='';
  646. Case F.DataType of
  647. ftDate : Ptrn:=TJSONDateField(F).DateFormat;
  648. ftTime : Ptrn:=TJSONTimeField(F).TimeFormat;
  649. ftDateTime : Ptrn:=TJSONDateTimeField(F).DateTimeFormat;
  650. end;
  651. If (Ptrn='') then
  652. Case F.DataType of
  653. ftDate : Result:=DateToStr(DT);
  654. ftTime : Result:=TimeToStr(DT);
  655. ftDateTime : Result:=DateTimeToStr(DT);
  656. end
  657. else
  658. Result:=FormatDateTime(ptrn,DT);
  659. end;
  660. function TBaseJSONDataSet.GetFieldData(Field: TField; Buffer: TDatarecord): JSValue;
  661. var
  662. R : JSValue;
  663. begin
  664. if (FEditIdx=Buffer.Bookmark) then
  665. R:=FEditRow
  666. else
  667. R:=Buffer.data;
  668. Result:=FFieldMapper.GetJSONDataForField(Field,R);
  669. end;
  670. procedure TBaseJSONDataSet.SetFieldData(Field: TField; var Buffer: TDatarecord; AValue : JSValue);
  671. begin
  672. FFieldMapper.SetJSONDataForField(Field,FEditRow,AValue);
  673. SetModified(True);
  674. // FFieldMapper.SetJSONDataForField(Field,Buffer.Data,AValue);
  675. end;
  676. procedure TBaseJSONDataSet.SetBookmarkFlag(var Buffer: TDataRecord; Value: TBookmarkFlag);
  677. begin
  678. Buffer.BookmarkFlag := Value;
  679. end;
  680. function TBaseJSONDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint;
  681. begin
  682. if isNumber(Bookmark1.Data) and isNumber(Bookmark2.Data) then
  683. Result := Integer(Bookmark2.Data) - Integer(Bookmark1.Data)
  684. else
  685. begin
  686. if isNumber(Bookmark1.Data) then
  687. Result := -1
  688. else
  689. if isNumber(Bookmark2.Data) then
  690. Result := 1
  691. else
  692. Result := 0;
  693. end;
  694. end;
  695. procedure TBaseJSONDataSet.SetRecNo(Value: Integer);
  696. begin
  697. if (Value < 1) or (Value > FCurrentIndex.Count) then
  698. raise EJSONDataset.CreateFmt('%s: SetRecNo: index %d out of range',[Name,Value]);
  699. FCurrent := Value - 1;
  700. Resync([]);
  701. DoAfterScroll;
  702. end;
  703. constructor TBaseJSONDataSet.Create(AOwner: TComponent);
  704. begin
  705. inherited;
  706. FownsData:=True;
  707. UseDateTimeFormatFields:=False;
  708. FEditIdx:=-1;
  709. end;
  710. destructor TBaseJSONDataSet.Destroy;
  711. begin
  712. FEditIdx:=-1;
  713. FreeData;
  714. inherited;
  715. end;
  716. end.