paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-30 20:39:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Made TCustomWebAction.SetDisplayName override its parent

Browse Source 
* When DefActionWhenUnkown is true, use the default action when the action
   is invalid. Else raise an exception. Based on patch from Attila Borka, 
   bug #13254

git-svn-id: trunk@13005 -
This commit is contained in:
joost 2009-04-05 21:24:04 +00:00
parent 626a723f8c
commit 709fcaa7bd
2 changed files with 53 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
packages/fcl-web/src/fphttp.pp
View File

@ -58,7 +58,7 @@ Type
Protected
procedure SetContentProducer(const AValue: THTTPContentProducer);virtual;
Function GetDisplayName : String; override;
Procedure SetDisplayName(AValue : String);
Procedure SetDisplayName(const AValue : String); override;
Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse; Var Handled : Boolean);
Procedure DoHandleRequest(ARequest : TRequest; AResponse : TResponse; Var Handled : Boolean); virtual;
published
@ -75,6 +75,7 @@ Type
TCustomWebActions = Class(TCollection)
private
FActionVar : String;
FDefActionWhenUnknown: Boolean;
FOnGetAction: TGetActionEvent;
function GetActions(Index : Integer): TCustomWebAction;
procedure SetActions(Index : Integer; const AValue: TCustomWebAction);
@ -83,6 +84,7 @@ Type
Function GetActionName(ARequest : TRequest) : String;
Property ActionVar : String Read FactionVar Write FActionVar;
public
constructor Create(AItemClass: TCollectionItemClass);
Procedure Assign(Source : TPersistent); override;
Function Add : TCustomWebAction;
Function ActionByName(AName : String) : TCustomWebAction;
@ -90,6 +92,7 @@ Type
Function IndexOfAction(AName : String) : Integer;
Property OnGetAction : TGetActionEvent Read FOnGetAction Write FOnGetAction;
Property Actions[Index : Integer] : TCustomWebAction Read GetActions Write SetActions; Default;
Property DefActionWhenUnknown : Boolean read FDefActionWhenUnknown write FDefActionWhenUnknown;
end;
TCustomHTTPModule = Class(TDataModule)
@ -136,6 +139,7 @@ Resourcestring
SErrNoSuchAction = 'No action found for action: "%s"';
SErrUnknownAction = 'Unknown action: "%s"';
SErrNoDefaultAction = 'No action name and no default action';
SErrInvActNoDefaultAction = 'Invalid action name and no default action';
SErrRequestNotHandled = 'Web request was not handled by actions.';
Implementation
@ -290,7 +294,7 @@ begin
Result:=FName;
end;
procedure TCustomWebAction.SetDisplayName(AValue: String);
procedure TCustomWebAction.SetDisplayName(const AValue: String);
begin
Inherited;
FName:=AValue;
@ -329,26 +333,42 @@ end;
Function TCustomWebActions.GetRequestAction(ARequest: TRequest) : TCustomWebAction;
Var
I : Integer;
S : String;
Function GetDefaultAction:TCustomWebAction;
Var I : Integer;
begin
Result := nil;
I:=0;
While (Result=Nil) and (I<Count) do
begin
If Actions[I].Default then
Result:=Actions[I];
Inc(I);
end;
end;
begin
Result:=Nil;
S:=GetActionName(ARequest);
If (S<>'') then
Result:=FindAction(S)
else
begin
I:=0;
While (Result=Nil) and (I<Count) do
begin
If Actions[i].Default then
Result:=Actions[i];
Inc(i);
begin
Result:=FindAction(S);
if Result = nil then
begin//no action with that name found
if not DefActionWhenUnknown then
Raise EFPHTTPError.CreateFmt(SErrNoSuchAction,[s])
else begin
Result := GetDefaultAction;
if Result = nil then
Raise EFPHTTPError.Create(SErrInvActNoDefaultAction);
end;
end;
end else begin //no action name was specified
Result := GetDefaultAction;
If (Result=Nil) then
Raise EFPHTTPError.Create(SErrNoDefaultAction);
end;
end;
end;
@ -366,6 +386,12 @@ begin
end;
end;
constructor TCustomWebActions.Create(AItemClass: TCollectionItemClass);
begin
inherited Create(AItemClass);
FDefActionWhenUnknown:=True;
end;
procedure TCustomWebActions.Assign(Source: TPersistent);
begin
If (Source is TCustomWebActions) then

14
packages/fcl-web/src/fpweb.pp
View File

@ -104,9 +104,11 @@ Type
FTemplate: TFPTemplate;
FTemplateVars : TTemplateVars;
function GetActionVar: String;
function GetDefActionWhenUnknown: Boolean;
function GetOnGetAction: TGetActionEvent;
procedure SetActions(const AValue: TFPWebActions);
procedure SetActionVar(const AValue: String);
procedure SetDefActionWhenUnknown(const AValue: Boolean);
procedure SetOnGetAction(const AValue: TGetActionEvent);
procedure SetTemplate(const AValue: TFPTemplate);
Protected
@ -125,6 +127,7 @@ Type
Property OnRequest : TWebActionEvent Read FOnRequest Write FOnRequest;
Property AfterResponse : TResponseEvent Read FAfterResponse Write FAfterResponse;
Property OnGetAction : TGetActionEvent Read GetOnGetAction Write SetOnGetAction;
Property DefActionWhenUnknown : Boolean read GetDefActionWhenUnknown write SetDefActionWhenUnknown default true;
Property Template : TFPTemplate Read FTemplate Write SetTemplate;
Property OnGetParam : TGetParamEvent Read FOnGetParam Write FOnGetParam;
Property OnTemplateContent : TGetParamEvent Read FOnGetParam Write FOnGetParam;
@ -140,6 +143,7 @@ Type
Property OnRequest;
Property AfterResponse;
Property OnGetAction;
Property DefActionWhenUnknown;
Property CreateSession;
Property Session;
Property OnNewSession;
@ -311,6 +315,11 @@ begin
Result:=FActions.ActionVar;
end;
function TCustomFPWebModule.GetDefActionWhenUnknown: Boolean;
begin
Result:=FActions.DefActionWhenUnknown;
end;
function TCustomFPWebModule.GetOnGetAction: TGetActionEvent;
begin
Result:=FActions.OnGetAction;
@ -328,6 +337,11 @@ begin
FActions.ActionVar:=AValue;
end;
procedure TCustomFPWebModule.SetDefActionWhenUnknown(const AValue: Boolean);
begin
FActions.DefActionWhenUnknown:=AValue;
end;
procedure TCustomFPWebModule.SetOnGetAction(const AValue: TGetActionEvent);
begin
FActions.OnGetAction:=AValue;