From 0c3f7bb6645cc2b5122f78fcf12776a1da55ed76 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C3=ABl=20Van=20Canneyt?= Date: Sat, 9 Sep 2023 17:07:31 +0200 Subject: [PATCH] * Allow event handlers to modify input --- .../fcl-web/src/restbridge/sqldbrestdata.pp | 110 ++++++++++-------- .../fcl-web/src/restbridge/sqldbrestio.pp | 54 ++++++++- .../fcl-web/src/restbridge/sqldbrestschema.pp | 11 ++ 3 files changed, 125 insertions(+), 50 deletions(-) diff --git a/packages/fcl-web/src/restbridge/sqldbrestdata.pp b/packages/fcl-web/src/restbridge/sqldbrestdata.pp index 918c1c911d..8baf8b0aa3 100644 --- a/packages/fcl-web/src/restbridge/sqldbrestdata.pp +++ b/packages/fcl-web/src/restbridge/sqldbrestdata.pp @@ -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); diff --git a/packages/fcl-web/src/restbridge/sqldbrestio.pp b/packages/fcl-web/src/restbridge/sqldbrestio.pp index 2ff7c436c4..ee1983a8ba 100644 --- a/packages/fcl-web/src/restbridge/sqldbrestio.pp +++ b/packages/fcl-web/src/restbridge/sqldbrestio.pp @@ -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; diff --git a/packages/fcl-web/src/restbridge/sqldbrestschema.pp b/packages/fcl-web/src/restbridge/sqldbrestschema.pp index c5cae20b80..58791532ba 100644 --- a/packages/fcl-web/src/restbridge/sqldbrestschema.pp +++ b/packages/fcl-web/src/restbridge/sqldbrestschema.pp @@ -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);