* Cleaner design refactoring: Separate out ExtDirect support in non-http part and http part

git-svn-id: trunk@28194 -

.gitattributes

@@ -3085,6 +3085,7 @@ packages/fcl-web/src/base/websession.pp svneol=native#text/plain
 packages/fcl-web/src/base/webutil.pp svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/Makefile svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/Makefile.fpc svneol=native#text/plain
+packages/fcl-web/src/jsonrpc/fpdispextdirect.pp svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/fpextdirect.pp svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/fpjsonrpc.pp svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/readme.txt svneol=native#text/plain

packages/fcl-web/fpmake.pp

@@ -203,12 +203,19 @@ begin
       begin
       AddUnit('fpjsonrpc');
       end;
-    T:=P.Targets.AddUnit('fpextdirect.pp');
+    T:=P.Targets.AddUnit('fpdispextdirect.pp');
     T.ResourceStrings:=true;
     With T.Dependencies do
       begin
       AddUnit('fpjsonrpc');
+      end;
+    T:=P.Targets.AddUnit('fpextdirect.pp');
+    T.ResourceStrings:=true;
+    With T.Dependencies do
+      begin
+      AddUnit('fpdispextdirect');
       AddUnit('webjsonrpc');
+      AddUnit('httpdefs');
       end;
 {$ifndef ALLPACKAGES}
     Run;

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

@@ -0,0 +1,282 @@
+unit fpdispextdirect;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpjson, fpjsonrpc ;
+
+Const
+  DefaultExtDirectOptions = DefaultDispatchOptions + [jdoRequireClass];
+
+Type
+  { TCustomExtDirectDispatcher }
+
+  TCustomExtDirectDispatcher = Class(TCustomJSONRPCDispatcher)
+  private
+    FAPIType: String;
+    FNameSpace: String;
+    FURL: String;
+    function GetNameSpace: String;
+    function isNameSpaceStored: boolean;
+  Protected
+    // Use this to initialize the container when the handler was created.
+    Procedure InitContainer(H: TCustomJSONRPCHandler;  AContext: TJSONRPCCallContext; AContainer: TComponent); virtual;
+    // Format the result
+    function FormatResult(const AClassName, AMethodName: TJSONStringType; const Params, ID, Return: TJSONData): TJSONData; override;
+    // Called during API creation. Can be used to restrict list of reported handlers.
+    Function PublishHandler(H: TCustomJSONRPCHandler): Boolean; virtual;
+    // Called during API creation. Can be used to restrict list of reported handlers.
+    Function PublishHandlerDef(HD: TJSONRPCHandlerDef): Boolean; virtual;
+    // 'tid'
+    Class Function TransactionProperty : String; override;
+    // 'method'
+    Class Function MethodProperty : String; override;
+    // 'action'
+    Class Function ClassNameProperty : String; override;
+    // 'data'
+    Class Function ParamsProperty : String; override;
+    // Add session support
+    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'
+    Property NameSpace : String Read GetNameSpace Write FNameSpace Stored isNameSpaceStored;
+    // URL property for router. Must be set
+    Property URL : String Read FURL Write FURL;
+    // "type". By default: 'remoting'
+    Property APIType : String Read FAPIType Write FAPIType;
+  Public
+    // Override to set additional opions.
+    Constructor Create(AOwner : TComponent); override;
+    // Return API description object
+    Function API: TJSONData;
+    // Return API Description including namespace, as a string
+    Function APIAsString(Formatted : Boolean = False) : String; virtual;
+  end;
+
+  { TExtDirectDispatcher }
+
+  TExtDirectDispatcher = Class(TCustomExtDirectDispatcher)
+  Published
+    Property NameSpace;
+    Property URL;
+    Property APIType;
+    Property OnStartBatch;
+    Property OnDispatchRequest;
+    Property OnFindHandler;
+    Property OnEndBatch;
+    Property Options;
+  end;
+
+
+implementation
+{ TCustomExtDirectDispatcher }
+Const
+  DefaultNameSpace = 'FPWeb';
+
+function TCustomExtDirectDispatcher.GetNameSpace: String;
+begin
+  Result:=FNameSpace;
+  If (Result='') then
+    Result:=DefaultNameSpace
+end;
+
+function TCustomExtDirectDispatcher.isNameSpaceStored: boolean;
+begin
+  Result:=NameSpace<>DefaultNameSpace;
+end;
+
+function TCustomExtDirectDispatcher.FormatResult(const AClassName,
+  AMethodName: TJSONStringType; const Params, ID, Return: TJSONData): TJSONData;
+
+begin
+  Result:=Inherited FormatResult(AClassName,AMethodName,Params,ID,Return);
+  TJSONObject(Result).Add('type','rpc');
+  TJSONObject(Result).Add('action',AClassName);
+  TJSONObject(Result).Add('method',AMethodName);
+end;
+
+Class Function TCustomExtDirectDispatcher.TransactionProperty: String;
+begin
+  Result:='tid';
+end;
+
+Class Function TCustomExtDirectDispatcher.MethodProperty: String;
+begin
+  Result:='method';
+end;
+
+Class Function TCustomExtDirectDispatcher.ClassNameProperty: String;
+begin
+  Result:='action';
+end;
+
+Class Function TCustomExtDirectDispatcher.ParamsProperty: String;
+begin
+  Result:='data';
+end;
+
+Procedure TCustomExtDirectDispatcher.InitContainer(H : TCustomJSONRPCHandler; AContext : TJSONRPCCallContext; AContainer : TComponent);
+
+begin
+  // Do nothing, must be overridden in descendents
+end;
+
+Function TCustomExtDirectDispatcher.FindHandler(Const AClassName,
+  AMethodName: TJSONStringType; AContext: TJSONRPCCallContext; Out
+  FreeObject: TComponent): TCustomJSONRPCHandler;
+begin
+  {$ifdef extdebug}SendDebugFmt('Searching for %s %s',[AClassName,AMethodName]);{$endif}
+  Result:=inherited FindHandler(AClassName, AMethodName, AContext, FreeObject);
+  InitContainer(Result,AContext,FreeObject);
+  {$ifdef extdebug}SendDebugFmt('Done with searching for %s %s : %d',[AClassName,AMethodName,Ord(Assigned(Result))]);{$endif}
+end;
+
+function TCustomExtDirectDispatcher.CreateJSON2Error(Const AMessage: String;
+  Const ACode: Integer; ID: TJSONData; idname: TJSONStringType): TJSONObject;
+begin
+  Result:=inherited CreateJSON2Error(AMessage,ACode,ID,idname);
+  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.PublishHandler(H : TCustomJSONRPCHandler) : Boolean;
+
+begin
+  Result:=(H<>Nil); // Avoid warning
+end;
+
+Function TCustomExtDirectDispatcher.PublishHandlerDef(HD : TJSONRPCHandlerDef) : Boolean;
+
+begin
+  Result:=(HD<>Nil); // Avoid warning
+end;
+
+Function TCustomExtDirectDispatcher.DoAPI: TJSONData;
+
+Var
+  A,D : TJSONObject;
+  R : TJSONArray;
+  N : TJSONStringType;
+  H : TCustomJSONRPCHandler;
+  I,J : Integer;
+  M : TCustomJSONRPCHandlerManager;
+  HD : TJSONRPCHandlerDef;
+
+begin
+  {$ifdef extdebug}SendDebugFmt('Creating API entries',[]);{$endif}
+  D:=TJSONObject.Create;
+  try
+    D.Add('url',URL);
+    D.Add('type',APIType);
+    A:=TJSONObject.Create;
+    D.Add('actions',A);
+    R:=Nil;
+    N:='';
+    If (jdoSearchOwner in Options) and Assigned(Owner) then
+      begin
+      for I:=Owner.ComponentCount-1 downto 0 do
+        If Owner.Components[i] is TCustomJSONRPCHandler then
+          begin
+          H:=Owner.Components[i] as TCustomJSONRPCHandler;
+          if PublishHandler(H) then
+            begin
+            If (R=Nil) then
+              begin
+              N:=Owner.Name;
+              R:=TJSONArray.Create;
+              A.Add(N,R);
+              end;
+            R.Add(HandlerToAPIMethod(H));
+            end;
+          end;
+      end;
+    If (jdoSearchRegistry in Options) then
+      begin
+      M:=JSONRPCHandlerManager;
+      For I:=M.HandlerCount-1 downto 0 do
+        begin
+        HD:=M.HandlerDefs[i];
+        if PublishHandlerDef(HD) then
+          begin
+          If (R=Nil) or (CompareText(N,HD.HandlerClassName)<>0) then
+            begin
+            N:=HD.HandlerClassName;
+            J:=A.IndexOfName(N);
+            If (J=-1) then
+              begin
+              R:=TJSONArray.Create;
+              A.Add(N,R);
+              end
+            else
+              R:=A.Items[J] as TJSONArray;
+            end;
+          R.Add(HandlerDefToAPIMethod(HD));
+          end;
+        end;
+      end;
+    Result:=D;
+  except
+    FreeAndNil(D);
+    Raise;
+  end;
+end;
+
+Constructor TCustomExtDirectDispatcher.Create(AOwner: TComponent);
+
+Var
+  O : TJSONRPCDispatchOptions;
+
+begin
+  inherited Create(AOwner);
+  Options:=DefaultExtDirectOptions;
+  APIType:='remoting';
+end;
+
+Function TCustomExtDirectDispatcher.API: TJSONData;
+begin
+  Result:=DoAPI;
+end;
+
+Function TCustomExtDirectDispatcher.APIAsString(Formatted: Boolean = False): String;
+
+Var
+  A : TJSONData;
+
+begin
+  A:=API;
+  try
+    if Formatted then
+      Result:=NameSpace + ' = ' + A.FormatJSON + ';'
+    else
+      Result:=NameSpace + ' = ' + A.AsJSON + ';';
+  finally
+    A.Free;
+  end;
+end;
+
+
+{$ifdef extdebug}
+uses dbugintf;
+{$endif}
+
+end.
+

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

@@ -6,62 +6,22 @@ unit fpextdirect;
 interface
 
 uses
-  Classes, SysUtils, fpjson, fpjsonrpc, webjsonrpc, httpdefs;
+  Classes, SysUtils, fpjson, fpjsonrpc, fpdispextdirect, webjsonrpc, httpdefs;
 
 Const
-  DefaultExtDirectOptions = DefaultDispatchOptions + [jdoRequireClass];
+  // Redefinition for backwards compatibility
+  DefaultExtDirectOptions = fpdispextdirect.DefaultExtDirectOptions;
 
 Type
+  // Redefinition for backwards compatibility
+
   { TCustomExtDirectDispatcher }
 
-  TCustomExtDirectDispatcher = Class(TCustomJSONRPCDispatcher)
-  private
-    FAPIType: String;
-    FNameSpace: String;
-    FURL: String;
-    function GetNameSpace: String;
-    function isNameSpaceStored: boolean;
-  Protected
-    function FormatResult(const AClassName, AMethodName: TJSONStringType;
-      const Params, ID, Return: TJSONData): TJSONData; override;
-    // Called during API creation. Can be used to restrict list of reported handlers.
-    Function PublishHandler(H: TCustomJSONRPCHandler): Boolean; virtual;
-    // Called during API creation. Can be used to restrict list of reported handlers.
-    Function PublishHandlerDef(HD: TJSONRPCHandlerDef): Boolean; virtual;
-    // 'tid'
-    Class Function TransactionProperty : String; override;
-    // 'method'
-    Class Function MethodProperty : String; override;
-    // 'action'
-    Class Function ClassNameProperty : String; override;
-    // 'data'
-    Class Function ParamsProperty : String; override;
-    // Add session support
-    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'
-    Property NameSpace : String Read GetNameSpace Write FNameSpace Stored isNameSpaceStored;
-    // URL property for router. Must be set
-    Property URL : String Read FURL Write FURL;
-    // "type". By default: 'remoting'
-    Property APIType : String Read FAPIType Write FAPIType;
-  Public
-    // Override to set additional opions.
-    Constructor Create(AOwner : TComponent); override;
-    // Return API description object
-    Function API: TJSONData;
-    // Return API Description including namespace, as a string
-    Function APIAsString(Formatted : Boolean = False) : String; virtual;
+  TCustomExtDirectDispatcher = Class(fpdispextdirect.TCustomExtDirectDispatcher)
+    Procedure InitContainer(H: TCustomJSONRPCHandler;  AContext: TJSONRPCCallContext; AContainer: TComponent); override;
   end;
 
   { TExtDirectDispatcher }
-
   TExtDirectDispatcher = Class(TCustomExtDirectDispatcher)
   Published
     Property NameSpace;
@@ -153,197 +113,15 @@ Resourcestring
   SErrInvalidPath = 'Invalid path';
 
 { TCustomExtDirectDispatcher }
-Const
-  DefaultNameSpace = 'FPWeb';
-
-function TCustomExtDirectDispatcher.GetNameSpace: String;
-begin
-  Result:=FNameSpace;
-  If (Result='') then
-    Result:=DefaultNameSpace
-end;
-
-function TCustomExtDirectDispatcher.isNameSpaceStored: boolean;
-begin
-  Result:=NameSpace<>DefaultNameSpace;
-end;
-
-function TCustomExtDirectDispatcher.FormatResult(const AClassName,
-  AMethodName: TJSONStringType; const Params, ID, Return: TJSONData): TJSONData;
-
-begin
-  Result:=Inherited FormatResult(AClassName,AMethodName,Params,ID,Return);
-  TJSONObject(Result).Add('type','rpc');
-  TJSONObject(Result).Add('action',AClassName);
-  TJSONObject(Result).Add('method',AMethodName);
-end;
-
-Class Function TCustomExtDirectDispatcher.TransactionProperty: String;
-begin
-  Result:='tid';
-end;
-
-Class Function TCustomExtDirectDispatcher.MethodProperty: String;
-begin
-  Result:='method';
-end;
-
-Class Function TCustomExtDirectDispatcher.ClassNameProperty: String;
-begin
-  Result:='action';
-end;
-
-Class Function TCustomExtDirectDispatcher.ParamsProperty: String;
-begin
-  Result:='data';
-end;
-
-Function TCustomExtDirectDispatcher.FindHandler(Const AClassName,
-  AMethodName: TJSONStringType; AContext: TJSONRPCCallContext; Out
-  FreeObject: TComponent): TCustomJSONRPCHandler;
-begin
-  {$ifdef extdebug}SendDebugFmt('Searching for %s %s',[AClassName,AMethodName]);{$endif}
-  Result:=inherited FindHandler(AClassName, AMethodName, AContext, FreeObject);
-  If (AContext is TJSONRPCSessionContext) and (FreeObject is TCustomJSONRPCModule) then
-    TCustomJSONRPCModule(FreeObject).Session:=TJSONRPCSessionContext(AContext).Session;
-  {$ifdef extdebug}SendDebugFmt('Done with searching for %s %s : %d',[AClassName,AMethodName,Ord(Assigned(Result))]);{$endif}
-end;
-
-function TCustomExtDirectDispatcher.CreateJSON2Error(Const AMessage: String;
-  Const ACode: Integer; ID: TJSONData; idname: TJSONStringType): TJSONObject;
-begin
-  Result:=inherited CreateJSON2Error(AMessage,ACode,ID,idname);
-  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.PublishHandler(H : TCustomJSONRPCHandler) : Boolean;
-
-begin
-  Result:=(H<>Nil); // Avoid warning
-end;
-
-Function TCustomExtDirectDispatcher.PublishHandlerDef(HD : TJSONRPCHandlerDef) : Boolean;
-
-begin
-  Result:=(HD<>Nil); // Avoid warning
-end;
-
-Function TCustomExtDirectDispatcher.DoAPI: TJSONData;
-
-Var
-  A,D : TJSONObject;
-  R : TJSONArray;
-  N : TJSONStringType;
-  H : TCustomJSONRPCHandler;
-  I,J : Integer;
-  M : TCustomJSONRPCHandlerManager;
-  HD : TJSONRPCHandlerDef;
 
+Procedure TCustomExtDirectDispatcher.InitContainer(H: TCustomJSONRPCHandler;
+  AContext: TJSONRPCCallContext; AContainer: TComponent);
 begin
-  {$ifdef extdebug}SendDebugFmt('Creating API entries',[]);{$endif}
-  D:=TJSONObject.Create;
-  try
-    D.Add('url',URL);
-    D.Add('type',APIType);
-    A:=TJSONObject.Create;
-    D.Add('actions',A);
-    R:=Nil;
-    N:='';
-    If (jdoSearchOwner in Options) and Assigned(Owner) then
-      begin
-      for I:=Owner.ComponentCount-1 downto 0 do
-        If Owner.Components[i] is TCustomJSONRPCHandler then
-          begin
-          H:=Owner.Components[i] as TCustomJSONRPCHandler;
-          if PublishHandler(H) then
-            begin
-            If (R=Nil) then
-              begin
-              N:=Owner.Name;
-              R:=TJSONArray.Create;
-              A.Add(N,R);
-              end;
-            R.Add(HandlerToAPIMethod(H));
-            end;
-          end;
-      end;
-    If (jdoSearchRegistry in Options) then
-      begin
-      M:=JSONRPCHandlerManager;
-      For I:=M.HandlerCount-1 downto 0 do
-        begin
-        HD:=M.HandlerDefs[i];
-        if PublishHandlerDef(HD) then
-          begin
-          If (R=Nil) or (CompareText(N,HD.HandlerClassName)<>0) then
-            begin
-            N:=HD.HandlerClassName;
-            J:=A.IndexOfName(N);
-            If (J=-1) then
-              begin
-              R:=TJSONArray.Create;
-              A.Add(N,R);
-              end
-            else
-              R:=A.Items[J] as TJSONArray;
-            end;
-          R.Add(HandlerDefToAPIMethod(HD));
-          end;
-        end;
-      end;
-    Result:=D;
-  except
-    FreeAndNil(D);
-    Raise;
-  end;
-end;
-
-Constructor TCustomExtDirectDispatcher.Create(AOwner: TComponent);
-
-Var
-  O : TJSONRPCDispatchOptions;
-
-begin
-  inherited Create(AOwner);
-  Options:=DefaultExtDirectOptions;
-  APIType:='remoting';
-end;
-
-Function TCustomExtDirectDispatcher.API: TJSONData;
-begin
-  Result:=DoAPI;
+  inherited InitContainer(H, AContext, AContainer);
+  If (AContext is TJSONRPCSessionContext) and (AContainer is TCustomJSONRPCModule) then
+    TCustomJSONRPCModule(AContainer).Session:=TJSONRPCSessionContext(AContext).Session;
 end;
 
-Function TCustomExtDirectDispatcher.APIAsString(Formatted: Boolean = False): String;
-
-Var
-  A : TJSONData;
-
-begin
-  A:=API;
-  try
-    if Formatted then
-      Result:=NameSpace + ' = ' + A.FormatJSON + ';'
-    else
-      Result:=NameSpace + ' = ' + A.AsJSON + ';';
-  finally
-    A.Free;
-  end;
-end;
-
-
 { TCustomExtDirectContentProducer }
 
 function TCustomExtDirectContentProducer.GetIDProperty: String;