* FindPath/GetPath implementation

git-svn-id: trunk@25691 -

packages/fcl-json/src/fpjson.pp

@@ -48,6 +48,7 @@ Type
   
   TJSONData = class(TObject)
   protected
+    Function DoFindPath(Const APath : TJSONStringType; Out NotFound : TJSONStringType) : TJSONdata; virtual;
     function GetAsBoolean: Boolean; virtual; abstract;
     function GetAsFloat: TJSONFloat; virtual; abstract;
     function GetAsInteger: Integer; virtual; abstract;
@@ -70,6 +71,8 @@ Type
     Constructor Create; virtual;
     Class function JSONType: TJSONType; virtual;
     Procedure Clear;  virtual; Abstract;
+    Function FindPath(Const APath : TJSONStringType) : TJSONdata;
+    Function GetPath(Const APath : TJSONStringType) : TJSONdata;
     Function Clone : TJSONData; virtual; abstract;
     Function FormatJSON(Options : TFormatOptions = DefaultFormat; Indentsize : Integer = DefaultIndentSize) : TJSONStringType; 
     property Count: Integer read GetCount;
@@ -274,6 +277,7 @@ Type
     procedure SetObjects(Index : Integer; const AValue: TJSONObject);
     procedure SetStrings(Index : Integer; const AValue: TJSONStringType);
   protected
+    Function DoFindPath(Const APath : TJSONStringType; Out NotFound : TJSONStringType) : TJSONdata; override;
     Procedure Converterror(From : Boolean);
     function GetAsBoolean: Boolean; override;
     function GetAsFloat: TJSONFloat; override;
@@ -368,6 +372,7 @@ Type
     procedure SetObjects(const AName : String; const AValue: TJSONObject);
     procedure SetStrings(const AName : String; const AValue: TJSONStringType);
   protected
+    Function DoFindPath(Const APath : TJSONStringType; Out NotFound : TJSONStringType) : TJSONdata; override;
     Procedure Converterror(From : Boolean);
     function GetAsBoolean: Boolean; override;
     function GetAsFloat: TJSONFloat; override;
@@ -466,7 +471,8 @@ Resourcestring
   SErrOddNumber = 'TJSONObject must be constructed with name,value pairs';
   SErrNameMustBeString = 'TJSONObject constructor element name at pos %d is not a string';
   SErrNonexistentElement = 'Unknown object member: "%s"';
-  
+  SErrPathElementNotFound = 'Path "%s" invalid: element "%s" not found.';
+
 Function StringToJSONString(const S : TJSONStringType) : TJSONStringType;
 
 Var
@@ -573,6 +579,18 @@ begin
   Clear;
 end;
 
+function TJSONData.DoFindPath(const APath: TJSONStringType; out
+  NotFound: TJSONStringType): TJSONdata;
+begin
+  If APath<>'' then
+    begin
+    NotFound:=APath;
+    Result:=Nil;
+    end
+  else
+    Result:=Self;
+end;
+
 function TJSONData.GetIsNull: Boolean;
 begin
   Result:=False;
@@ -583,19 +601,40 @@ begin
   JSONType:=jtUnknown;
 end;
 
+function TJSONData.FindPath(const APath: TJSONStringType): TJSONdata;
+
+Var
+  M : String;
+
+begin
+  Result:=DoFindPath(APath,M);
+end;
+
+function TJSONData.GetPath(const APath: TJSONStringType): TJSONdata;
+
+Var
+  M : String;
+begin
+  Result:=DoFindPath(APath,M);
+  If Result=Nil then
+    Raise EJSON.CreateFmt(SErrPathElementNotFound,[APath,M]);
+end;
+
 procedure TJSONData.SetItem(Index : Integer; const AValue:
   TJSONData);
 begin
   // Do Nothing
 end;
 
-Function TJSONData.FormatJSON(Options : TFormatOptions = DefaultFormat; IndentSize : Integer = DefaultIndentSize) : TJSONStringType;
+function TJSONData.FormatJSON(Options: TFormatOptions; Indentsize: Integer
+  ): TJSONStringType;
 
 begin
   Result:=DoFormatJSON(Options,0,IndentSize);
 end;
 
-Function TJSONData.DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; 
+function TJSONData.DoFormatJSON(Options: TFormatOptions; CurrentIndent,
+  Indent: Integer): TJSONStringType;
 
 begin
   Result:=AsJSON;
@@ -1253,6 +1292,39 @@ begin
   Items[Index]:=TJSONString.Create(AValue);
 end;
 
+function TJSONArray.DoFindPath(const APath: TJSONStringType; out
+  NotFound: TJSONStringType): TJSONdata;
+
+Var
+  P,I : integer;
+  E : String;
+
+begin
+  if (APath<>'') and (APath[1]='[') then
+    begin
+    P:=Pos(']',APath);
+    I:=-1;
+    If (P>2) then
+      I:=StrToIntDef(Copy(APath,2,P-2),-1);
+    If (I>=0) and (I<Count) then
+       begin
+       E:=APath;
+       System.Delete(E,1,P);
+       Result:=Items[i].DoFindPath(E,NotFound);
+       end
+    else
+       begin
+       Result:=Nil;
+       If (P>0) then
+         NotFound:=Copy(APath,1,P)
+       else
+         NotFound:=APath;
+       end;
+    end
+  else
+    Result:=inherited DoFindPath(APath, NotFound);
+end;
+
 procedure TJSONArray.Converterror(From: Boolean);
 begin
   If From then
@@ -1329,7 +1401,8 @@ begin
     Result:=StringOfChar(' ',Indent);  
 end;
 
-Function TJSONArray.DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; 
+function TJSONArray.DoFormatJSON(Options: TFormatOptions; CurrentIndent,
+  Indent: Integer): TJSONStringType;
 
 Var
   I : Integer;
@@ -1430,7 +1503,7 @@ begin
     end;
 end;
 
-constructor TJSONArray.Create(Const Elements: array of const);
+constructor TJSONArray.Create(const Elements: array of const);
 
 Var
   I : integer;
@@ -1445,7 +1518,7 @@ begin
     end;
 end;
 
-Destructor TJSONArray.Destroy;
+destructor TJSONArray.Destroy;
 begin
   FreeAndNil(FList);
   inherited Destroy;
@@ -1630,39 +1703,39 @@ end;
 
 { TJSONObject }
 
-function TJSONObject.GetArrays(Const AName : String): TJSONArray;
+function TJSONObject.GetArrays(const AName: String): TJSONArray;
 begin
   Result:=GetElements(AName) as TJSONArray;
 end;
 
-function TJSONObject.GetBooleans(Const AName : String): Boolean;
+function TJSONObject.GetBooleans(const AName: String): Boolean;
 begin
   Result:=GetElements(AName).AsBoolean;
 end;
 
-function TJSONObject.GetElements(Const AName: string): TJSONData;
+function TJSONObject.GetElements(const AName: string): TJSONData;
 begin
   Result:=TJSONData(FHash.Find(AName));
   If (Result=Nil) then
     Raise EJSON.CreateFmt(SErrNonexistentElement,[AName]);
 end;
 
-function TJSONObject.GetFloats(Const AName : String): TJSONFloat;
+function TJSONObject.GetFloats(const AName: String): TJSONFloat;
 begin
   Result:=GetElements(AName).AsFloat;
 end;
 
-function TJSONObject.GetIntegers(Const AName : String): Integer;
+function TJSONObject.GetIntegers(const AName: String): Integer;
 begin
   Result:=GetElements(AName).AsInteger;
 end;
 
-function TJSONObject.GetInt64s(Const AName : String): Int64;
+function TJSONObject.GetInt64s(const AName: String): Int64;
 begin
   Result:=GetElements(AName).AsInt64;
 end;
 
-function TJSONObject.GetIsNull(Const AName : String): Boolean;
+function TJSONObject.GetIsNull(const AName: String): Boolean;
 begin
   Result:=GetElements(AName).IsNull;
 end;
@@ -1742,6 +1815,40 @@ begin
   SetElements(AName,TJSONString.Create(AVAlue));
 end;
 
+function TJSONObject.DoFindPath(const APath: TJSONStringType; out
+  NotFound: TJSONStringType): TJSONdata;
+
+Var
+  N: TJSONStringType;
+  L,P,P2 : Integer;
+
+begin
+  If (APath='') then
+    Exit(Self);
+  N:=APath;
+  L:=Length(N);
+  P:=1;
+  While (P<L) and (N[P]='.') do
+    inc(P);
+  P2:=P;
+  While (P2<=L) and (Not (N[P2] in ['.','['])) do
+    inc(P2);
+   N:=Copy(APath,P,P2-P);
+   If (N='') then
+     Result:=Self
+   else
+     begin
+     Result:=Find(N);
+     If Result=Nil then
+       NotFound:=N+Copy(APath,P2,L-P2)
+     else
+       begin
+       N:=Copy(APath,P2,L-P2+1);
+       Result:=Result.DoFindPath(N,NotFound);
+       end;
+     end;
+end;
+
 procedure TJSONObject.Converterror(From: Boolean);
 begin
   If From then
@@ -1918,7 +2025,8 @@ begin
 end;
 
 
-Function TJSONObject.DoFormatJSON(Options : TFormatOptions; CurrentIndent, Indent : Integer) : TJSONStringType; 
+function TJSONObject.DoFormatJSON(Options: TFormatOptions; CurrentIndent,
+  Indent: Integer): TJSONStringType;
 
 Var
   i : Integer;
@@ -2041,7 +2149,7 @@ begin
   FHash.Delete(Index);
 end;
 
-procedure TJSONObject.Delete(Const AName: string);
+procedure TJSONObject.Delete(const AName: string);
 
 Var
   I : Integer;
@@ -2142,7 +2250,7 @@ begin
 end;
 
 function TJSONObject.Get(const AName: String; ADefault: TJSONStringType
-  ): TJSONStringType;
+  ): TJSONStringTYpe;
 Var
   D : TJSONData;
 

packages/fcl-json/tests/testjson.lpi

@@ -24,7 +24,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="--format=plain --suite=TCJSONStreamer"/>
+        <CommandLineParams Value="--suite=TTestJSONPath.TestObjectRecursiveObject"/>
         <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
@@ -71,7 +71,7 @@
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="10"/>
+    <Version Value="11"/>
     <SearchPaths>
       <OtherUnitFiles Value="../src"/>
     </SearchPaths>
@@ -82,7 +82,7 @@
     </Parsing>
     <Linking>
       <Debugging>
-        <GenerateDebugInfo Value="True"/>
+        <DebugInfoType Value="dsStabs"/>
         <UseHeaptrc Value="True"/>
       </Debugging>
     </Linking>

packages/fcl-json/tests/testjson.pp

@@ -17,8 +17,7 @@
 program testjson;
 
 uses
-  Classes, consoletestrunner, testjsondata, testjsonparser,
-  fpcunitconsolerunner; //, testjsonrtti, fpjsonrtti;
+  Classes, testjsondata, testjsonparser, consoletestrunner; //, testjsonrtti, fpjsonrtti;
 type
   { TLazTestRunner }
    TMyTestRunner = class(TTestRunner)
@@ -29,6 +28,9 @@ type
 var
   Application: TMyTestRunner;
 begin
+  DefaultFormat := fPlain;
+  DefaultRunAllTests := True;
+
   Application := TMyTestRunner.Create(nil); 
   Application.Initialize;
   Application.Run;  

packages/fcl-json/tests/testjsondata.pp

@@ -209,9 +209,299 @@ type
     Procedure TestFind;
   end;
 
+  { TTestJSONPath }
+
+  TTestJSONPath = class(TTestJSON)
+  private
+    FData: TJSONData;
+  Protected
+    Procedure TearDown; override;
+    Property Data : TJSONData read FData Write FData;
+  Published
+    Procedure TestNullEmpty;
+    Procedure TestNullGet;
+    Procedure TestNullNonExisting;
+    Procedure TestNullNotEmpty;
+    Procedure TestBooleanEmpty;
+    Procedure TestBooleanNotEmpty;
+    Procedure TestIntegerEmpty;
+    Procedure TestIntegerNotEmpty;
+    Procedure TestInt64Empty;
+    Procedure TestInt64NotEmpty;
+    Procedure TestFloatEmpty;
+    Procedure TestFloatNotEmpty;
+    Procedure TestStringEmpty;
+    Procedure TestStringNotEmpty;
+    Procedure TestArrayEmpty;
+    Procedure TestArrayNotIndex;
+    Procedure TestArrayIncompleteIndex;
+    Procedure TestArrayNonNumericalIndex;
+    Procedure TestArrayOutOfRangeIndex;
+    Procedure TestArrayCorrectIndex;
+    Procedure TestArrayRecursiveArray;
+    Procedure TestArrayRecursiveObject;
+    Procedure TestObjectEmpty;
+    Procedure TestObjectDots;
+    Procedure TestObjectExisting;
+    Procedure TestObjectNonExisting;
+    Procedure TestObjectTrailingDot;
+    Procedure TestObjectRecursiveArray;
+    Procedure TestObjectRecursiveObject;
+    Procedure TestDeepRecursive;
+  end;
 
 implementation
 
+{ TTestJSONPath }
+
+procedure TTestJSONPath.TearDown;
+begin
+  FreeAndNil(FData);
+  inherited TearDown;
+end;
+
+procedure TTestJSONPath.TestNullEmpty;
+begin
+  Data:=TJSONNull.Create;
+  AssertSame('Empty on NULL returns object itself',Data,Data.FIndPath(''));
+end;
+
+procedure TTestJSONPath.TestNullGet;
+begin
+  Data:=TJSONNull.Create;
+  AssertSame('Empty get on NULL returns object itself',Data,Data.GetPath(''));
+end;
+
+procedure TTestJSONPath.TestNullNonExisting;
+
+Var
+  Msg : String;
+
+begin
+  Data:=TJSONNull.Create;
+  try
+    Data.GetPath('a.b.c');
+    Msg:='No exception raised'
+  except
+    on E : Exception do
+      begin
+      If Not (E is EJSON) then
+        Msg:='Wrong exception class. Got '+E.ClassName+' instead of EJSON'
+      else
+        If E.Message<>'Path "a.b.c" invalid: element "a.b.c" not found.' then
+          Msg:='Wrong exception message, expected: "Path "a.b.c" invalid: element "a.b.c" not found.", actual: "'+E.Message+'"';
+      end;
+  end;
+  If (Msg<>'') then
+    Fail(Msg);
+end;
+
+procedure TTestJSONPath.TestNullNotEmpty;
+begin
+  Data:=TJSONNull.Create;
+  AssertNull('Not empty on NULL returns nil',Data.FindPath('a'));
+end;
+
+procedure TTestJSONPath.TestBooleanEmpty;
+begin
+  Data:=TJSONBoolean.Create(true);
+  AssertSame('Empty on Boolean returns object itself',Data,Data.FIndPath(''));
+end;
+
+procedure TTestJSONPath.TestBooleanNotEmpty;
+begin
+  Data:=TJSONBoolean.Create(True);
+  AssertNull('Not empty on Boolean returns nil',Data.FindPath('a'));
+end;
+
+procedure TTestJSONPath.TestIntegerEmpty;
+begin
+  Data:=TJSONIntegerNumber.Create(1);
+  AssertSame('Empty on integer returns object itself',Data,Data.FIndPath(''));
+end;
+
+procedure TTestJSONPath.TestIntegerNotEmpty;
+begin
+  Data:=TJSONIntegerNumber.Create(1);
+  AssertNull('Not Empty on integer returns object itself',Data.FIndPath('a'));
+end;
+
+procedure TTestJSONPath.TestInt64Empty;
+begin
+  Data:=TJSONInt64Number.Create(1);
+  AssertSame('Empty on Int64 returns object itself',Data,Data.FIndPath(''));
+end;
+
+procedure TTestJSONPath.TestInt64NotEmpty;
+begin
+  Data:=TJSONInt64Number.Create(1);
+  AssertNull('Not Empty on Int64 returns object itself',Data.FIndPath('a'));
+end;
+
+procedure TTestJSONPath.TestFloatEmpty;
+begin
+  Data:=TJSONFloatNumber.Create(1);
+  AssertSame('Empty on Float returns object itself',Data,Data.FIndPath(''));
+end;
+
+procedure TTestJSONPath.TestFloatNotEmpty;
+begin
+  Data:=TJSONFloatNumber.Create(1);
+  AssertNull('Not Empty on Float returns object itself',Data.FIndPath('a'));
+end;
+
+procedure TTestJSONPath.TestStringEmpty;
+begin
+  Data:=TJSONString.Create('1');
+  AssertSame('Empty on String returns object itself',Data,Data.FIndPath(''));
+end;
+
+procedure TTestJSONPath.TestStringNotEmpty;
+begin
+  Data:=TJSONString.Create('1');
+  AssertNull('Not Empty on String returns object itself',Data.FIndPath('a'));
+end;
+
+procedure TTestJSONPath.TestArrayEmpty;
+begin
+  Data:=TJSONArray.Create([1,2,3]);
+  AssertSame('Empty on array returns object itself',Data,Data.FIndPath(''));
+end;
+
+procedure TTestJSONPath.TestArrayNotIndex;
+begin
+  Data:=TJSONArray.Create([1,2,3]);
+  AssertNull('Not index indication on array returns object itself',Data.FindPath('oo'));
+end;
+
+procedure TTestJSONPath.TestArrayIncompleteIndex;
+begin
+  Data:=TJSONArray.Create([1,2,3]);
+  AssertNull('Not complete index indication on array returns object itself',Data.FindPath('[1'));
+  AssertNull('Not complete index indication on array returns object itself',Data.FindPath('['));
+end;
+
+procedure TTestJSONPath.TestArrayNonNumericalIndex;
+begin
+  Data:=TJSONArray.Create([1,2,3]);
+  AssertNull('Not complete index indication on array returns object itself',Data.FindPath('[a]'));
+end;
+
+procedure TTestJSONPath.TestArrayOutOfRangeIndex;
+begin
+  Data:=TJSONArray.Create([1,2,3]);
+  AssertNull('Not complete index indication on array returns object itself',Data.FindPath('[-1]'));
+  AssertNull('Not complete index indication on array returns object itself',Data.FindPath('[3]'));
+end;
+
+procedure TTestJSONPath.TestArrayCorrectIndex;
+begin
+  Data:=TJSONArray.Create([1,2,3]);
+  AssertSame('Index 0 on array returns item 0',Data.Items[0],Data.FindPath('[0]'));
+  AssertSame('Index 1 on array returns item 1',Data.Items[1],Data.FindPath('[1]'));
+  AssertSame('Index 2 on array returns item 2',Data.Items[2],Data.FindPath('[2]'));
+end;
+
+procedure TTestJSONPath.TestArrayRecursiveArray;
+
+Var
+  A : TJSONArray;
+
+begin
+  A:=TJSONArray.Create([1,2,3]);
+  Data:=TJSONArray.Create([A,1,2,3]);
+  AssertSame('Index [0][0] on array returns item 0',A.Items[0],Data.FindPath('[0][0]'));
+  AssertSame('Index [0][1] on array returns item 1',A.Items[1],Data.FindPath('[0][1]'));
+  AssertSame('Index [0][2] on array returns item 2',A.Items[2],Data.FindPath('[0][2]'));
+end;
+
+procedure TTestJSONPath.TestArrayRecursiveObject;
+
+Var
+  A : TJSONObject;
+
+begin
+  A:=TJSONObject.Create(['a',1,'b',2,'c',3]);
+  Data:=TJSONArray.Create([A,1,2,3]);
+  AssertSame('[0]a on array returns element a of item 0',A.Elements['a'],Data.FindPath('[0]a'));
+  AssertSame('[0]b on array returns element b of item 0',A.Elements['b'],Data.FindPath('[0]b'));
+  AssertSame('[0]c on array returns element c of item 0',A.Elements['c'],Data.FindPath('[0]c'));
+  AssertSame('[0].a on array returns element a of item 0',A.Elements['a'],Data.FindPath('[0].a'));
+  AssertSame('[0].b on array returns element b of item 0',A.Elements['b'],Data.FindPath('[0].b'));
+  AssertSame('[0].c on array returns element c of item 0',A.Elements['c'],Data.FindPath('[0].c'));
+end;
+
+procedure TTestJSONPath.TestObjectEmpty;
+begin
+  Data:=TJSONObject.Create(['a',1,'b',2,'c',3]);
+  AssertSame('Empty on object returns object',Data,Data.FindPath(''));
+end;
+
+procedure TTestJSONPath.TestObjectDots;
+begin
+  Data:=TJSONObject.Create(['a',1,'b',2,'c',3]);
+  AssertSame('Dot on object returns object',Data,Data.FindPath('.'));
+  AssertSame('2 Dots on object returns object',Data,Data.FindPath('..'));
+  AssertSame('3 Dots on object returns object',Data,Data.FindPath('...'));
+end;
+
+procedure TTestJSONPath.TestObjectExisting;
+begin
+  Data:=TJSONObject.Create(['a',1,'b',2,'c',3]);
+  AssertSame('a on object returns element a',TJSONObject(Data).Elements['a'],Data.FindPath('a'));
+  AssertSame('.a on object returns element a',TJSONObject(Data).Elements['a'],Data.FindPath('.a'));
+  AssertSame('..a on object returns element a',TJSONObject(Data).Elements['a'],Data.FindPath('..a'));
+end;
+
+procedure TTestJSONPath.TestObjectNonExisting;
+begin
+  Data:=TJSONObject.Create(['a',1,'b',2,'c',3]);
+  AssertNull('d on object returns nil',Data.FindPath('d'));
+end;
+
+procedure TTestJSONPath.TestObjectTrailingDot;
+begin
+  Data:=TJSONObject.Create(['a',1,'b',2,'c',3]);
+  AssertNull('a. on object returns nil',Data.FindPath('a.'));
+end;
+
+procedure TTestJSONPath.TestObjectRecursiveArray;
+
+Var
+  A : TJSONArray;
+
+begin
+  A:=TJSONArray.Create([1,2,3]);
+  Data:=TJSONObject.Create(['a',A,'b',2,'c',3]);
+  AssertSame('a[0] returns item 0 of array a',A.Items[0],Data.FindPath('a[0]'));
+end;
+
+procedure TTestJSONPath.TestObjectRecursiveObject;
+Var
+  O : TJSONObject;
+  D : TJSONData;
+begin
+  D :=TJSONIntegerNumber.Create(1);
+  O:=TJSONObject.Create(['b',D]);
+  Data:=TJSONObject.Create(['a',O]);
+  AssertSame('a.b returns correct data ',D,Data.FindPath('a.b'));
+  AssertSame('a..b returns correct data ',D,Data.FindPath('a..b'));
+end;
+
+procedure TTestJSONPath.TestDeepRecursive;
+Var
+  O : TJSONObject;
+  A : TJSONArray;
+  D : TJSONData;
+begin
+  D :=TJSONIntegerNumber.Create(1);
+  A:=TJSONArray.Create([0,'string',TJSONObject.Create(['b',D])]);
+  Data:=TJSONObject.Create(['a',TJSONObject.Create(['c',A])]);
+  AssertSame('a.c[2].b returns correct data ',D,Data.FindPath('a.c[2].b'));
+  AssertSame('a.c[2]b returns correct data ',D,Data.FindPath('a.c[2]b'));
+  AssertNull('a.c[2]d returns nil ',Data.FindPath('a.c[2]d'));
+end;
+
 { TTestJSON }
 
 procedure TTestJSON.TestItemCount(J: TJSONData; Expected: Integer);
@@ -2641,5 +2931,6 @@ initialization
   RegisterTest(TTestString);
   RegisterTest(TTestArray);
   RegisterTest(TTestObject);
+  RegisterTest(TTestJSONPath);
 end.