--- Merging r18964 into '.':

U    packages/fcl-json/src/fpjson.pp
--- Merging r18965 into '.':
U    packages/fcl-json/tests/testjsondata.pp
U    packages/fcl-json/tests/testjson.pp
U    packages/fcl-json/tests/testjson.lpi
G    packages/fcl-json/src/fpjson.pp
--- Merging r19002 into '.':
U    packages/fcl-web/src/jsonrpc/fpextdirect.pp
--- Merging r19004 into '.':
U    packages/fcl-web/src/jsonrpc/fpjsonrpc.pp

# revisions: 18964,18965,19002,19004
------------------------------------------------------------------------
r18964 | michael | 2011-09-04 12:21:23 +0200 (Sun, 04 Sep 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-json/src/fpjson.pp

* Patch from Luiz Americo to implement Insert/Move/Exchange in TJSONArray (ID 20145)
------------------------------------------------------------------------
------------------------------------------------------------------------
r18965 | michael | 2011-09-04 12:41:09 +0200 (Sun, 04 Sep 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-json/src/fpjson.pp
   M /trunk/packages/fcl-json/tests/testjson.lpi
   M /trunk/packages/fcl-json/tests/testjson.pp
   M /trunk/packages/fcl-json/tests/testjsondata.pp

* Added tests for new methods, added insert (null)
------------------------------------------------------------------------
------------------------------------------------------------------------
r19002 | michael | 2011-09-07 12:42:07 +0200 (Wed, 07 Sep 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/jsonrpc/fpextdirect.pp

* Move conversion of handler(def) to JSON Object to separatr, virtual methods
------------------------------------------------------------------------
------------------------------------------------------------------------
r19004 | michael | 2011-09-07 13:33:37 +0200 (Wed, 07 Sep 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/jsonrpc/fpjsonrpc.pp

* Register paramdefs in JSONRPC handler manager
------------------------------------------------------------------------

git-svn-id: branches/fixes_2_6@19142 -

packages/fcl-json/src/fpjson.pp

@@ -313,6 +313,17 @@ Type
     function Add(AnArray : TJSONArray): Integer;
     function Add(AnObject: TJSONObject): Integer;
     Procedure Delete(Index : Integer);
+    procedure Exchange(Index1, Index2: Integer);
+    procedure Insert(Index: Integer);
+    procedure Insert(Index: Integer; Item : TJSONData);
+    procedure Insert(Index: Integer; I : Integer);
+    procedure Insert(Index: Integer; I : Int64);
+    procedure Insert(Index: Integer; const S : String);
+    procedure Insert(Index: Integer; F : TJSONFloat);
+    procedure Insert(Index: Integer; B : Boolean);
+    procedure Insert(Index: Integer; AnArray : TJSONArray);
+    procedure Insert(Index: Integer; AnObject: TJSONObject);
+    procedure Move(CurIndex, NewIndex: Integer);
     Procedure Remove(Item : TJSONData);
     // Easy Access Properties.
     property Items;default;
@@ -1526,6 +1537,65 @@ begin
   FList.Delete(Index);
 end;
 
+procedure TJSONArray.Exchange(Index1, Index2: Integer);
+begin
+  FList.Exchange(Index1, Index2);
+end;
+
+procedure TJSONArray.Insert(Index: Integer);
+begin
+  Insert(Index,TJSONNull.Create);
+end;
+
+procedure TJSONArray.Insert(Index: Integer; Item: TJSONData);
+begin
+  FList.Insert(Index, Item);
+end;
+
+procedure TJSONArray.Insert(Index: Integer; I: Integer);
+begin
+  FList.Insert(Index, TJSONIntegerNumber.Create(I));
+end;
+
+procedure TJSONArray.Insert(Index: Integer; I: Int64);
+begin
+  FList.Insert(Index, TJSONInt64Number.Create(I));
+end;
+
+procedure TJSONArray.Insert(Index: Integer; const S: String);
+begin
+  FList.Insert(Index, TJSONString.Create(S));
+end;
+
+procedure TJSONArray.Insert(Index: Integer; F: TJSONFloat);
+begin
+  FList.Insert(Index, TJSONFloatNumber.Create(F));
+end;
+
+procedure TJSONArray.Insert(Index: Integer; B: Boolean);
+begin
+  FList.Insert(Index, TJSONBoolean.Create(B));
+end;
+
+procedure TJSONArray.Insert(Index: Integer; AnArray: TJSONArray);
+begin
+  if (IndexOf(AnArray)<>-1) then
+    raise EJSON.Create(SErrCannotAddArrayTwice);
+  FList.Insert(Index, AnArray);
+end;
+
+procedure TJSONArray.Insert(Index: Integer; AnObject: TJSONObject);
+begin
+  if (IndexOf(AnObject)<>-1) then
+    raise EJSON.Create(SErrCannotAddObjectTwice);
+  FList.Insert(Index, AnObject);
+end;
+
+procedure TJSONArray.Move(CurIndex, NewIndex: Integer);
+begin
+  FList.Move(CurIndex, NewIndex);
+end;
+
 procedure TJSONArray.Remove(Item: TJSONData);
 begin
   FList.Remove(Item);
@@ -1807,7 +1877,6 @@ function TJSONObject.Clone: TJSONData;
 Var
   O : TJSONObject;
   I: Integer;
-  N : TJSONStringType;
 
 begin
   O:=TJSONObject.Create;

packages/fcl-json/tests/testjson.lpi

@@ -71,7 +71,7 @@
     </Units>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="9"/>
+    <Version Value="10"/>
     <SearchPaths>
       <OtherUnitFiles Value="../src"/>
     </SearchPaths>

packages/fcl-json/tests/testjson.pp

@@ -18,7 +18,7 @@ program testjson;
 
 uses
   Classes, consoletestrunner, testjsondata, testjsonparser,
-  fpcunitconsolerunner, testjsonrtti, fpjsonrtti;
+  fpcunitconsolerunner; //, testjsonrtti, fpjsonrtti;
 type
   { TLazTestRunner }
    TMyTestRunner = class(TTestRunner)

packages/fcl-json/tests/testjsondata.pp

@@ -130,6 +130,7 @@ type
   TTestArray = class(TTestJSON)
   private
     procedure TestAddBoolean(B : Boolean);
+    procedure TestInsertBoolean(B : Boolean);
   published
     Procedure TestCreate;
     Procedure TestCreateString;
@@ -153,6 +154,17 @@ type
     procedure TestAddNull;
     procedure TestAddObject;
     procedure TestAddArray;
+    procedure TestInsertInteger;
+    procedure TestInsertInt64;
+    procedure TestInsertFloat;
+    procedure TestInsertBooleanTrue;
+    procedure TestInsertBooleanFalse;
+    procedure TestInsertString;
+    procedure TestInsertNull;
+    procedure TestInsertObject;
+    procedure TestInsertArray;
+    procedure TestMove;
+    procedure TestExchange;
     procedure TestDelete;
     procedure TestRemove;
     Procedure TestClone;
@@ -1333,6 +1345,30 @@ begin
 
 end;
 
+procedure TTestArray.TestInsertBoolean(B: Boolean);
+Var
+  J : TJSONArray;
+
+begin
+  B:=True;
+  J:=TJSonArray.Create;
+  try
+    J.Add(Not B);
+    J.Insert(0,B);
+    TestItemCount(J,2);
+    TestJSONType(J[0],jtBoolean);
+    AssertEquals('J[0] is TJSONBoolean',TJSONBoolean,J[0].ClassType);
+    TestAsBoolean(J[0],B);
+    AssertEquals('J.Booleans[0]='+BoolToStr(B)+'"',B,J.Booleans[0]);
+    If B then
+      TestJSON(J,'[true, false]')
+    else
+      TestJSON(J,'[false, true]');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
 procedure TTestArray.TestAddBooleanTrue;
 
 begin
@@ -1416,6 +1452,237 @@ begin
   end;
 end;
 
+procedure TTestArray.TestInsertInteger;
+Var
+  J : TJSONArray;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J.Add(Integer(1));
+    J.Insert(0,Integer(0));
+    TestItemCount(J,2);
+    TestJSONType(J[0],jtNumber);
+    AssertEquals('J[0] is TJSONIntegerNumber',J[0].ClassType,TJSONIntegerNumber);
+    AssertEquals('j.Types[0]=jtNumber',ord(J.Types[0]),Ord(jtNumber));
+    AssertEquals('J.Integers[0]=0',0,J.integers[0]);
+    TestAsInteger(J[0],0);
+    TestAsInt64(J[0],0);
+    TestJSON(J,'[0, 1]');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestInsertInt64;
+Var
+  J : TJSONArray;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J.Add(Int64(1));
+    J.Insert(0,Int64(0));
+    TestItemCount(J,2);
+    TestJSONType(J[0],jtNumber);
+    AssertEquals('J[0] is TJSONInt64Number',J[0].ClassType,TJSONInt64Number);
+    AssertEquals('j.Types[0]=jtNumber',ord(J.Types[0]),Ord(jtNumber));
+    AssertEquals('J.Int64s[0]=0',0,J.Int64s[0]);
+    TestAsInteger(J[0],0);
+    TestAsInt64(J[0],0);
+    TestJSON(J,'[0, 1]');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestInsertFloat;
+Var
+  J : TJSONArray;
+  S,S2 : String;
+  F : TJSONFloat;
+begin
+  F:=1.2;
+  J:=TJSonArray.Create;
+  try
+    J.Add(2.3);
+    J.Insert(0,F);
+    TestItemCount(J,2);
+    TestJSONType(J[0],jtNumber);
+    AssertEquals('J[0] is TJSONFloatNumber',TJSONfloatNumber,J[0].ClassType);
+    AssertEquals('j.Types[0]=jtNumber',Ord(jtNumber),ord(J.Types[0]));
+    AssertEquals('J.Floats[0]='+FloatToStr(F),F,J.Floats[0]);
+    TestAsFloat(J[0],F);
+    Str(F,S);
+    F:=2.3;
+    Str(F,S2);
+    TestJSON(J,'['+S+', '+S2+']');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestInsertBooleanTrue;
+begin
+  TestInsertBoolean(True);
+end;
+
+procedure TTestArray.TestInsertBooleanFalse;
+begin
+  TestInsertBoolean(False);
+end;
+
+procedure TTestArray.TestInsertString;
+
+Var
+  J : TJSONArray;
+  S : String;
+  F : TJSONFloat;
+
+begin
+  S:='A string';
+  J:=TJSonArray.Create;
+  try
+    J.Add('Another string');
+    J.Insert(0,S);
+    TestItemCount(J,2);
+    TestJSONType(J[0],jtString);
+    AssertEquals('J[0] is TJSONString',TJSONString,J[0].ClassType);
+    TestAsString(J[0],S);
+    AssertEquals('J.Strings[0]="'+S+'"',S,J.Strings[0]);
+    TestJSON(J,'["'+StringToJSONString(S)+'", "Another string"]');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestInsertNull;
+Var
+  J : TJSONArray;
+  S : String;
+  F : TJSONFloat;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J.Add(123);
+    J.Insert(0);
+    TestItemCount(J,2);
+    TestJSONType(J[0],jtNull);
+    AssertEquals('J[0] is TJSONNull',TJSONNull,J[0].ClassType);
+    AssertEquals('J.Nulls[0]=True',True,J.Nulls[0]);
+    TestIsNull(J[0],true);
+    TestJSON(J,'[null, 123]');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestInsertObject;
+Const
+  A = 'a';
+  B = 'b';
+
+Var
+  J : TJSONArray;
+  J2 : TJSONObject;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J.Add('A string');
+    J2:=TJSonObject.Create;
+    J2.Add(A,0);
+    J2.Add(B,1);
+    J.Insert(0,J2);
+    TestItemCount(J,2);
+    TestJSONType(J[0],jtObject);
+    AssertEquals('J[0] is TJSONObject',TJSONObject,J[0].ClassType);
+    AssertEquals('J.Objects[0] is TJSONObject',TJSONObject,J.Objects[0].ClassType);
+    TestAsInteger(J.Objects[0][A],0);
+    TestAsInteger(J.Objects[0][B],1);
+    TestAsInt64(J.Objects[0][A],0);
+    TestAsInt64(J.Objects[0][B],1);
+    TestJSON(J,'[{ "a" : 0, "b" : 1 }, "A string"]');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestInsertArray;
+Var
+  J,J2 : TJSONArray;
+
+begin
+  J:=TJSonArray.Create;
+  try
+    J.Add('Something nice');
+    J2:=TJSonArray.Create;
+    J2.Add(0);
+    J2.Add(1);
+    J.Insert(0,J2);
+    TestItemCount(J,2);
+    TestJSONType(J[0],jtArray);
+    AssertEquals('J[0] is TJSONArray',TJSONArray,J[0].ClassType);
+    AssertEquals('J.Arrays[0] is TJSONArray',TJSONArray,J.Arrays[0].ClassType);
+    TestAsInteger(J.Arrays[0][0],0);
+    TestAsInteger(J.Arrays[0][1],1);
+    TestAsInt64(J.Arrays[0][0],0);
+    TestAsInt64(J.Arrays[0][1],1);
+    TestJSON(J,'[[0, 1], "Something nice"]');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestMove;
+Var
+  J : TJSONArray;
+  S : String;
+  F : TJSONFloat;
+
+begin
+  S:='A string';
+  J:=TJSonArray.Create;
+  try
+    J.Add('First string');
+    J.Add('Second string');
+    J.Add('Third string');
+    J.Move(2,1);
+    TestItemCount(J,3);
+    AssertEquals('J[2] is TJSONString',TJSONString,J[1].ClassType);
+    AssertEquals('J[1] is TJSONString',TJSONString,J[2].ClassType);
+    TestAsString(J[1],'Third string');
+    TestAsString(J[2],'Second string');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
+procedure TTestArray.TestExchange;
+Var
+  J : TJSONArray;
+  S : String;
+  F : TJSONFloat;
+
+begin
+  S:='A string';
+  J:=TJSonArray.Create;
+  try
+    J.Add('First string');
+    J.Add('Second string');
+    J.Add('Third string');
+    J.Exchange(2,0);
+    TestItemCount(J,3);
+    AssertEquals('J[2] is TJSONString',TJSONString,J[0].ClassType);
+    AssertEquals('J[1] is TJSONString',TJSONString,J[2].ClassType);
+    TestAsString(J[0],'Third string');
+    TestAsString(J[2],'First string');
+  finally
+    FreeAndNil(J);
+  end;
+end;
+
 procedure TTestArray.TestAddObject;
 
 Const

packages/fcl-web/src/jsonrpc/fpextdirect.pp

@@ -36,6 +36,9 @@ Type
     Function FindHandler(Const AClassName,AMethodName : TJSONStringType;AContext : TJSONRPCCallContext; Out FreeObject : TComponent) : TCustomJSONRPCHandler; override;
     // Add type field
     function CreateJSON2Error(Const AMessage : String; Const ACode : Integer; ID : TJSONData = Nil; idname : TJSONStringType = 'id' ) : TJSONObject; override;
+    // Create API method description
+    Function HandlerToAPIMethod (H: TCustomJSONRPCHandler): TJSONObject; virtual;
+    Function HandlerDefToAPIMethod (H: TJSONRPCHandlerDef): TJSONObject; virtual;
     // Create API
     Function DoAPI : TJSONData; virtual;
     // Namespace for API description. Must be set. Default 'FPWeb'
@@ -209,6 +212,17 @@ begin
   TJSONObject(Result).Add('type','rpc');
 end;
 
+function TCustomExtDirectDispatcher.HandlerToAPIMethod(H: TCustomJSONRPCHandler): TJSONObject;
+begin
+  Result:=TJSONObject.Create(['name',H.Name,'len',H.ParamDefs.Count])
+end;
+
+function TCustomExtDirectDispatcher.HandlerDefToAPIMethod(H: TJSONRPCHandlerDef
+  ): TJSONObject;
+begin
+  Result:=TJSONObject.Create(['name',H.HandlerMethodName,'len',H.ArgumentCount])
+end;
+
 function TCustomExtDirectDispatcher.DoAPI: TJSONData;
 
 Var
@@ -242,7 +256,7 @@ begin
             A.Add(N,R);
             end;
           H:=Owner.Components[i] as TCustomJSONRPCHandler;
-          R.Add(TJSONObject.Create(['name',H.Name,'len',H.ParamDefs.Count]));
+          R.Add(HandlerToAPIMethod(H));
           end;
       end;
     If (jdoSearchRegistry in Options) then
@@ -266,7 +280,7 @@ begin
           else
             R:=A.Items[J] as TJSONArray;
           end;
-        R.Add(TJSONObject.Create(['name',HD.HandlerMethodName,'len',HD.ArgumentCount]));
+        R.Add(HandlerDefToAPIMethod(HD));
         end;
       end;
     Result:=D;

packages/fcl-web/src/jsonrpc/fpjsonrpc.pp

@@ -201,24 +201,30 @@ Type
     FAfterCreate: TJSONRPCHandlerEvent;
     FArgumentCount: Integer;
     FBeforeCreate: TBeforeCreateJSONRPCHandlerEvent;
+    FParamDefs: TJSONParamDefs;
     FPClass: TCustomJSONRPCHandlerClass;
     FDataModuleClass : TDataModuleClass;
     FHandlerMethodName: TJSONStringType;
     FHandlerClassName: TJSONStringType;
     procedure CheckNames(const AClassName, AMethodName: TJSONStringType);
+    function GetParamDefs: TJSONParamDefs;
     procedure SetFPClass(const AValue: TCustomJSONRPCHandlerClass);
     procedure SetHandlerClassName(const AValue: TJSONStringType);
     procedure SetHandlerMethodName(const AValue: TJSONStringType);
+    procedure SetParamDefs(AValue: TJSONParamDefs);
   protected
     Function CreateInstance(AOwner : TComponent; Out AContainer : TComponent) : TCustomJSONRPCHandler; virtual;
     Property DataModuleClass : TDataModuleClass Read FDataModuleClass;
   Public
+    Destructor Destroy; override;
+    Function HaveParamDefs : Boolean;
     Property HandlerClassName : TJSONStringType Read FHandlerClassName Write SetHandlerClassName;
     Property HandlerMethodName : TJSONStringType Read FHandlerMethodName Write SetHandlerMethodName;
     Property HandlerClass : TCustomJSONRPCHandlerClass Read FPClass Write SetFPClass;
     Property BeforeCreate : TBeforeCreateJSONRPCHandlerEvent Read FBeforeCreate Write FBeforeCreate;
     Property AfterCreate : TJSONRPCHandlerEvent Read FAfterCreate Write FAfterCreate;
     Property ArgumentCount : Integer Read FArgumentCount Write FArgumentCount;
+    Property ParamDefs : TJSONParamDefs Read GetParamDefs Write SetParamDefs;
   end;
 
   { TJSONRPCHandlerDefs }
@@ -976,7 +982,8 @@ begin
   FPClass:=AValue;
 end;
 
-procedure TJSONRPCHandlerDef.CheckNames(Const AClassName,AMethodName : TJSONStringType);
+procedure TJSONRPCHandlerDef.CheckNames(const AClassName,
+  AMethodName: TJSONStringType);
 
 Var
   I : Integer;
@@ -993,6 +1000,13 @@ begin
     end;
 end;
 
+function TJSONRPCHandlerDef.GetParamDefs: TJSONParamDefs;
+begin
+  IF (FParamDefs=Nil) then
+    FParamDefs:=TJSONParamDefs.Create(TJSONParamDef);
+  Result:=FParamDefs;
+end;
+
 procedure TJSONRPCHandlerDef.SetHandlerClassName(const AValue: TJSONStringType);
 begin
   if FHandlerClassName=AValue then exit;
@@ -1008,6 +1022,17 @@ begin
   FHandlerMethodName:=AValue;
 end;
 
+procedure TJSONRPCHandlerDef.SetParamDefs(AValue: TJSONParamDefs);
+begin
+  if FParamDefs=AValue then Exit;
+  IF (FParamDefs=Nil) then
+    FParamDefs:=TJSONParamDefs.Create(TJSONParamDef);
+  if (AValue<>Nil) then
+    FParamDefs.Assign(AValue)
+  else
+    FreeAndNil(FParamDefs);
+end;
+
 function TJSONRPCHandlerDef.CreateInstance(AOwner: TComponent; out
   AContainer: TComponent): TCustomJSONRPCHandler;
 
@@ -1048,6 +1073,17 @@ begin
     FAfterCreate(Self,Result);
 end;
 
+destructor TJSONRPCHandlerDef.Destroy;
+begin
+  FreeAndNil(FParamDefs);
+  inherited Destroy;
+end;
+
+function TJSONRPCHandlerDef.HaveParamDefs: Boolean;
+begin
+  Result:=Assigned(FParamDefs);
+end;
+
 { TJSONRPCHandlerDefs }
 
 function TJSONRPCHandlerDefs.GetH(Index: Integer): TJSONRPCHandlerDef;
@@ -1158,6 +1194,7 @@ begin
              JSONRPCError(SErrDuplicateRPCCLassMethodHandler,[CN,C.Name]);
           D:=AddHandlerDef(CN,C.Name);
           D.ArgumentCount:=TCustomJSONRPCHandler(C).ParamDefs.Count;
+          D.ParamDefs:=TCustomJSONRPCHandler(C).ParamDefs;
           {$ifdef wmdebug}SendDebug('Registering provider '+C.Name);{$endif}
           D.FDataModuleClass:=TDataModuleClass(DM.ClassType);
           end;