unit PM.Router; { URL dispatcher. Mirrors the switch(true) pattern of api.php. Each handler unit registers its routes here. The Router itself owns no state. } interface uses System.SysUtils, System.Classes, System.Generics.Collections, System.RegularExpressions, IdCustomHTTPServer; type TRouteParams = TArray; TRouteHandler = reference to procedure( ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo; const AParams: TRouteParams); TRoute = record Method: string; Pattern: string; // regex; ^ and $ added automatically Regex: TRegEx; Handler: TRouteHandler; end; TPMRouter = class private FRoutes: TList; public constructor Create; destructor Destroy; override; procedure Register(const AMethod, APattern: string; const AHandler: TRouteHandler); function DispatchRequest(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo): Boolean; end; var Router: TPMRouter; implementation constructor TPMRouter.Create; begin inherited; FRoutes := TList.Create; end; destructor TPMRouter.Destroy; begin FRoutes.Free; inherited; end; procedure TPMRouter.Register(const AMethod, APattern: string; const AHandler: TRouteHandler); var R: TRoute; begin R.Method := UpperCase(AMethod); R.Pattern := APattern; R.Regex := TRegEx.Create('^' + APattern + '$'); R.Handler := AHandler; FRoutes.Add(R); end; function TPMRouter.DispatchRequest(ARequest: TIdHTTPRequestInfo; AResponse: TIdHTTPResponseInfo): Boolean; var LRoute: TRoute; LMatch: TMatch; LParams: TRouteParams; I: Integer; LMethod, LPath: string; begin Result := False; LMethod := UpperCase(ARequest.Command); LPath := ARequest.Document; for LRoute in FRoutes do begin if LRoute.Method <> LMethod then Continue; LMatch := LRoute.Regex.Match(LPath); if LMatch.Success then begin SetLength(LParams, LMatch.Groups.Count - 1); for I := 1 to LMatch.Groups.Count - 1 do LParams[I - 1] := LMatch.Groups[I].Value; LRoute.Handler(ARequest, AResponse, LParams); Exit(True); end; end; end; initialization Router := TPMRouter.Create; finalization Router.Free; end.