Added support for web-modules to TCustomWebApplication

git-svn-id: trunk@12977 -

packages/fcl-web/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2009/03/15]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2009/03/29]
 #
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded
@@ -265,7 +265,7 @@ PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages $(FPCDIR)/packages/base $(F
 override PACKAGE_NAME=fcl-web
 override PACKAGE_VERSION=2.2.2
 ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache
+override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache  fastcgi custfcgi custweb
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
 override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache
@@ -325,7 +325,7 @@ ifeq ($(FULL_TARGET),i386-symbian)
 override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
-override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache
+override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache  fastcgi custfcgi custweb
 endif
 ifeq ($(FULL_TARGET),m68k-freebsd)
 override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache
@@ -349,7 +349,7 @@ ifeq ($(FULL_TARGET),m68k-embedded)
 override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
-override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache
+override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache  fastcgi custfcgi custweb
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
 override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache
@@ -370,7 +370,7 @@ ifeq ($(FULL_TARGET),powerpc-embedded)
 override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
-override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache
+override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache  fastcgi custfcgi custweb
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
 override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache
@@ -382,7 +382,7 @@ ifeq ($(FULL_TARGET),sparc-embedded)
 override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache
+override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache  fastcgi custfcgi custweb
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache
@@ -397,7 +397,7 @@ ifeq ($(FULL_TARGET),x86_64-embedded)
 override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache
 endif
 ifeq ($(FULL_TARGET),arm-linux)
-override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache
+override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache  fastcgi custfcgi custweb
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
 override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache
@@ -421,7 +421,7 @@ ifeq ($(FULL_TARGET),arm-symbian)
 override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
-override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache
+override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache  fastcgi custfcgi custweb
 endif
 ifeq ($(FULL_TARGET),powerpc64-darwin)
 override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache
@@ -433,7 +433,7 @@ ifeq ($(FULL_TARGET),avr-embedded)
 override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache
 endif
 ifeq ($(FULL_TARGET),armeb-linux)
-override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache
+override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache  fastcgi custfcgi custweb
 endif
 ifeq ($(FULL_TARGET),armeb-embedded)
 override TARGET_UNITS+=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb webutil fpdatasetform cgiapp ezcgi fpapache

packages/fcl-web/Makefile.fpc

@@ -9,6 +9,7 @@ version=2.2.2
 [target]
 units=httpdefs fphttp custcgi fpcgi fptemplate fphtml websession fpweb \
       webutil fpdatasetform cgiapp ezcgi fpapache 
+units_linux=fastcgi custfcgi custweb 
 rsts=fpcgi fphtml fpweb websession cgiapp
 
 [require]

packages/fcl-web/src/custfcgi.pp

@@ -315,6 +315,7 @@ end;
 
 constructor TCustomFCgiApplication.Create(AOwner: TComponent);
 begin
+  Inherited Create(AOwner);
   FRequestsAvail:=5;
   SetLength(FRequestsArray,FRequestsAvail);
   FHandle := -1;

packages/fcl-web/src/custweb.pp

@@ -21,7 +21,7 @@ unit custweb;
 Interface
 
 uses
-  CustApp,Classes,SysUtils, httpdefs;
+  CustApp,Classes,SysUtils, httpdefs, fphttp;
 
 Const
   CGIVarCount = 34;
@@ -70,27 +70,40 @@ Const
 
 Type
   { TCustomWebApplication }
+  TGetModuleEvent = Procedure (Sender : TObject; ARequest : TRequest;
+                               Var ModuleClass : TCustomHTTPModuleClass) of object;
 
   TCustomWebApplication = Class(TCustomApplication)
   Private
+    FAllowDefaultModule: Boolean;
+    FModuleVar: String;
+    FOnGetModule: TGetModuleEvent;
     FRequest : TRequest;
     FHandleGetOnPost : Boolean;
     FRedirectOnError : Boolean;
     FRedirectOnErrorURL : String;
   protected
+    Function GetModuleName(Arequest : TRequest) : string;
     function WaitForRequest(var ARequest : TRequest; var AResponse : TResponse) : boolean; virtual; abstract;
     procedure EndRequest(ARequest : TRequest;AResponse : TResponse); virtual;
+    function FindModule(ModuleClass : TCustomHTTPModuleClass): TCustomHTTPModule;
   Public
     constructor Create(AOwner: TComponent); override;
     Procedure Initialize; override;
     Procedure DoRun; override;
+    Procedure ShowException(E: Exception);override;
     Procedure handleRequest(ARequest : TRequest; AResponse : TResponse); virtual;
     Property HandleGetOnPost : Boolean Read FHandleGetOnPost Write FHandleGetOnPost;
     Property RedirectOnError : boolean Read FRedirectOnError Write FRedirectOnError;
     Property RedirectOnErrorURL : string Read FRedirectOnErrorURL Write FRedirectOnErrorURL;
     Property Request : TRequest read FRequest;
+    Property AllowDefaultModule : Boolean Read FAllowDefaultModule Write FAllowDefaultModule;
+    Property ModuleVariable : String Read FModuleVar Write FModuleVar;
+    Property OnGetModule : TGetModuleEvent Read FOnGetModule Write FOnGetModule;
   end;
 
+  EFPWebError = Class(Exception);
+
 Implementation
 
 {$ifdef CGIDEBUG}
@@ -98,6 +111,10 @@ uses
   dbugintf;
 {$endif}
 
+resourcestring
+  SErrNoModuleNameForRequest = 'Could not determine HTTP module name for request';
+  SErrNoModuleForRequest = 'Could not determine HTTP module for request "%s"';
+
 procedure TCustomWebApplication.DoRun;
 var ARequest : TRequest;
     AResponse : TResponse;
@@ -114,9 +131,46 @@ begin
     end;
 end;
 
+procedure TCustomWebApplication.ShowException(E: Exception);
+var Buf:ShortString;
+begin
+{$ifdef CGIDEBUG}
+  SetLength(Buf,ExceptionErrorMessage(ExceptObject,ExceptAddr,@Buf[1],255));
+  senddebug('Exception: ' + Buf);
+{$endif CGIDEBUG}
+  inherited ShowException(E);
+end;
+
 procedure TCustomWebApplication.HandleRequest(ARequest: TRequest; AResponse: TResponse);
+Var
+  MC : TCustomHTTPModuleClass;
+  M  : TCustomHTTPModule;
+  MN : String;
+  MI : TModuleItem;
+
 begin
-  // Needs overriding;
+  MC:=Nil;
+  M:=NIL;
+  If (OnGetModule<>Nil) then
+    OnGetModule(Self,ARequest,MC);
+  If (MC=Nil) then
+    begin
+    MN:=GetModuleName(ARequest);
+    If (MN='') and Not AllowDefaultModule then
+      Raise EFPWebError.Create(SErrNoModuleNameForRequest);
+    MI:=ModuleFactory.FindModule(MN);
+    If (MI=Nil) and (ModuleFactory.Count=1) then
+      MI:=ModuleFactory[0];
+    if (MI=Nil) then
+      begin
+      Raise EFPWebError.CreateFmt(SErrNoModuleForRequest,[MN]);
+      end;
+    MC:=MI.ModuleClass;
+    end;
+  M:=FindModule(MC); // Check if a module exists already
+  If (M=Nil) then
+    M:=MC.Create(Self);
+  M.HandleRequest(ARequest,AResponse);
 end;
 
 Procedure TCustomWebApplication.Initialize;
@@ -126,15 +180,46 @@ begin
   Inherited;
 end;
 
+function TCustomWebApplication.GetModuleName(Arequest: TRequest): string;
+var
+  S : String;
+begin
+  If (FModuleVar<>'') then
+    Result:=ARequest.QueryFields.Values[FModuleVar];//Module name from query parameter using the FModuleVar as parameter name (default is 'Module')
+  If (Result='') then
+    begin
+    S:=ARequest.PathInfo;
+    Delete(S,1,1);
+    if (Pos('/',S) <= 0) and AllowDefaultModule then
+      Exit;//There is only 1 '/' in ARequest.PathInfo -> only ActionName is there -> use default module
+    Result:=ARequest.GetNextPathInfo;
+    end;
+end;
+
 procedure TCustomWebApplication.EndRequest(ARequest: TRequest; AResponse: TResponse);
 begin
   AResponse.Free;
   ARequest.Free;
 end;
 
+function TCustomWebApplication.FindModule(ModuleClass: TCustomHTTPModuleClass): TCustomHTTPModule;
+Var
+  I : Integer;
+begin
+  I:=ComponentCount-1;
+  While (I>=0) and (Not (Components[i] is ModuleClass)) do
+    Dec(i);
+  if (I>=0) then
+    Result:=Components[i] as TCustomHTTPModule
+  else
+    Result:=Nil;
+end;
+
 constructor TCustomWebApplication.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
+  FModuleVar:='Module'; // Do not localize
+  FAllowDefaultModule:=True;
   FHandleGetOnPost := True;
   FRedirectOnError := False;
   FRedirectOnErrorURL := '';