paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 09:02:22 +01:00
Code Issues Packages Projects Releases Wiki Activity

Added support for web-modules to TCustomWebApplication

Browse Source 
git-svn-id: trunk@12977 -
This commit is contained in:
joost 2009-03-29 12:26:56 +00:00
parent 87c17a6ef8
commit 0911ec32f2
4 changed files with 99 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
packages/fcl-web/Makefile
View File

@ -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

1
packages/fcl-web/Makefile.fpc
View File

@ -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]

1
packages/fcl-web/src/custfcgi.pp
View File

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

91
packages/fcl-web/src/custweb.pp
View File

@ -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.HandleRequest(ARequest: TRequest; AResponse: TResponse);
procedure TCustomWebApplication.ShowException(E: Exception);
var Buf:ShortString;
begin
// Needs overriding;
{$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
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 := '';