Browse Source

Add BTree index for JSON Objects names

PascalCoinDev 2 years ago
parent
commit
005cca2c38

+ 97 - 7
src/libraries/pascalcoin/UJSONFunctions.pas

@@ -27,6 +27,9 @@ Uses
 {$DEFINE DELPHIXE}
 {$DEFINE DELPHIXE}
 {$ENDIF}
 {$ENDIF}
 
 
+{$DEFINE USE_BTREE}
+{$DEFINE JSONOBJECTS_NAMES_CASE_SENSITIVITY}
+
   {$IFDEF FPC}
   {$IFDEF FPC}
   fpjson, jsonparser,
   fpjson, jsonparser,
   {$ELSE}
   {$ELSE}
@@ -36,6 +39,7 @@ Uses
   DBXJSON,
   DBXJSON,
   {$ENDIF}
   {$ENDIF}
   SysUtils, DateUtils, Variants, Classes,
   SysUtils, DateUtils, Variants, Classes,
+  {$IFDEF USE_BTREE}UAbstractBTree,{$ENDIF}
   {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF};
   {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF};
 
 
 Type
 Type
@@ -127,10 +131,10 @@ Type
     Constructor Create; override;
     Constructor Create; override;
     Destructor Destroy; override;
     Destructor Destroy; override;
     Property Items[Index:Integer] : TPCJSONData read GetItems write SetItems;
     Property Items[Index:Integer] : TPCJSONData read GetItems write SetItems;
-    Procedure Insert(Index:Integer; PCJSONData:TPCJSONData);
-    Procedure Delete(index : Integer);
+    Procedure Insert(Index:Integer; PCJSONData:TPCJSONData); virtual;
+    Procedure Delete(index : Integer); virtual;
     function Count : Integer;
     function Count : Integer;
-    Procedure Clear;
+    Procedure Clear; virtual;
   End;
   End;
 
 
   TPCJSONArray = class(TPCJSONList)
   TPCJSONArray = class(TPCJSONList)
@@ -152,6 +156,11 @@ Type
 
 
   TPCJSONObject = Class(TPCJSONList)
   TPCJSONObject = Class(TPCJSONList)
   private
   private
+    {$IFDEF USE_BTREE}
+    FSearchingValue : String;
+    FOrderedByName : TMemoryBTree<Integer>;
+    function CompareBTree(const Left, Right: Integer): Integer;
+    {$ENDIF}
     Function GetIndexOrCreateName(Name : String) : Integer;
     Function GetIndexOrCreateName(Name : String) : Integer;
     Function GetByName(Name : String) : TPCJSONNameValue;
     Function GetByName(Name : String) : TPCJSONNameValue;
   protected
   protected
@@ -183,6 +192,10 @@ Type
     Function GetNameValue(index : Integer) : TPCJSONNameValue;
     Function GetNameValue(index : Integer) : TPCJSONNameValue;
     Function IsNull(ParamName : String) : Boolean;
     Function IsNull(ParamName : String) : Boolean;
     Procedure SetAs(Name : String; Value : TPCJSONData);
     Procedure SetAs(Name : String; Value : TPCJSONData);
+    Procedure Delete(index : Integer); override;
+    Procedure Clear; override;
+    Procedure Insert(Index:Integer; PCJSONData:TPCJSONData); override;
+    procedure CheckConsistency;
   End;
   End;
 
 
   EPCParametresError = Class(Exception);
   EPCParametresError = Class(Exception);
@@ -771,6 +784,14 @@ begin
   if Not (PCJSONData is TPCJSONNameValue) then raise Exception.Create('Object inside a '+TPCJSONData.ClassName+' must be a '+TPCJSONNameValue.ClassName+' (currently '+PCJSONData.ClassName+')');
   if Not (PCJSONData is TPCJSONNameValue) then raise Exception.Create('Object inside a '+TPCJSONData.ClassName+' must be a '+TPCJSONNameValue.ClassName+' (currently '+PCJSONData.ClassName+')');
 end;
 end;
 
 
+procedure TPCJSONObject.CheckConsistency;
+begin
+  {$IFDEF USE_BTREE}
+  FOrderedByName.CheckConsistency;
+  if FOrderedByName.Count<>Count then raise EPCParametresError.Create('Not valid counters');
+  {$ENDIF}
+end;
+
 procedure TPCJSONObject.CheckValidName(Name: String);
 procedure TPCJSONObject.CheckValidName(Name: String);
 Var i : Integer;
 Var i : Integer;
 begin
 begin
@@ -783,9 +804,20 @@ begin
   end;
   end;
 end;
 end;
 
 
+procedure TPCJSONObject.Clear;
+begin
+  inherited;
+  {$IFDEF USE_BTREE}
+  FOrderedByName.EraseTree;
+  {$ENDIF}
+end;
+
 constructor TPCJSONObject.Create;
 constructor TPCJSONObject.Create;
 begin
 begin
   inherited;
   inherited;
+  {$IFDEF USE_BTREE}
+  FOrderedByName := TMemoryBTree<Integer>.Create(CompareBTree,False,7);
+  {$ENDIF}
 end;
 end;
 
 
 constructor TPCJSONObject.CreateFromJSONObject(JSONObject: TJSONObject);
 constructor TPCJSONObject.CreateFromJSONObject(JSONObject: TJSONObject);
@@ -821,6 +853,34 @@ begin
   {$ENDIF}
   {$ENDIF}
 end;
 end;
 
 
+{$IFDEF USE_BTREE}
+function TPCJSONObject.CompareBTree(const Left, Right: Integer): Integer;
+var sLeft,sRight : String;
+begin
+  if Left=-1 then sLeft := FSearchingValue
+  else if (Left>=0) and (Left<FList.Count) and (Assigned(FList.Items[Left])) And (TObject(FList.Items[Left]) is TPCJSONNameValue) then sLeft := TPCJSONNameValue( FList.Items[Left] ).Name
+  else raise EPCParametresError.Create('Invalid JSON left index '+Left.ToString);
+  if Right=-1 then sRight := FSearchingValue
+  else if (Right>=0) and (Right<FList.Count) and (Assigned(FList.Items[Right])) And (TObject(FList.Items[Right]) is TPCJSONNameValue) then sRight := TPCJSONNameValue( FList.Items[Right] ).Name
+  else raise EPCParametresError.Create('Invalid JSON right index '+Right.ToString);
+  {$IFDEF JSONOBJECTS_NAMES_CASE_SENSITIVITY}
+  // NOTE: CompareStr is case sensitivity
+  Result := CompareStr(sLeft,sRight);
+  {$ELSE}
+  Result := CompareText(sLeft,sRight);
+  {$ENDIF}
+end;
+{$ENDIF}
+
+procedure TPCJSONObject.Delete(index: Integer);
+begin
+  {$IFDEF USE_BTREE}
+  if (index<0) or (index>=FList.Count) then raise EPCParametresError.Create('Invalid delete index '+index.ToString+'/'+FList.Count.ToString);
+  FSearchingValue :=  TPCJSONNameValue( FList.Items[index] ).Name;
+  FOrderedByName.Delete(-1);
+  {$ENDIF}
+  inherited;
+end;
 
 
 procedure TPCJSONObject.DeleteName(Name: String);
 procedure TPCJSONObject.DeleteName(Name: String);
 Var i : Integer;
 Var i : Integer;
@@ -833,8 +893,10 @@ end;
 
 
 destructor TPCJSONObject.Destroy;
 destructor TPCJSONObject.Destroy;
 begin
 begin
-
   inherited;
   inherited;
+  {$IFDEF USE_BTREE}
+  FOrderedByName.Free;
+  {$ENDIF}
 end;
 end;
 
 
 function TPCJSONObject.FindName(Name: String): TPCJSONNameValue;
 function TPCJSONObject.FindName(Name: String): TPCJSONNameValue;
@@ -893,7 +955,8 @@ Begin
   if (Result<0) then begin
   if (Result<0) then begin
     CheckValidName(Name);
     CheckValidName(Name);
     NV := TPCJSONNameValue.Create(Name);
     NV := TPCJSONNameValue.Create(Name);
-    Result := FList.Add(NV);
+    Result := FList.Count;
+    Insert(Result,NV);
   end;
   end;
 end;
 end;
 
 
@@ -918,15 +981,42 @@ begin
 end;
 end;
 
 
 function TPCJSONObject.IndexOfName(Name: String): Integer;
 function TPCJSONObject.IndexOfName(Name: String): Integer;
+{$IFDEF USE_BTREE}
+var bnode : TMemoryBTree<Integer>.TAbstractBTreeNode;
+  i : Integer;
+{$ENDIF}
 begin
 begin
+  {$IFDEF USE_BTREE}
+  FSearchingValue := Name;
+  if FOrderedByName.Find(-1,bnode,i) then begin
+    Result := bnode.data[i];
+  end else Result := -1;
+  {$ELSE}
   for Result := 0 to FList.Count - 1 do begin
   for Result := 0 to FList.Count - 1 do begin
     if (Assigned(FList.Items[Result])) And (TObject(FList.Items[Result]) is TPCJSONNameValue) then begin
     if (Assigned(FList.Items[Result])) And (TObject(FList.Items[Result]) is TPCJSONNameValue) then begin
-      If TPCJSONNameValue( FList.Items[Result] ).Name = Name then begin
-        exit;
+      {$IFDEF JSONOBJECTS_NAMES_CASE_SENSITIVITY}
+      // NOTE: CompareStr is case sensitivity
+      If CompareStr(TPCJSONNameValue( FList.Items[Result] ).Name, Name)=0 then begin
+        Exit;
+      end;
+      {$ELSE}
+      if CompareText(TPCJSONNameValue( FList.Items[Result] ).Name, Name)=0 then begin
+        Exit;
       end;
       end;
+      {$ENDIF}
     end;
     end;
   end;
   end;
   Result := -1;
   Result := -1;
+  {$ENDIF}
+end;
+
+procedure TPCJSONObject.Insert(Index: Integer; PCJSONData: TPCJSONData);
+begin
+  inherited;
+  {$IFDEF USE_BTREE}
+  FSearchingValue := TPCJSONNameValue(PCJSONData).Name;
+  if not FOrderedByName.Add( Index ) then raise EPCParametresError.Create('Error adding "'+FSearchingValue+'" index '+Index.ToString+' on BTree');
+  {$ENDIF}
 end;
 end;
 
 
 function TPCJSONObject.HasName(Name: String): Boolean;
 function TPCJSONObject.HasName(Name: String): Boolean;

+ 66 - 0
src/libraries/pascalcoin/tests/JSONFunctions.Tests.dpr

@@ -0,0 +1,66 @@
+program JSONFunctions.Tests;
+
+{$IFDEF FPC}
+  {$MODE Delphi}
+{$ENDIF}
+
+// Enable for Console tests
+{.$DEFINE CONSOLE_TESTRUNNER}
+
+{$IFDEF CONSOLE_TESTRUNNER}
+  {$APPTYPE CONSOLE}
+{$ENDIF}
+
+uses
+  {$IFDEF FPC}
+  {$IFDEF CONSOLE_TESTRUNNER}
+  Classes,
+  {$ELSE}
+  Interfaces,
+  Forms, GuiTestRunner,
+  {$ENDIF }
+  {$ELSE}
+  Forms,
+  TestFramework,
+  GUITestRunner,
+  TextTestRunner,
+  {$ENDIF }
+  UAbstractBTree in '..\..\abstractmem\UAbstractBTree.pas',
+  UOrderedList in '..\..\abstractmem\UOrderedList.pas',
+  UJSONFunctions in '..\UJSONFunctions.pas',
+  UJSONFunctions.Tests in 'src\UJSONFunctions.Tests.pas';
+
+{$IF Defined(FPC) and (Defined(CONSOLE_TESTRUNNER))}
+type
+  TFreePascalConsoleRunner = class(TTestRunner)
+  protected
+  end;
+var
+  Application : TFreePascalConsoleRunner;
+{$ENDIF}
+
+begin
+  {$IFNDEF FPC}
+  System.ReportMemoryLeaksOnShutdown := True;
+  {$ENDIF}
+
+  {$IF Defined(FPC) and (Defined(CONSOLE_TESTRUNNER))}
+  Application := TFreePascalConsoleRunner.Create(nil);
+  {$ENDIF}
+
+  Application.Title:='Test';
+  Application.Initialize;
+  {$IFDEF FPC}
+  {$IF Not Defined(CONSOLE_TESTRUNNER)}
+  Application.CreateForm(TGuiTestRunner, TestRunner);
+  {$ENDIF}
+  Application.Run;
+  {$ELSE}
+  if IsConsole then
+    TextTestRunner.RunRegisteredTests
+  else
+    GUITestRunner.RunRegisteredTests;
+  {$ENDIF}
+end.
+
+

+ 76 - 0
src/libraries/pascalcoin/tests/src/UJSONFunctions.Tests.pas

@@ -0,0 +1,76 @@
+unit UJSONFunctions.Tests;
+
+{$IFDEF FPC}
+  {$MODE Delphi}
+{$ENDIF}
+
+interface
+
+uses
+   SysUtils,
+   {$IFDEF FPC}
+   fpcunit, testutils, testregistry,
+   {$ELSE}
+   TestFramework,
+   {$ENDIF}
+   UJSONFunctions,
+   UAbstractBTree, UOrderedList;
+
+type
+   TestJSONFunctions = class(TTestCase)
+   strict private
+   public
+     procedure SetUp; override;
+     procedure TearDown; override;
+   published
+     procedure Test_JSON;
+   end;
+
+implementation
+
+
+
+
+{ TestJSONFunctions }
+
+procedure TestJSONFunctions.SetUp;
+begin
+  inherited;
+
+end;
+
+procedure TestJSONFunctions.TearDown;
+begin
+  inherited;
+
+end;
+
+procedure TestJSONFunctions.Test_JSON;
+var j : TPCJSONObject;
+begin
+  j := TPCJSONObject.ParseJSONValue('{"a":[1,2,3,4,7],"d":null,"b":null,"C":null,"m":null,"J":"j"}') as TPCJSONObject;
+  try
+    j.AsInteger('j',1);
+    j.AsInteger('J',2);
+    assert(j.HasName('a'),'Not found');
+    assert(j.HasName('b'),'Not found');
+    assert(j.HasName('C'),'Not found');
+    assert(j.HasName('d'),'Not found');
+    assert(j.HasName('m'),'Not found');
+    assert(j.HasName('j'),'Not found');
+    assert(j.HasName('J'),'Not found');
+    j.CheckConsistency;
+    while j.Count>0 do begin
+      j.DeleteName(j.GetNameValue(j.Count-1).Name);
+      j.CheckConsistency;
+    end;
+
+
+  finally
+    j.Free;
+  end;
+end;
+
+initialization
+  RegisterTest(TestJSONFunctions{$IFNDEF FPC}.Suite{$ENDIF});
+end.