/packages/fcl-db/src/json/fpjsondataset.pp
Puppet | 1109 lines | 1104 code | 5 blank | 0 comment | 5 complexity | 3afc75b60775396eed70cd910b8210d9 MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
1{$mode objfpc} 2{$h+} 3unit fpjsondataset; 4 5interface 6 7uses 8 DB, typinfo, Classes, SysUtils, fpjson; 9 10type 11 12 { TJSONFieldMapper } 13 // This class is responsible for mapping the field objects of the records. 14 TJSONFieldMapper = Class(TObject) 15 // Return row TJSONData instance with data for field 'FieldName' or 'FieldIndex'. 16 Function GetJSONDataForField(Const FieldName : String; FieldIndex : Integer; Row : TJSONData) : TJSONData; virtual; abstract; 17 // Same, but now based on TField. 18 Function GetJSONDataForField(F : TField; Row : TJSONData) : TJSONData; virtual; 19 // Set data for field 'FieldName' or 'FieldIndex' to supplied TJSONData instance in row 20 procedure SetJSONDataForField(Const FieldName : String; FieldIndex : Integer; Row,Data : TJSONData); virtual; abstract; 21 // Set data for field TField to supplied TJSONData instance 22 procedure SetJSONDataForField(F : TField; Row,Data : TJSONData); virtual; 23 // Create a new row. 24 Function CreateRow : TJSONData; virtual; abstract; 25 end; 26 27 // JSON has no date/time type, so we use a string field. 28 // ExtJS provides the date/time format in it's field config: 'dateFormat' 29 // The below field classes store this in the NNNFormat field. 30 { TJSONDateField } 31 32 TJSONDateField = Class(TDateField) 33 private 34 FDateFormat: String; 35 Published 36 Property DateFormat : String Read FDateFormat Write FDateFormat; 37 end; 38 39 { TJSONTimeField } 40 41 TJSONTimeField = Class(TTimeField) 42 private 43 FTimeFormat: String; 44 Published 45 Property TimeFormat : String Read FTimeFormat Write FTimeFormat; 46 end; 47 48 { TJSONDateTimeField } 49 50 TJSONDateTimeField = Class(TDateTimeField) 51 private 52 FDateTimeFormat: String; 53 Published 54 Property DateTimeFormat : String Read FDateTimeFormat Write FDateTimeFormat; 55 end; 56 57 { TBaseJSONDataSet } 58 59 // basic JSON dataset. Does nothing ExtJS specific. 60 TBaseJSONDataSet = class (TDataSet) 61 private 62 FMUS: Boolean; 63 FOwnsData : Boolean; 64 FDefaultList : TFPList; 65 FCurrentList: TFPList; 66 FRecordSize: Integer; 67 FCurrent: Integer; 68 // Possible metadata to configure fields from. 69 FMetaData : TJSONObject; 70 // This will contain the rows. 71 FRows : TJSONArray; 72 FFieldMapper : TJSONFieldMapper; 73 // When editing, this object is edited. 74 FEditRow : TJSONData; 75 procedure SetMetaData(AValue: TJSONObject); 76 procedure SetRows(AValue: TJSONArray); 77 protected 78 // dataset virtual methods 79 function AllocRecordBuffer: TRecordBuffer; override; 80 procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override; 81 procedure InternalInitRecord(Buffer: TRecordBuffer); override; 82 procedure GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override; 83 function GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag; override; 84 function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override; 85 function GetRecordSize: Word; override; 86 procedure InternalClose; override; 87 procedure InternalDelete; override; 88 procedure InternalFirst; override; 89 procedure InternalGotoBookmark(ABookmark: Pointer); override; 90 procedure InternalLast; override; 91 procedure InternalOpen; override; 92 procedure InternalPost; override; 93 procedure InternalInsert; override; 94 procedure InternalEdit; override; 95 procedure InternalCancel; override; 96 procedure InternalInitFieldDefs; override; 97 procedure InternalSetToRecord(Buffer: TRecordBuffer); override; 98 function GetFieldClass(FieldType: TFieldType): TFieldClass; override; 99 function IsCursorOpen: Boolean; override; 100 procedure SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag); override; 101 procedure SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override; 102 function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat : Boolean): Boolean; override; 103 procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat : Boolean); override; 104 function GetRecordCount: Integer; override; 105 procedure SetRecNo(Value: Integer); override; 106 function GetRecNo: Integer; override; 107 Protected 108 // New methods. 109 // Called when dataset is closed. If OwnsData is true, metadata and rows are freed. 110 Procedure FreeData; virtual; 111 // Fill default list. 112 Procedure FillList; virtual; 113 // Convert MetaData object to FieldDefs. 114 Procedure MetaDataToFieldDefs; virtual; abstract; 115 // Initialize Date/Time info in all date/time fields. Called during InternalOpen 116 procedure InitDateTimeFields; virtual; 117 // Convert JSON date S to DateTime for Field F 118 function ConvertDateTimeField(S: String; F: TField): TDateTime; virtual; 119 // Format JSON date to from DT for Field F 120 function FormatDateTimeField(DT : TDateTime; F: TField): String; virtual; 121 // Create fieldmapper. A descendent MUST implement this. 122 Function CreateFieldMapper : TJSONFieldMapper; virtual; abstract; 123 // If True, then the dataset will free MetaData and FRows when it is closed. 124 Property OwnsData : Boolean Read FownsData Write FOwnsData; 125 // set to true if unknown field types should be handled as string fields. 126 Property MapUnknownToStringType : Boolean Read FMUS Write FMUS; 127 // Metadata 128 Property MetaData : TJSONObject Read FMetaData Write SetMetaData; 129 // Rows 130 Property Rows : TJSONArray Read FRows Write SetRows; 131 public 132 constructor Create (AOwner: TComponent); override; 133 destructor Destroy; override; 134 published 135 Property FieldDefs; 136 // redeclared data set properties 137 property Active; 138 property BeforeOpen; 139 property AfterOpen; 140 property BeforeClose; 141 property AfterClose; 142 property BeforeInsert; 143 property AfterInsert; 144 property BeforeEdit; 145 property AfterEdit; 146 property BeforePost; 147 property AfterPost; 148 property BeforeCancel; 149 property AfterCancel; 150 property BeforeDelete; 151 property AfterDelete; 152 property BeforeScroll; 153 property AfterScroll; 154 property OnCalcFields; 155 property OnDeleteError; 156 property OnEditError; 157 property OnFilterRecord; 158 property OnNewRecord; 159 property OnPostError; 160 end; 161 162 { TExtJSJSONDataSet } 163 164 // Base for ExtJS datasets. It handles MetaData conversion. 165 TExtJSJSONDataSet = Class(TBaseJSONDataset) 166 Private 167 FFields : TJSONArray; 168 Protected 169 Function GenerateMetaData : TJSONObject; 170 function ConvertDateFormat(S: String): String; virtual; 171 Procedure MetaDataToFieldDefs; override; 172 procedure InitDateTimeFields; override; 173 function StringToFieldType(S: String): TFieldType;virtual; 174 function GetStringFieldLength(F: TJSONObject; AName: String; AIndex: Integer): integer; virtual; 175 Public 176 // Use this to load MetaData/Rows from stream. 177 // If no metadata is present in the stream, FieldDefs must be filled manually. 178 Procedure LoadFromStream(S : TStream); 179 // Use this to load MetaData/Rows from file. 180 // If no metadata is present in the file, FieldDefs must be filled manually. 181 Procedure LoadFromFile(Const AFileName: string); 182 // Use this to save Rows and optionally metadata to Stream. 183 // Note that MetaData must be set. 184 Procedure SaveToStream(S : TStream; SaveMetaData : Boolean); 185 // Use this to save Rows and optionally metadata to Stream. 186 // Note that MetaData must be set. 187 Procedure SaveToFile(Const AFileName : String; SaveMetaData : Boolean); 188 // Can be set directly if the dataset is closed. 189 Property MetaData; 190 // Can be set directly if the dataset is closed. If metadata is set, it must match the data. 191 Property Rows; 192 Published 193 Property OwnsData; 194 end; 195 196 { TExtJSJSONObjectDataSet } 197 // Use this dataset for data where the data is an array of objects. 198 TExtJSJSONObjectDataSet = Class(TExtJSJSONDataSet) 199 Function CreateFieldMapper : TJSONFieldMapper; override; 200 end; 201 202 { TExtJSJSONArrayDataSet } 203 // Use this dataset for data where the data is an array of arrays. 204 TExtJSJSONArrayDataSet = Class(TExtJSJSONDataSet) 205 Function CreateFieldMapper : TJSONFieldMapper; override; 206 end; 207 208 { TJSONObjectFieldMapper } 209 // Fieldmapper to be used when the data is in an object 210 TJSONObjectFieldMapper = Class(TJSONFieldMapper) 211 procedure SetJSONDataForField(Const FieldName : String; FieldIndex : Integer; Row,Data : TJSONData); override; 212 Function GetJSONDataForField(Const FieldName : String; FieldIndex : Integer; Row : TJSONData) : TJSONData; override; 213 Function CreateRow : TJSONData; override; 214 end; 215 216 { TJSONArrayFieldMapper } 217 // Fieldmapper to be used when the data is in an array 218 TJSONArrayFieldMapper = Class(TJSONFieldMapper) 219 procedure SetJSONDataForField(Const FieldName : String; FieldIndex : Integer; Row,Data : TJSONData); override; 220 Function GetJSONDataForField(Const FieldName : String; FieldIndex : Integer; Row : TJSONData) : TJSONData; override; 221 Function CreateRow : TJSONData; override; 222 end; 223 224 EJSONDataset = Class(EDatabaseError); 225 226implementation 227 228uses dateutils, jsonparser; 229 230type 231 PRecInfo = ^TRecInfo; 232 TRecInfo = record 233 Index: Integer; 234 Bookmark: Longint; 235 BookmarkFlag: TBookmarkFlag; 236 end; 237 238 239{ TJSONFieldMapper } 240 241function TJSONFieldMapper.GetJSONDataForField(F: TField; Row: TJSONData 242 ): TJSONData; 243begin 244 // This supposes that Index is correct, i.e. the field positions have not been changed. 245 Result:=GetJSONDataForField(F.FieldName,F.Index,Row); 246end; 247 248procedure TJSONFieldMapper.SetJSONDataForField(F: TField; Row,Data: TJSONData); 249begin 250 SetJSONDataForField(F.FieldName,F.Index,Row,Data); 251end; 252 253{ TJSONArrayDataSet } 254 255function TExtJSJSONArrayDataSet.CreateFieldMapper: TJSONFieldMapper; 256begin 257 Result:=TJSONArrayFieldMapper.Create; 258end; 259 260{ TJSONObjectDataSet } 261 262function TExtJSJSONObjectDataSet.CreateFieldMapper: TJSONFieldMapper; 263begin 264 Result:=TJSONObjectFieldMapper.Create; 265end; 266 267{ TJSONArrayFieldMapper } 268 269procedure TJSONArrayFieldMapper.SetJSONDataForField(const FieldName: String; 270 FieldIndex: Integer; Row, Data: TJSONData); 271begin 272 (Row as TJSONArray).Items[FieldIndex]:=Data; 273end; 274 275function TJSONArrayFieldMapper.GetJSONDataForField(Const FieldName: String; 276 FieldIndex: Integer; Row: TJSONData): TJSONData; 277begin 278 Result:=(Row as TJSONArray).Items[FieldIndex]; 279end; 280 281function TJSONArrayFieldMapper.CreateRow: TJSONData; 282begin 283 Result:=TJSONArray.Create; 284end; 285 286{ TJSONObjectFieldMapper } 287 288procedure TJSONObjectFieldMapper.SetJSONDataForField(const FieldName: String; 289 FieldIndex: Integer; Row, Data: TJSONData); 290begin 291 (Row as TJSONObject).Elements[FieldName]:=Data; 292end; 293 294function TJSONObjectFieldMapper.GetJSONDataForField(const FieldName: String; 295 FieldIndex: Integer; Row: TJSONData): TJSONData; 296begin 297 Result:=(Row as TJSONObject).Elements[FieldName]; 298end; 299 300function TJSONObjectFieldMapper.CreateRow: TJSONData; 301begin 302 Result:=TJSONObject.Create; 303end; 304 305procedure TBaseJSONDataSet.SetMetaData(AValue: TJSONObject); 306begin 307 CheckInActive; 308 if FMetaData=AValue then 309 Exit; 310 If OwnsData then 311 FreeAndNil(FMetaData); 312 FMetaData:=AValue; 313end; 314 315procedure TBaseJSONDataSet.SetRows(AValue: TJSONArray); 316begin 317 CheckInActive; 318 if FRows=AValue then Exit; 319 If OwnsData then 320 FreeAndNil(FRows); 321 FRows:=AValue; 322end; 323 324function TBaseJSONDataSet.AllocRecordBuffer: TRecordBuffer; 325begin 326 Result := TRecordBuffer(StrAlloc(fRecordSize)); 327end; 328 329// the next two are particularly ugly. 330procedure TBaseJSONDataSet.InternalInitRecord(Buffer: TRecordBuffer); 331begin 332 FillChar(Buffer^, FRecordSize, 0); 333end; 334 335procedure TBaseJSONDataSet.FreeRecordBuffer (var Buffer: TRecordBuffer); 336begin 337 StrDispose(pansichar(Buffer)); 338end; 339 340procedure TBaseJSONDataSet.GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); 341begin 342 PInteger(Data)^ := PRecInfo(Buffer)^.Bookmark; 343end; 344 345function TBaseJSONDataSet.GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag; 346begin 347 Result := PRecInfo(Buffer)^.BookmarkFlag; 348end; 349 350function TBaseJSONDataSet.GetRecNo: Integer; 351begin 352 Result := FCurrent + 1; 353end; 354 355procedure TBaseJSONDataSet.InternalInitFieldDefs; 356begin 357 If Assigned(FMetaData) then 358 MetaDataToFieldDefs; 359 if (FieldDefs.Count=0) then 360 Raise EJSONDataset.Create('No fields found'); 361end; 362 363procedure TBaseJSONDataSet.FreeData; 364begin 365 If FOwnsData then 366 begin 367 FreeAndNil(FRows); 368 FreeAndNil(FMetaData); 369 end; 370 if (FCurrentList<>FDefaultList) then 371 FreeAndNil(FCurrentList) 372 else 373 FCurrentList:=Nil; 374 FreeAndNil(FDefaultList); 375 FreeAndNil(FFieldMapper); 376 FCurrentList:=Nil; 377end; 378 379procedure TBaseJSONDataSet.FillList; 380 381Var 382 I : Integer; 383 384begin 385 FDefaultList:=TFPList.Create; 386 For I:=0 to FRows.Count-1 do 387 FDefaultList.Add(FRows[i]); 388 FCurrentList:=FDefaultList; 389end; 390 391Function TExtJSJSONDataSet.StringToFieldType(S : String) : TFieldType; 392 393begin 394 if (s='int') then 395 Result:=ftLargeInt 396 else if (s='float') then 397 Result:=ftFloat 398 else if (s='boolean') then 399 Result:=ftBoolean 400 else if (s='date') then 401 Result:=ftDateTime 402 else if (s='string') or (s='auto') or (s='') then 403 Result:=ftString 404 else 405 if MapUnknownToStringType then 406 Result:=ftString 407 else 408 Raise EJSONDataset.CreateFmt('Unknown JSON data type : %s',[s]); 409end; 410 411Function TExtJSJSONDataSet.GetStringFieldLength(F : TJSONObject; AName : String; AIndex : Integer) : integer; 412 413Var 414 I,L : Integer; 415 D : TJSONData; 416 417begin 418 Result:=0; 419 I:=F.IndexOfName('maxlen'); 420 if (I<>-1) and (F.Items[I].jsonType=jtNumber) then 421 begin 422 Result:=StrToIntDef(trim(F.Items[i].AsString),-1); 423 if (Result=-1) then 424 Raise EJSONDataset.CreateFmt('Invalid maximum length specifier for field %s : %s',[AName,F.Items[i].AsString]) 425 end 426 else 427 begin 428 For I:=0 to FRows.Count-1 do 429 begin 430 D:=FFieldMapper.GetJSONDataForField(Aname,AIndex,FRows[i]); 431 if (D<>Nil) and (D.JsonType<>jtNull) then 432 begin 433 l:=Length(D.AsString); 434 if L>Result then 435 Result:=L; 436 end; 437 end; 438 end; 439 if (Result=0) then 440 Result:=20; 441end; 442 443procedure TExtJSJSONDataSet.LoadFromStream(S: TStream); 444 445Var 446 P : TJSONParser; 447 D : TJSONData; 448 O : TJSONObject; 449 N : String; 450 I : Integer; 451 452begin 453 P:=TJSONParser.Create(S); 454 try 455 D:=P.Parse; 456 try 457 if (D.JSONType=jtObject) then 458 O:=D as TJSONObject 459 else 460 begin 461 FreeAndNil(D); 462 Raise EJSONDataset.Create('Not a valid ExtJS JSON data packet'); 463 end; 464 N:='rows'; 465 // Check metadata 466 I:=O.IndexOfName('metaData'); 467 if (I<>-1) then 468 begin 469 If (O.Items[i].JSONType<>jtObject) then 470 Raise EJSONDataset.Create('Invalid ExtJS JSON metaData in data packet.'); 471 Metadata:=O.Objects['metaData']; 472 O.Extract(I); 473 I:=Metadata.IndexOfName('root'); 474 If (I<>-1) then 475 begin 476 if (MetaData.Items[i].JSONType<>jtString) then 477 Raise EJSONDataset.Create('Invalid ExtJS JSON root element in metaData.'); 478 N:=MetaData.Strings['root']; 479 end; 480 end; 481 // Check rows 482 I:=O.IndexOfName(N); 483 if (I=-1) then 484 Raise EJSONDataset.Create('Missing rows in data packet'); 485 if (O.Items[i].JSONType<>jtArray) then 486 Raise EJSONDataset.Create('Rows element must be an array'); 487 Rows:=O.Items[i] as TJSONArray; 488 O.Extract(I); 489 OwnsData:=True; 490 finally 491 D.Free; 492 end; 493 finally 494 P.Free; 495 end; 496end; 497 498procedure TExtJSJSONDataSet.LoadFromFile(const AFileName: string); 499 500Var 501 F : TFileStream; 502 503begin 504 F:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite); 505 try 506 LoadFromStream(F); 507 finally 508 F.Free; 509 end; 510end; 511 512procedure TExtJSJSONDataSet.SaveToStream(S: TStream; SaveMetaData: Boolean); 513 514Var 515 O : TJSONObject; 516 SS : TStringStream; 517 N : String; 518 I : Integer; 519 M : TJSONobject; 520 521begin 522 O:=TJSONObject.Create; 523 try 524 N:='rows'; 525 If SaveMetaData then 526 begin 527 M:=MetaData; 528 if M=Nil then 529 M:=GenerateMetaData; 530 O.Add('metaData',M); 531 if M.IndexOfName('root')<>-1 then 532 N:=M.Strings['root']; 533 end; 534 O.Add(N,Rows); 535 SS:=TStringStream.Create(O.FormatJSON()); 536 try 537 S.CopyFrom(SS,0); 538 finally 539 SS.Free; 540 end; 541 finally 542 If (MetaData<>Nil) and SaveMetaData then 543 begin 544 I:=O.IndexOfName('metaData'); 545 if (I<>-1) then 546 O.Extract(i); 547 end; 548 O.Extract(O.IndexOfName(N)); 549 O.Free; 550 end; 551end; 552 553procedure TExtJSJSONDataSet.SaveToFile(const AFileName: String; 554 SaveMetaData: Boolean); 555 556Var 557 F : TFileStream; 558 559begin 560 F:=TFileStream.Create(AFileName,fmCreate); 561 try 562 SaveToStream(F,SaveMetaData); 563 finally 564 F.Free; 565 end; 566end; 567 568procedure TExtJSJSONDataSet.MetaDataToFieldDefs; 569 570Var 571 A : TJSONArray; 572 F : TJSONObject; 573 I,J,FS : Integer; 574 N,idf : String; 575 ft: TFieldType; 576 D : TJSONData; 577 578begin 579 FieldDefs.Clear; 580 I:=FMetadata.IndexOfName('fields'); 581 if (I=-1) or (FMetaData.Items[i].JSONType<>jtArray) then 582 Raise EJSONDataset.Create('Invalid metadata object'); 583 A:=FMetadata.Arrays['fields']; 584 For I:=0 to A.Count-1 do 585 begin 586 If (A.Types[i]<>jtObject) then 587 Raise EJSONDataset.CreateFmt('Field definition %d in metadata (%s) is not an object',[i,A[i].AsJSON]); 588 F:=A.Objects[i]; 589 J:=F.IndexOfName('name'); 590 If (J=-1) or (F.Items[J].JSONType<>jtString) then 591 Raise EJSONDataset.CreateFmt('Field definition %d in has no or invalid name property',[i]); 592 N:=F.Items[J].AsString; 593 J:=F.IndexOfName('type'); 594 If (J=-1) then 595 ft:=ftstring 596 else If (F.Items[J].JSONType<>jtString) then 597 Raise EJSONDataset.CreateFmt('Field definition %d in has invalid type property',[i]) 598 else 599 ft:=StringToFieldType(F.Items[J].asString); 600 if (ft=ftString) then 601 fs:=GetStringFieldLength(F,N,I) 602 else 603 fs:=0; 604 FieldDefs.Add(N,ft,fs); 605 end; 606 FFields:=A; 607end; 608 609function TExtJSJSONDataSet.GenerateMetaData: TJSONObject; 610 611Var 612 F : TJSONArray; 613 O : TJSONObject; 614 I,M : Integer; 615 T : STring; 616 617begin 618 Result:=TJSONObject.Create; 619 F:=TJSONArray.Create; 620 Result.Add('fields',F); 621 For I:=0 to FieldDefs.Count -1 do 622 begin 623 O:=TJSONObject.Create(['name',FieldDefs[i].name]); 624 F.Add(O); 625 M:=0; 626 case FieldDefs[i].DataType of 627 ftfixedwidechar, 628 ftwideString, 629 ftfixedchar, 630 ftString: 631 begin 632 T:='string'; 633 M:=FieldDefs[i].Size; 634 end; 635 ftBoolean: T:='boolean'; 636 ftDate, 637 ftTime, 638 ftDateTime: T:='date'; 639 ftFloat: t:='float'; 640 ftSmallint, 641 ftInteger, 642 ftAutoInc, 643 ftLargeInt, 644 ftword: t:='int'; 645 else 646 Raise EJSONDataset.CreateFmt('Unsupported field type : %s',[GetEnumName(TypeInfo(TFieldType),Ord(FieldDefs[i].DataType))]); 647 end; // case 648 O.Strings['type']:=t; 649 if M<>0 then 650 O.Integers['maxlen']:=M; 651 end; 652 Result.strings['root']:='rows'; 653end; 654 655Function TExtJSJSONDataSet.ConvertDateFormat(S : String) : String; 656 657{ Not handled: N S w z W t L o O P T Z c U MS } 658 659begin 660 Result:=StringReplace(S,'y','yy',[rfReplaceall]); 661 Result:=StringReplace(Result,'Y','yyyy',[rfReplaceall]); 662 Result:=StringReplace(Result,'g','h',[rfReplaceall]); 663 Result:=StringReplace(Result,'G','hh',[rfReplaceall]); 664 Result:=StringReplace(Result,'F','mmmm',[rfReplaceall]); 665 Result:=StringReplace(Result,'M','mmm',[rfReplaceall]); 666 Result:=StringReplace(Result,'n','m',[rfReplaceall]); 667 Result:=StringReplace(Result,'D','ddd',[rfReplaceall]); 668 Result:=StringReplace(Result,'j','d',[rfReplaceall]); 669 Result:=StringReplace(Result,'l','dddd',[rfReplaceall]); 670 Result:=StringReplace(Result,'i','nn',[rfReplaceall]); 671 Result:=StringReplace(Result,'u','zzz',[rfReplaceall]); 672 Result:=StringReplace(Result,'a','am/pm',[rfReplaceall,rfIgnoreCase]); 673 Result:=LowerCase(Result); 674end; 675 676procedure TExtJSJSONDataSet.InitDateTimeFields; 677 678Var 679 F : TJSONObject; 680 FF : TField; 681 I,J : Integer; 682 Fmt : String; 683 684begin 685 If (FFields=Nil) then 686 Exit; 687 For I:=0 to FFields.Count-1 do 688 begin 689 F:=FFields.Objects[i]; 690 J:=F.IndexOfName('type'); 691 if (J<>-1) and (F.Items[J].JSONType=jtString) and (F.items[J].AsString='date') then 692 begin 693 J:=F.IndexOfName('dateFormat'); 694 if (J<>-1) and (F.Items[J].JSONType=jtString) then 695 begin 696 FMT:=ConvertDateFormat(F.Items[J].AsString); 697 FF:=FindField(F.Strings['name']); 698 if (FF<>Nil) and (FF.DataType in [ftDate,ftTime,ftDateTime]) and (FF.FieldKind=fkData) then 699 begin 700 701 if FF is TJSONDateField then 702 TJSONDateField(FF).DateFormat:=Fmt 703 else if FF is TJSONTimeField then 704 TJSONTimeField(FF).TimeFormat:=Fmt 705 else if FF is TJSONDateTimeField then 706 TJSONDateTimeField(FF).DateTimeFormat:=Fmt; 707 end; 708 end; 709 end; 710 end; 711end; 712 713function TBaseJSONDataSet.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; 714 DoCheck: Boolean): TGetResult; 715begin 716 Result := grOK; // default 717 case GetMode of 718 gmNext: // move on 719 if fCurrent < fCurrentList.Count - 1 then 720 Inc (fCurrent) 721 else 722 Result := grEOF; // end of file 723 gmPrior: // move back 724 if fCurrent > 0 then 725 Dec (fCurrent) 726 else 727 Result := grBOF; // begin of file 728 gmCurrent: // check if empty 729 if fCurrent >= fCurrentList.Count then 730 Result := grEOF; 731 end; 732 if Result = grOK then // read the data 733 with PRecInfo(Buffer)^ do 734 begin 735 Index := fCurrent; 736 BookmarkFlag := bfCurrent; 737 Bookmark := fCurrent; 738 end; 739end; 740 741function TBaseJSONDataSet.GetRecordCount: Integer; 742begin 743 Result := FCurrentList.Count; 744end; 745 746function TBaseJSONDataSet.GetRecordSize: Word; 747begin 748 Result := SizeOf(Integer); // actual data without house-keeping 749end; 750 751 752procedure TBaseJSONDataSet.InternalClose; 753begin 754 // disconnet and destroy field objects 755 BindFields (False); 756 if DefaultFields then 757 DestroyFields; 758 FreeData; 759end; 760 761procedure TBaseJSONDataSet.InternalDelete; 762 763Var 764 R : TJSONData; 765 766begin 767 R:=TJSONData(FCurrentList[FCurrent]); 768 FCurrentList.Delete(FCurrent); 769 if (FCurrent>=FCurrentList.Count) then 770 Dec(FCurrent); 771 FRows.Remove(R); 772end; 773 774procedure TBaseJSONDataSet.InternalFirst; 775begin 776 FCurrent := -1; 777end; 778 779procedure TBaseJSONDataSet.InternalGotoBookmark(ABookmark: Pointer); 780begin 781 if (ABookmark <> nil) then 782 FCurrent := Integer (ABookmark); 783end; 784 785procedure TBaseJSONDataSet.InternalInsert; 786 787Var 788 I : Integer; 789 D : TFieldDef; 790 791begin 792 FEditRow:=FFieldMapper.CreateRow; 793 For I:=0 to FieldDefs.Count-1 do 794 begin 795 D:=FieldDefs[i]; 796 FFieldMapper.SetJSONDataForField(D.Name,D.Index,FEditRow,TJSONNull.Create); 797 end; 798end; 799 800procedure TBaseJSONDataSet.InternalEdit; 801begin 802 FEditRow:=TJSONData(FCurrentList[FCurrent]).Clone; 803end; 804 805procedure TBaseJSONDataSet.InternalCancel; 806begin 807 FreeAndNil(FEditRow); 808end; 809 810procedure TBaseJSONDataSet.InternalLast; 811begin 812 FCurrent:=FCurrentList.Count-1; 813end; 814 815procedure TBaseJSONDataSet.InitDateTimeFields; 816 817begin 818 // Do nothing 819end; 820 821procedure TBaseJSONDataSet.InternalOpen; 822begin 823 FreeAndNil(FFieldMapper); 824 FFieldMapper:=CreateFieldMapper; 825 IF (FRows=Nil) then // opening from fielddefs ? 826 begin 827 FRows:=TJSONArray.Create; 828 OwnsData:=True; 829 end; 830 FillList; 831 InternalInitFieldDefs; 832 if DefaultFields then 833 CreateFields; 834 BindFields (True); 835 InitDateTimeFields; 836 FRecordSize := sizeof (TRecInfo); 837 FCurrent := -1; 838 BookmarkSize := sizeOf (Integer); 839end; 840 841procedure TBaseJSONDataSet.InternalPost; 842 843Var 844 RI,I : integer; 845begin 846 GetBookMarkData(ActiveBuffer,@I); 847 if (State=dsInsert) then 848 begin // Insert or Append 849 FRows.Add(FEditRow); 850 if GetBookMarkFlag(ActiveBuffer)=bfEOF then 851 begin // Append 852 FDefaultList.Add(FEditRow); 853 if (FCurrentList<>FDefaultList) then 854 FCurrentList.Add(FEditRow); 855 end 856 else // insert 857 begin 858 FCurrentList.Insert(FCurrent,FEditRow); 859 if (FCurrentList<>FDefaultList) then 860 FDefaultList.Add(FEditRow); 861 end; 862 end 863 else 864 begin // Edit 865 RI:=FRows.IndexOf(TJSONData(FCurrentList[FCurrent])); 866 if (RI<>-1) then 867 FRows[RI]:=FEditRow 868 else 869 FRows.Add(FEditRow); 870 FCurrentList[FCurrent]:=FEditRow; 871 if (FCurrentList<>FDefaultList) then 872 FDefaultList[FCurrent]:=FEditRow; 873 end; 874 FEditRow:=Nil; 875end; 876 877procedure TBaseJSONDataSet.InternalSetToRecord(Buffer: TRecordBuffer); 878begin 879 FCurrent := PRecInfo(Buffer)^.Index; 880end; 881 882function TBaseJSONDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass; 883begin 884 case FieldType of 885 ftDate : Result:=TJSONDateField; 886 ftDateTime : Result:=TJSONDateTimeField; 887 ftTime : Result:=TJSONTimeField; 888 else 889 Result:=inherited GetFieldClass(FieldType); 890 end; 891end; 892 893function TBaseJSONDataSet.IsCursorOpen: Boolean; 894begin 895 Result := Assigned(FDefaultList); 896end; 897 898procedure TBaseJSONDataSet.SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); 899begin 900 PRecInfo(Buffer)^.Bookmark := PInteger(Data)^; 901end; 902 903function TBaseJSONDataSet.ConvertDateTimeField(S : String; F : TField) : TDateTime; 904 905Var 906 Ptrn : string; 907 908begin 909 Result:=0; 910 Case F.DataType of 911 ftDate : Ptrn:=TJSONDateField(F).DateFormat; 912 ftTime : Ptrn:=TJSONTimeField(F).TimeFormat; 913 ftDateTime : Ptrn:=TJSONDateTimeField(F).DateTimeFormat; 914 end; 915 If (Ptrn='') then 916 Case F.DataType of 917 ftDate : Result:=StrToDate(S); 918 ftTime : Result:=StrToTime(S); 919 ftDateTime : Result:=StrToDateTime(S); 920 end 921 else 922 begin 923 Result:=ScanDateTime(ptrn,S,1); 924 end; 925end; 926 927function TBaseJSONDataSet.FormatDateTimeField(DT: TDateTime; F: TField 928 ): String; 929 930Var 931 Ptrn : string; 932begin 933 Result:=''; 934 Case F.DataType of 935 ftDate : Ptrn:=TJSONDateField(F).DateFormat; 936 ftTime : Ptrn:=TJSONTimeField(F).TimeFormat; 937 ftDateTime : Ptrn:=TJSONDateTimeField(F).DateTimeFormat; 938 end; 939 If (Ptrn='') then 940 Case F.DataType of 941 ftDate : Result:=DateToStr(DT); 942 ftTime : Result:=TimeToStr(DT); 943 ftDateTime : Result:=DateTimeToStr(DT); 944 end 945 else 946 Result:=FormatDateTime(ptrn,DT); 947end; 948 949function TBaseJSONDataSet.GetFieldData(Field: TField; Buffer: Pointer 950 ; NativeFormat : Boolean): Boolean; 951var 952 R,F : TJSONData; 953 B : WordBool; 954 s: string; 955 w : widestring; 956 D : TDateTime; 957 FV : Double; 958 I : Longint; 959 li : int64; 960 961begin 962 I:=PRecInfo(ActiveBuffer)^.Index; 963 // Writeln('Index : ',I,'<',FCurrentList.Count,' ?'); 964 if (I<>-1) then 965 R:=TJSONData(FCurrentList[i]) 966 else 967 R:=FEditRow; 968 F:=FFieldMapper.GetJSONDataForField(Field,R); 969 Result:=(F<>Nil) and not (F.JSONType in [jtUnknown,jtNull]); 970 if not Result then 971 exit; 972 case Field.DataType of 973 ftfixedwidechar, 974 ftwideString: 975 begin 976 W:=F.AsString; 977 if (length(W)>0) then 978 Move(W[1],Buffer^,Length(W)*SizeOf(Widechar)+1) 979 else 980 PChar(Buffer)^:=#0; 981 end; 982 ftfixedchar, 983 ftString: 984 begin 985 S:=F.AsString; 986 if (length(s)>0) then 987 Move(S[1],Buffer^,Length(S)+1) 988 else 989 PChar(Buffer)^:=#0; 990 end; 991 ftBoolean: 992 begin 993 B:=F.AsBoolean; 994 Move(B,Buffer^,sizeof(WordBool)); 995 end; 996 ftDate, 997 ftTime, 998 ftDateTime: 999 begin 1000 D:=ConvertDateTimeField(F.AsString,Field); 1001 Move(D,Buffer^,sizeof(TDateTime)); 1002 end; 1003 ftFloat: 1004 begin 1005 Fv:=F.asFloat; 1006 Move(FV,Buffer^,sizeof(Double)); 1007 end; 1008 ftSmallint, 1009 ftInteger, 1010 ftAutoInc, 1011 ftword: 1012 begin 1013 I:=F.AsInteger; 1014 Move(I,Buffer^,SizeOf(I)); 1015 end; 1016 ftLargeint: 1017 begin 1018 LI:=F.AsInt64; 1019 Move(LI,Buffer^,SizeOf(LI)); 1020 end; 1021 else 1022 Raise EJSONDataset.CreateFmt('Unsupported field type : %s',[GetEnumName(TypeInfo(TFieldType),Ord(Field.DataType))]); 1023 end; // case 1024end; 1025 1026procedure TBaseJSONDataSet.SetFieldData(Field: TField; Buffer: Pointer; NativeFormat : Boolean); 1027var 1028 R,F : TJSONData; 1029 B : PWordBool; 1030 s: string; 1031 w : widestring; 1032 D : TDateTime; 1033 FV : Double; 1034 I : Longint; 1035 li : int64; 1036 1037begin 1038 F:=Nil; 1039 if (Buffer<>nil) then 1040 case Field.DataType of 1041 ftfixedwidechar, 1042 ftwideString: 1043 begin 1044 SetLength(W,Field.Size); 1045 if (length(W)>0) then 1046 Move(Buffer^,W[1],Field.Size*SizeOf(Widechar)); 1047 F:=TJSONString.Create(W); 1048 end; 1049 ftfixedchar, 1050 ftString: 1051 F:=TJSONString.Create(StrPas(Buffer)); 1052 ftBoolean: 1053 F:=TJSONBoolean.Create(PWordBool(Buffer)^); 1054 ftDate, 1055 ftTime, 1056 ftDateTime: 1057 begin 1058 S:=FormatDateTimeField(PDateTime(Buffer)^,Field); 1059 F:=TJSONString.Create(S); 1060 end; 1061 ftFloat: 1062 F:=TJSONFloatNumber.Create(PDouble(Buffer)^); 1063 ftSmallint, 1064 ftInteger, 1065 ftAutoInc, 1066 ftword: 1067 F:=TJSONIntegerNumber.Create(PLongint(Buffer)^); 1068 ftLargeint: 1069 begin 1070 F:=TJSONInt64Number.Create(PInt64(Buffer)^); 1071 end; 1072 else 1073 Raise EJSONDataset.CreateFmt('Unsupported field type : %s',[GetEnumName(TypeInfo(TFieldType),Ord(Field.DataType))]); 1074 end; // case 1075 if (F=Nil) then 1076 F:=TJSONNull.Create; 1077// Writeln('Set field data : ',F.AsJSON); 1078 FFieldMapper.SetJSONDataForField(Field,FEditRow,F); 1079// Writeln('Field data is set : ',FEditRow.AsJSON); 1080end; 1081 1082procedure TBaseJSONDataSet.SetBookmarkFlag(Buffer: TRecordBuffer; 1083 Value: TBookmarkFlag); 1084begin 1085 PRecInfo(Buffer)^.BookmarkFlag := Value; 1086end; 1087 1088procedure TBaseJSONDataSet.SetRecNo(Value: Integer); 1089begin 1090 if (Value < 0) or (Value > FCurrentList.Count) then 1091 raise EJSONDataset.CreateFmt('SetRecNo: index %d out of range',[Value]); 1092 FCurrent := Value - 1; 1093 Resync([]); 1094 DoAfterScroll; 1095end; 1096 1097constructor TBaseJSONDataSet.Create(AOwner: TComponent); 1098begin 1099 inherited; 1100 FownsData:=True; 1101end; 1102 1103destructor TBaseJSONDataSet.Destroy; 1104begin 1105 FreeData; 1106 inherited; 1107end; 1108 1109end.