* Correctly handle use in restmodule: use pathinfo to configure dispatcher

git-svn-id: trunk@42277 -

packages/fcl-web/src/restbridge/sqldbrestbridge.pp

@@ -322,6 +322,7 @@ Type
     procedure HandleMetadataRequest(aRequest : TRequest; aResponse : TResponse);
     procedure HandleConnRequest(aRequest : TRequest; aResponse : TResponse);
     procedure HandleRequest(aRequest : TRequest; aResponse : TResponse);
+    Procedure VerifyPathInfo(aRequest : TRequest);
     Function ExposeDatabase(Const aType,aHostName,aDatabaseName,aUserName,aPassword : String; aTables : Array of String; aMinFieldOpts : TRestFieldOptions = []) : TSQLDBRestConnection;
     Function ExposeDatabase(Const aType,aHostName,aDatabaseName,aUserName,aPassword : String; aTables : TStrings = nil; aMinFieldOpts : TRestFieldOptions = []) : TSQLDBRestConnection;
     Function ExposeConnection(aOwner : TComponent; Const aConnection : TSQLDBRestConnection; aTables : TStrings = nil; aMinFieldOpts : TRestFieldOptions = []) : TSQLDBRestSchema;
@@ -2002,6 +2003,42 @@ begin
   end;
 end;
 
+procedure TSQLDBRestDispatcher.VerifyPathInfo(aRequest: TRequest);
+Var
+  Full,Path : String;
+  BasePaths : TStringArray;
+  I : Integer;
+
+begin
+  // Check & discard basepath parts of the URL
+  Path:=aRequest.GetNextPathInfo;
+  Full:=BasePath;
+  BasePaths:=Full.Split('/',TStringSplitOptions.ExcludeEmpty);
+  I:=0;
+  While (I<Length(BasePaths)) and SameText(Path,BasePaths[i]) do
+    begin
+    inc(I);
+    Path:=aRequest.GetNextPathInfo;
+    end;
+  if (I<Length(BasePaths)) then
+    Raise ESQLDBRest.Create(400,'NOT FOUND');
+  // Path1 is now either connection or resource
+  if (rdoConnectionInURL in DispatchOptions) then
+    begin
+    // Both /metadata and /connection/metadata are possible
+    if not ((rdoExposeMetadata in DispatchOptions) and SameText(Path,Strings.getRestString(rpMetadataResourceName))) then
+      begin
+      aRequest.RouteParams['connection']:=Path;
+      Path:=aRequest.GetNextPathInfo;
+      end;
+    end;
+  aRequest.RouteParams['resource']:=Path;
+  // Next part is ID
+  Path:=aRequest.GetNextPathInfo;
+  if (Path<>'') then
+    aRequest.RouteParams['ID']:=Path;
+end;
+
 function TSQLDBRestDispatcher.ExposeDatabase(const aType, aHostName, aDatabaseName, aUserName, aPassword: String;
   aTables: array of String; aMinFieldOpts: TRestFieldOptions): TSQLDBRestConnection;
 

packages/fcl-web/src/restbridge/sqldbrestmodule.pp

@@ -17,6 +17,7 @@ Type
     procedure SetDispatcher(AValue: TSQLDBRestDispatcher);
   Protected
     Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+    procedure ConfigureDispatcherFromRequest(Disp: TSQLDBRestDispatcher; aRequest: TRequest); virtual;
     Function FindDispatcher : TSQLDBRestDispatcher; virtual;
   Public
     constructor Create(AOwner: TComponent); override;
@@ -28,7 +29,7 @@ Type
 
 implementation
 
-uses sqldbrestconst;
+uses sqldbrestschema, sqldbrestconst;
 
 { TSQLDBRestModule }
 
@@ -39,7 +40,10 @@ begin
     FDispatcher.RemoveFreeNotification(Self);
   FDispatcher:=AValue;
   if Assigned(Dispatcher) then
+    begin
+    FDispatcher.Active:=False;
     FDispatcher.FreeNotification(Self);
+    end;
 end;
 
 procedure TSQLDBRestModule.Notification(AComponent: TComponent; Operation: TOperation);
@@ -61,6 +65,12 @@ begin
   inherited Create(AOwner);
 end;
 
+procedure TSQLDBRestModule.ConfigureDispatcherFromRequest(Disp : TSQLDBRestDispatcher; aRequest : TRequest);
+
+begin
+  Disp.VerifyPathInfo(aRequest);
+end;
+
 procedure TSQLDBRestModule.HandleRequest(ARequest: TRequest; AResponse: TResponse);
 
 Var
@@ -69,7 +79,11 @@ Var
 begin
   Disp:=FindDispatcher;
   If assigned(Disp) then
+    begin
+    Disp.Active:=False;
+    ConfigureDispatcherFromRequest(Disp,aRequest);
     Disp.HandleRequest(aRequest,aResponse)
+    end
   else
     Raise EHTTP.Create(SErrNoRESTDispatcher);
 end;