* Introduce route options to select case sensitivity or not. (default not case sensitive)

git-svn-id: trunk@38956 -

packages/fcl-web/src/base/httproute.pp

@@ -37,6 +37,8 @@ Type
   // Some common HTTP methods.
 
   TRouteMethod = (rmUnknown,rmAll,rmGet,rmPost,rmPut,rmDelete,rmOptions,rmHead, rmTrace);
+  TRouteOption = (roCaseSensitive,roEmptyMatchesAll);
+  TRouteOptions = Set of TRouteOption;
 
   { THTTPRoute }
 
@@ -51,11 +53,13 @@ Type
   Public
     Destructor Destroy; override;
     Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse);
-    Function Matches(Const APattern : String; AMethod : TRouteMethod) : Boolean;
+    Function Matches(Const APattern : String; AMethod : TRouteMethod; Options : TRouteOptions) : Boolean;
-    Function MatchPattern(Const Path : String; L : TStrings) : Boolean;
+    Function MatchPattern(Const Path : String; L : TStrings; Options : TRouteOptions) : Boolean;
     Function MatchMethod(Const AMethod : TRouteMethod) : Boolean;
   Published
+    // Default route is per method. This means you can register
     Property Default : Boolean Read FDefault Write FDefault;
+    // Depending on options, an empty URLPattern matches all, and acts as default.
     Property URLPattern : String Read FURLPattern Write SetURLPattern;
     Property Method : TRouteMethod Read FMethod Write FMethod;
   end;
@@ -154,6 +158,7 @@ Type
   private
     FAfterRequest: THTTPRouteRequestEvent;
     FBeforeRequest: THTTPRouteRequestEvent;
+    FRouteOptions: TRouteOptions;
     FRoutes : THTTPRouteList;
     function GetR(AIndex : Integer): THTTPRoute;
     Class Procedure DoneService;
@@ -219,6 +224,8 @@ Type
     Property BeforeRequest : THTTPRouteRequestEvent Read FBeforeRequest Write FBeforeRequest;
     // Called after the request is routed, if no exception was raised during or before the request.
     Property AfterRequest : THTTPRouteRequestEvent Read FAfterRequest Write FAfterRequest;
+    // Global options used when routing a request.
+    Property RouteOptions : TRouteOptions Read FRouteOptions Write FRouteOptions;
   end;
 
 Function RouteMethodToString (R : TRouteMethod)  : String;
@@ -318,7 +325,7 @@ begin
     R:=FRoutes[I];
     if R.Default then
       DI:=I;
-    if R.Matches(APattern,AMethod) then
+    if R.Matches(APattern,AMethod,FRouteOptions) then
       Raise EHTTPRoute.CreateFmt(EDuplicateRoute,[APattern,RouteMethodToString(AMethod)]);
     end;
   if isDefault and (DI<>-1) then
@@ -526,7 +533,7 @@ begin
   While (Result=Nil) and (I<FRoutes.Count) do
     begin
     Result:=FRoutes[i];
-    If Not Result.MatchPattern(APathInfo,Params) then
+    If Not Result.MatchPattern(APathInfo,Params,FRouteOptions) then
       Result:=Nil
     else if Not Result.MatchMethod(AMethod) then
       begin
@@ -536,6 +543,18 @@ begin
       end;
     Inc(I);
     end;
+  // Find default route.
+  if (Result=Nil) then
+    begin
+    I:=0;
+    While (Result=Nil) and (I<FRoutes.Count) do
+      begin
+      Result:=FRoutes[i];
+      if Not (Result.Default and Result.MatchMethod(AMethod)) then
+        Result:=Nil;
+      Inc(I);
+      end;
+    end;
 end;
 
 function THTTPRouter.GetHTTPRoute(const Path: String; AMethod: TRouteMethod; Params : TStrings): THTTPRoute;
@@ -605,7 +624,7 @@ Var
 
 begin
   V:=IncludeHTTPPathDelimiter(AValue);
-  if (V<>'/') and (V[1]='/') then
+  if (V<>'') and (V<>'/') and (V[1]='/') then
     Delete(V,1,1);
   if FURLPattern=V then Exit;
   FURLPattern:=V;
@@ -627,22 +646,24 @@ begin
   DoHandleRequest(ARequest,AResponse);
 end;
 
-function THTTPRoute.Matches(const APattern: String; AMethod: TRouteMethod
+function THTTPRoute.Matches(const APattern: String; AMethod: TRouteMethod; Options: TRouteOptions): Boolean;
-  ): Boolean;
 begin
-  Result:=(CompareText(URLPattern,APattern)=0)
+  Result:=((Method=rmAll) or (AMethod=Method));
-          and ((Method=rmAll) or (AMethod=Method))
+  if Result then
+    Result:=SameText(URLPattern,APattern) or ((URLPattern='') and (roEmptyMatchesAll in Options))
 end;
 
-Function THTTPRoute.MatchPattern(Const Path : String; L : TStrings) : Boolean;
+Function THTTPRoute.MatchPattern(Const Path : String; L : TStrings; Options: TRouteOptions) : Boolean;
 
+  // This is used only with special chars, so we do not check case sensitivity
   Function StartsWith(C : Char; S : String): Boolean; 
   
   begin
     Result:=(Length(S)>0) and (S[1]=C);
   end;
   
-  Function EndsWith(C : Char; S : String): Boolean; 
+  // This is used only with special chars, so we do not check case sensitivity
+  Function EndsWith(C : Char; S : String): Boolean;
   
   Var
   L : Integer;
@@ -651,6 +672,15 @@ Function THTTPRoute.MatchPattern(Const Path : String; L : TStrings) : Boolean;
     L:=Length(S);
     Result:=(L>0) and (S[L]=C);
   end;
+
+  Function SameString(A,B : String) : Boolean;
+
+  begin
+    if roCaseSensitive in Options then
+      Result:=(A=B)
+    else
+      Result:=SameText(A,B);
+  end;
   
 
   procedure ExtractNextPathLevel(var ALeft: string;
@@ -700,9 +730,9 @@ var
   VLeftPat, VRightPat, VLeftVal, VRightVal, VVal, VPat, VName: string;
 
 begin
-  Result:= False;
+  Result:=False;
   if (URLPattern='') then
-     Exit; // Maybe empty pattern should match any path?
+     Exit(roEmptyMatchesAll in Options);
   APathInfo:=Path;
   APattern:=URLPattern;
   Delete(APattern, Pos('?', APattern), MaxInt);
@@ -750,7 +780,7 @@ begin
             end
           else
             // *path/const
-            if not ((VPat='') and (VLeftPat='')) and Not SameText(VPat,VVal) then
+            if not ((VPat='') and (VLeftPat='')) and Not SameString(VPat,VVal) then
               Exit;
           // Check if we already done
           if (VLeftPat='') or (VLeftVal='') then
@@ -767,7 +797,7 @@ begin
         end
       else
         // const
-        if Not SameText(VPat,VVal) then
+        if Not SameString(VPat,VVal) then
           Exit;
     // Check if we already done
     if (VRightPat='') or (VRightVal='') then