paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 17:47:56 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Allow event handlers to modify input

Browse Source
This commit is contained in:
Michaël Van Canneyt 2023-09-09 17:07:31 +02:00
parent 67f89afe99
commit 0c3f7bb664
3 changed files with 125 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

110
packages/fcl-web/src/restbridge/sqldbrestdata.pp
View File

@ -112,6 +112,9 @@ Type
procedure SetParamFromData(P: TParam; F: TSQLDBRestField; D: TJSONData); virtual;
function GetDataForParam(P: TParam; F: TSQLDBRestField; Sources : TVariableSources = AllVariableSources): TJSONData; virtual;
Function GetString(aString : TRestStringProperty) : UTF8String;
class function DefaultGetString(aConfig: TRestStringsConfig; aString: TRestStringProperty): UTF8String;
class procedure DefaultParamFromStringAndType(P: TParam; S: UTF8String; aDataType: TFieldType; aStrings: TRestStringsConfig);
virtual;
Property IO : TRestIO Read FRestIO;
Property Strings : TRestStringsConfig Read FStrings;
Property QueryClass : TSQLQueryClass Read FQueryClass;
@ -166,12 +169,64 @@ end;
function TSQLDBRestDBHandler.GetString(aString: TRestStringProperty): UTF8String;
begin
if Assigned(FStrings) then
Result:=FStrings.GetRestString(aString)
DefaultGetString(FStrings, aString);
end;
class function TSQLDBRestDBHandler.DefaultGetString(aConfig : TRestStringsConfig; aString: TRestStringProperty): UTF8String;
begin
if Assigned(aConfig) then
Result:=aConfig.GetRestString(aString)
else
Result:=TRestStringsConfig.GetDefaultString(aString);
end;
class procedure TSQLDBRestDBHandler.DefaultParamFromStringAndType(P: TParam; S: UTF8String; aDataType: TFieldType; aStrings : TRestStringsConfig);
var
F : Double;
C : Integer;
begin
Case aDataType of
ftFmtMemo,
ftFixedChar,
ftFixedWideChar,
ftWideMemo,
ftMemo,
ftString : P.AsString:=S;
ftSmallint : P.AsSmallInt:=StrToInt(S);
ftInteger : P.AsInteger:=StrToInt(S);
ftWord : P.AsWord:=StrToInt(S);
ftLargeint : P.AsLargeInt:=StrToInt64(S);
ftWideString : P.AsUnicodeString:=UTF8Decode(S);
ftBoolean : P.AsBoolean:=StrToBool(S);
ftFloat,
ftCurrency,
ftFMTBcd,
ftBCD :
begin
Val(S,F,C);
if C=0 then
P.AsFloat:=F
else
Raise EConvertError.Create('Invalid float value : '+S);
end;
ftDate : P.AsDateTime:=ScanDateTime(DefaultGetString(aStrings, rpDateFormat),S);
ftTime : P.AsDateTime:=ScanDateTime(DefaultGetString(aStrings, rpDateFormat),S);
ftTimeStamp,
ftDateTime : P.AsDateTime:=ScanDateTime(DefaultGetString(aStrings, rpDateTimeFormat),S);
ftVariant : P.Value:=S;
ftBytes : P.AsBytes:=TENcoding.UTF8.GetAnsiBytes(S);
ftVarBytes : P.AsBytes:=TENcoding.UTF8.GetAnsiBytes(S);
ftBlob : P.AsBytes:=TENcoding.UTF8.GetAnsiBytes(S);
ftGUID : P.AsString:=S;
else
Raise EConvertError.CreateFmt('Unsupported data type: %s',[GetEnumName(TypeInfo(TFieldType),Ord(aDataType))]);
end;
end;
function TSQLDBRestDBHandler.GetIDWhere(out FilteredFields: TRestFilterPairArray): UTF8String;
@ -404,7 +459,7 @@ begin
if (vs<>vsNone) then
Result:=TJSONString.Create(S)
else if (vsContent in Sources) then
Result:=IO.RESTInput.GetContentField(N);
Result:=IO.GetContentField(N);
end;
If (Result=Nil) then
begin
@ -415,7 +470,7 @@ begin
if (vs<>vsNone) then
Result:=TJSONString.Create(S)
else if (vsContent in Sources) then
Result:=IO.RESTInput.GetContentField(N)
Result:=IO.GetContentField(N)
else if vsParam in Sources then
begin
RP:=FResource.Parameters.Find(N);
@ -427,49 +482,8 @@ end;
procedure TSQLDBRestDBHandler.SetParamFromStringAndType(P : TParam; S : UTF8String; aDataType: TFieldType);
var
F : Double;
C : Integer;
begin
Case aDataType of
ftFmtMemo,
ftFixedChar,
ftFixedWideChar,
ftWideMemo,
ftMemo,
ftString : P.AsString:=S;
ftSmallint : P.AsSmallInt:=StrToInt(S);
ftInteger : P.AsInteger:=StrToInt(S);
ftWord : P.AsWord:=StrToInt(S);
ftLargeint : P.AsLargeInt:=StrToInt64(S);
ftWideString : P.AsUnicodeString:=UTF8Decode(S);
ftBoolean : P.AsBoolean:=StrToBool(S);
ftFloat,
ftCurrency,
ftFMTBcd,
ftBCD :
begin
Val(S,F,C);
if C=0 then
P.AsFloat:=F
else
Raise EConvertError.Create('Invalid float value : '+S);
end;
ftDate : P.AsDateTime:=ScanDateTime(GetString(rpDateFormat),S);
ftTime : P.AsDateTime:=ScanDateTime(GetString(rpDateFormat),S);
ftTimeStamp,
ftDateTime : P.AsDateTime:=ScanDateTime(GetString(rpDateTimeFormat),S);
ftVariant : P.Value:=S;
ftBytes : P.AsBytes:=TENcoding.UTF8.GetAnsiBytes(S);
ftVarBytes : P.AsBytes:=TENcoding.UTF8.GetAnsiBytes(S);
ftBlob : P.AsBytes:=TENcoding.UTF8.GetAnsiBytes(S);
ftGUID : P.AsString:=S;
else
Raise EConvertError.CreateFmt('Unsupported data type: %s',[GetEnumName(TypeInfo(TFieldType),Ord(aDataType))]);
end;
DefaultParamFromStringAndType(P,S,aDataType,FStrings);
end;
procedure TSQLDBRestDBHandler.SetParamFromData(P: TParam; F: TSQLDBRestField;
@ -880,7 +894,7 @@ begin
if (RF.GeneratorName<>'') then // Only when doing POST
D:=TJSONInt64Number.Create(GetGeneratorValue(RF.GeneratorName))
else
D:=IO.RESTInput.GetContentField(RF.PublicName);
D:=IO.GetContentField(RF.PublicName);
end
else if IO.GetVariable(FData.Name,V,[vsContent,vsQuery])<>vsNone then
D:=TJSONString.Create(V);
@ -944,7 +958,7 @@ begin
if (F.GeneratorName<>'') and (Old=Nil) then // Only when doing POST
D:=TJSONInt64Number.Create(GetGeneratorValue(F.GeneratorName))
else
D:=IO.RESTInput.GetContentField(F.PublicName);
D:=IO.GetContentField(F.PublicName);
end
else if IO.GetVariable(P.Name,V,[vsContent,vsQuery])<>vsNone then
D:=TJSONString.Create(V);

54
packages/fcl-web/src/restbridge/sqldbrestio.pp
View File

@ -293,6 +293,7 @@ Type
function GetConnection: TSQLConnection; override;
function GetTransaction: TSQLTransaction; override;
Function DoGetInputData(const aName : UTF8string) : TJSONData; override;
Procedure DoSetInputData(aName : UTF8string; aValue : TJSONData); override;
Function GetUpdateData : TDataset; override;
property IO : TRestIO Read FIO;
Public
@ -320,6 +321,7 @@ Type
FTrans: TSQLTransaction;
FContentStream : TStream;
FUpdatedData: TBufDataset;
FCustomInputData : TJSONObject;
function GetResourceName: UTF8String;
function GetUserID: String;
procedure SetUserID(const AValue: String);
@ -336,9 +338,13 @@ Type
procedure SetOperation(aOperation : TRestOperation);
Procedure SetRestStrings(aValue : TRestStringsConfig);
Procedure SetRestStatuses(aValue : TRestStatusConfig);
Procedure SetCustomInputData(Const aName : UTF8String; aValue : TJSONData);
// Get things
class function StrToNullBoolean(const S: String; Strict: Boolean): TNullBoolean;
Procedure DoGetVariable(Sender : TObject; Const aName : UTF8String; Out aVal : UTF8String);
function GetCustomInputData(const aName : UTF8String) : TJSONData;
// You must free the result of this function !
Function GetContentField(const aName : UTF8string) : TJSONData; virtual;
Function GetVariable (Const aName : UTF8String; Out aVal : UTF8String; AllowedSources : TVAriableSources = AllVariableSources) : TVariableSource; virtual;
function GetFilterVariable(const aName: UTF8String; AFilter: TRestFieldFilter; out aValue: UTF8String): TVariableSource;
Function GetBooleanVar(Const aName : UTF8String; aStrict : Boolean = False) : TNullBoolean;
@ -596,6 +602,11 @@ begin
Result:=IO.RESTInput.GetContentField(aName);
end;
procedure TRestContext.DoSetInputData(aName: UTF8string; aValue: TJSONData);
begin
IO.SetCustomInputData(aName,aValue);
end;
function TRestContext.GetUpdateData: TDataset;
begin
Result:=IO.UpdatedData;
@ -991,12 +1002,51 @@ begin
FRestStatuses:=aValue;
end;
procedure TRestIO.SetCustomInputData(const aName: UTF8String; aValue: TJSONData);
begin
if FCustomInputData=Nil then
FCustomInputData:=TJSONObject.Create([aName,aValue])
else
FCustomInputData.Elements[aName]:=aValue;
end;
function TRestIO.GetCustomInputData(const aName: UTF8String): TJSONData;
var
Idx : Integer;
begin
Result:=Nil;
if (FCustomInputData<>Nil) then
begin
Idx:=FCustomInputData.IndexOfName(aName,True);
if Idx<>-1 then
Result:=FCustomInputData.Items[idx];
end;
end;
procedure TRestIO.DoGetVariable(Sender: TObject; const aName: UTF8String; out
aVal: UTF8String);
begin
GetVariable(aName,aVal);
end;
function TRestIO.GetContentField(const aName: UTF8string): TJSONData;
var
Idx : Integer;
begin
Idx:=-1;
if Assigned(FCustomInputData) then
Idx:=FCustomInputData.IndexOfName(aName);
if Idx<>-1 then
Result:=FCustomInputData.Items[Idx].Clone
else
Result:=RESTInput.GetContentField(aName);
end;
procedure TRestIO.SetUserID(const AValue: String);
begin
if (UserID=AValue) then Exit;
@ -1028,6 +1078,7 @@ end;
destructor TRestIO.Destroy;
begin
FreeAndNil(FCustomInputData);
FreeAndNil(FUpdatedData);
FreeAndNil(FRestContext);
if Assigned(FInput) then
@ -1053,8 +1104,7 @@ begin
Result:=TRestContext.Create;
end;
function TRestIO.GetVariable(const aName: UTF8String; out aVal: UTF8String;
AllowedSources: TVAriableSources): TVariableSource;
function TRestIO.GetVariable(const aName: UTF8String; out aVal: UTF8String; AllowedSources: TVariableSources): TVariableSource;
Function FindInList(aSource : TVariableSource;L : TStrings) : Boolean;

11
packages/fcl-web/src/restbridge/sqldbrestschema.pp
View File

@ -74,6 +74,7 @@ Type
Procedure AddToFreeList(aData : TJSONData);
// The result of this function will be freed.
function DoGetInputData(const aName: UTF8string): TJSONData; virtual; abstract;
Procedure DoSetInputData(aName: UTF8string; aValue: TJSONData); virtual; abstract;
Function GetConnection : TSQLConnection; virtual; abstract;
Function GetTransaction : TSQLTransaction; virtual; abstract;
Function GetUpdateData : TDataset; virtual; abstract;
@ -83,6 +84,8 @@ Type
Function GetVariable(Const aName : UTF8String; aSources : TVariableSources; Out aValue : UTF8String) : Boolean; virtual; abstract;
// Get data from input data. Do not free the result !
Function GetInputData(aName : UTF8string) : TJSONData;
// Set data from input data. Do not free the result !
Procedure SetInputData(aName : UTF8string; aValue : TJSONData);
// This will be set when calling.
Property UserID : UTF8String Read FUserID Write FUserID;
// You can attach data to this if you want to. It will be kept for the duration of the request.
@ -94,6 +97,9 @@ Type
Property Transaction : TSQLTransaction Read GetTransaction;
// Updated data after PUT/POST/PATCH
Property UpdatedData : TDataset Read GetUpdateData;
// Property access to input data. You can set this as well in before update handlers.
// The value you set will be set
Property InputData[aName : UTF8String] : TJSONData Read GetInputData Write SetInputData;
end;
{ ESQLDBRest }
@ -590,6 +596,11 @@ begin
AddToFreeList(Result);
end;
procedure TBaseRestContext.SetInputData(aName: UTF8string; aValue: TJSONData);
begin
DoSetInputData(aName,aValue);
end;
{ TSQLDBRestCustomBusinessProcessor }
procedure TSQLDBRestCustomBusinessProcessor.SetResourceName(AValue: UTF8String);