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

* Add possibility to return empty dataset instead of 404, add event to refine WHERE Clause in code

Browse Source
This commit is contained in:
Michaël Van Canneyt 2023-08-06 11:14:20 +02:00
parent e2a54b6e75
commit dbb0b013d6
3 changed files with 55 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
packages/fcl-web/src/restbridge/sqldbrestbridge.pp
View File

@ -40,7 +40,8 @@ Type
// rdoServerInfo // Enable querying server info through /_serverinfo resource
rdoLegacyPut, // Makes PUT simulate PATCH : Not all values are required, missing values will be gotten from previous record.
rdoAllowNoRecordUpdates, // Check rows affected, rowsaffected = 0 is OK.
rdoAllowMultiRecordUpdates // Check rows affected, rowsaffected > 1 is OK.
rdoAllowMultiRecordUpdates, // Check rows affected, rowsaffected > 1 is OK.
rdoSingleEmptyOK // When asking a single resource and it does not exist, an empty dataset is returned
);
TRestDispatcherOptions = set of TRestDispatcherOption;
@ -1414,6 +1415,8 @@ begin
Include(opts,rhoCheckupdateCount);
if (rdoAllowMultiRecordUpdates in DispatchOptions) then
Include(opts,rhoAllowMultiUpdate);
if (rdoSingleEmptyOK in DispatchOptions) then
Include(opts,rhoSingleEmptyOK);
// Options may have been set in handler class, make sure we don't unset any.
Result.Options:=Result.Options+Opts;
Result.UpdatedData:=IO.UpdatedData;

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

@ -40,7 +40,7 @@ Type
TRestFilterPairArray = Array of TRestFilterPair;
{ TSQLDBRestDBHandler }
TSQLDBRestDBHandlerOption = (rhoLegacyPut,rhoCheckupdateCount,rhoAllowMultiUpdate);
TSQLDBRestDBHandlerOption = (rhoLegacyPut,rhoCheckupdateCount,rhoAllowMultiUpdate,rhoSingleEmptyOK);
TSQLDBRestDBHandlerOptions = set of TSQLDBRestDBHandlerOption;
TSQLDBRestDBHandler = Class(TComponent)
@ -445,7 +445,7 @@ begin
ftInteger : P.AsInteger:=StrToInt(S);
ftWord : P.AsWord:=StrToInt(S);
ftLargeint : P.AsLargeInt:=StrToInt64(S);
ftWideString : P.AsUnicodeString:=S;
ftWideString : P.AsUnicodeString:=UTF8Decode(S);
ftBoolean : P.AsBoolean:=StrToBool(S);
ftFloat,
ftCurrency,
@ -475,12 +475,12 @@ end;
procedure TSQLDBRestDBHandler.SetParamFromData(P: TParam; F: TSQLDBRestField;
D: TJSONData);
Procedure OtherParamValue(const S : String);
Procedure OtherParamValue(const S,N : String);
var
RP : TSQLDBRestParam;
begin
RP:=Self.FResource.Parameters.Find(P.Name);
RP:=Self.FResource.Parameters.Find(N);
if assigned(RP) then
SetParamFromStringAndType(P,S,RP.DataType)
else
@ -493,11 +493,9 @@ Var
begin
N:=P.Name;
if N='ID' then
Writeln('Ah');
if Assigned(D) then
if Assigned(D) and not ((D.JSONType in StructuredJSONTypes) or D.IsNull) then
S:=D.AsString;
if not Assigned(D) then
if (not Assigned(D)) or D.IsNull then
P.Clear
else if Assigned(F) then
Case F.FieldType of
@ -516,10 +514,10 @@ begin
P.AsBlob:=DecodeStringBase64(S);
{$ENDIF}
else
OtherParamValue(S);
OtherParamValue(S,N);
end
else
OtherParamValue(S);
OtherParamValue(S,N);
end;
function TSQLDBRestDBHandler.FindFieldForParam(aOperation: TRestOperation;
@ -769,6 +767,7 @@ begin
aWhere:=GetIDWhere(WhereFilterList)
else
aWhere:=GetWhere(WhereFilterList);
aWhere:=IO.Resource.DoCompleteWhere(IO.RestContext,skSelect,aWhere);
aOrderBy:=GetOrderBy;
aLimit:=GetLimit;
SQL:=FResource.GetResolvedSQl(skSelect,aWhere,aOrderBy,aLimit);
@ -824,7 +823,7 @@ begin
StreamDataset(IO.RESTOutput,D,FieldList)
else
begin
if Single then
if Single and not (rhoSingleEmptyOK in Self.Options) then
DoNotFound
else
StreamDataset(IO.RESTOutput,D,FieldList)
@ -1137,7 +1136,8 @@ const
Var
S : TSQLQuery;
aRowsAffected: Integer;
SQl : String;
SQl : UTF8String;
aWhere : UTF8String;
WhereFilterList : TRestFilterPairArray;
RequestFields : TSQLDBRestFieldArray;
@ -1165,7 +1165,9 @@ begin
end;
S:=TSQLQuery.Create(Self);
try
SQL:=FResource.GetResolvedSQl(skUpdate,GetIDWhere(WhereFilterList) ,'','',RequestFields);
aWhere:=GetIDWhere(WhereFilterList);
aWhere:=IO.Resource.DoCompleteWhere(IO.RestContext,skUpdate,aWhere);
SQL:=FResource.GetResolvedSQl(skUpdate,aWhere ,'','',RequestFields);
S.Database:=IO.Connection;
S.Transaction:=IO.Transaction;
S.SQL.Text:=SQL;
@ -1274,6 +1276,7 @@ begin
else
begin
aWhere:=GetIDWhere(FilteredFields);
aWhere:=IO.Resource.DoCompleteWhere(IO.RestContext,skDelete,aWhere);
SQL:=FResource.GetResolvedSQl(skDelete,aWhere,'');
Q:=CreateQuery(SQL);
try

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

@ -245,6 +245,7 @@ Type
TSQLDBRestAllowRecordEvent = Procedure (aSender : TObject; aContext : TBaseRestContext; aDataSet : TDataset; var allowRecord : Boolean) of object;
TSQLDBRestAllowResourceEvent = Procedure (aSender : TObject; aContext : TBaseRestContext; var allowResource : Boolean) of object;
TSQLDBRestAllowedOperationsEvent = Procedure (aSender : TObject; aContext : TBaseRestContext; var aOperations : TRestOperations) of object;
TSQLDBRestOnGetWhere = Procedure(Sender : TObject; aContext : TBaseRestContext; aKind : TSQLKind; var aWhere : UTF8String) of object;
TProcessIdentifier = Function (const S: UTF8String): UTF8String of object;
TSQLDBRestResource = class(TCollectionItem)
@ -259,6 +260,7 @@ Type
FOnAllowRecord: TSQLDBRestAllowRecordEvent;
FOnCheckParams: TSQLDBRestCheckParamsEvent;
FOnGetDataset: TSQLDBRestGetDatasetEvent;
FOnGetWhere: TSQLDBRestOnGetWhere;
FOnResourceAllowed: TSQLDBRestAllowResourceEvent;
FParameters: TSQLDBRestParameterList;
FResourceName: UTF8String;
@ -301,6 +303,7 @@ Type
Function ProcessSQl(const aSQL : String; Const AWhere : UTF8String; Const aOrderBy : UTF8String = ''; const aLimit : UTF8String = '') : UTF8String;
Procedure PopulateFieldsFromFieldDefs(Defs : TFieldDefs; aIndexFields : TStringArray; aProcessIdentifier : TProcessIdentifier; aMinFieldOpts : TRestFieldOptions);
Procedure PopulateParametersFromSQL(const SQL : String; DoClear : Boolean = True);
function DoCompleteWhere(aContext : TBaseRestContext; aKind: TSQLKind; const aWhere: UTF8String ): UTF8String;
Property SQL [aKind : TSQLKind] : TStrings Read GetSQLTyped;
Property BusinessProcessor : TSQLDBRestCustomBusinessProcessor Read FBusinessProcessor;
Published
@ -321,6 +324,7 @@ Type
Property OnGetDataset : TSQLDBRestGetDatasetEvent Read FOnGetDataset Write FOnGetDataset;
Property OnCheckParams : TSQLDBRestCheckParamsEvent Read FOnCheckParams Write FOnCheckParams;
Property OnAllowRecord : TSQLDBRestAllowRecordEvent Read FOnAllowRecord Write FOnAllowRecord;
Property OnGetWhere : TSQLDBRestOnGetWhere Read FOnGetWhere Write FOnGetWhere;
end;
{ TSQLDBRestResourceList }
@ -397,6 +401,7 @@ Type
Procedure CheckParams(aContext : TBaseRestContext; aOperation : TRestoperation; P : TParams); virtual; abstract;
Function GetDataset(aContext : TBaseRestContext; aFieldList : TRestFieldPairArray; aOrderBy : TRestFieldOrderPairArray; aLimit, aOffset : Int64) : TDataset; virtual;abstract;
Function AllowRecord(aContext : TBaseRestContext;aDataset : TDataset) : Boolean; virtual; abstract;
Function ProcessWhereSQL(aContext : TBaseRestContext; aKind : TSQLKind; const aWhere : UTF8String) : UTF8String; virtual;
Public
Property Resource : TSQLDBRestResource Read FResource;
Property ResourceName : UTF8String Read FResourceName Write SetResourceName;
@ -412,6 +417,7 @@ Type
FOnAllowRecord: TSQLDBRestAllowRecordEvent;
FOnCheckParams: TSQLDBRestCheckParamsEvent;
FOnGetDataset: TSQLDBRestGetDatasetEvent;
FOnGetWhere: TSQLDBRestOnGetWhere;
FOnResourceAllowed: TSQLDBRestAllowResourceEvent;
FSchema: TSQLDBRestSchema;
FAfterDatabaseRead: TRestDatabaseEvent;
@ -426,6 +432,7 @@ Type
Procedure CheckParams(aContext : TBaseRestContext; aOperation : TRestoperation; P : TParams); override;
Function GetDataset(aContext : TBaseRestContext; aFieldList : TRestFieldPairArray; aOrderBy : TRestFieldOrderPairArray; aLimit, aOffset : Int64) : TDataset; override;
Function AllowRecord(aContext : TBaseRestContext; aDataset : TDataset) : Boolean; override;
Function ProcessWhereSQL(aContext : TBaseRestContext; aKind : TSQLKind; const aWhere : UTF8String) : UTF8String; override;
Published
Property Schema : TSQLDBRestSchema Read GetSchema Write SetSchema;
Property ResourceName;
@ -434,6 +441,7 @@ Type
Property OnAllowResource : TSQLDBRestAllowResourceEvent Read FOnResourceAllowed Write FOnResourceAllowed;
Property OnAllowedOperations : TSQLDBRestAllowedOperationsEvent Read FOnAllowedOperations Write FOnAllowedOperations;
Property OnAllowRecord : TSQLDBRestAllowRecordEvent Read FOnAllowRecord Write FOnAllowRecord;
Property OnGetWhere : TSQLDBRestOnGetWhere Read FOnGetWhere Write FOnGetWhere;
Published
Property BeforeDatabaseUpdate : TRestDatabaseEvent Read FBeforeDatabaseUpdate Write FBeforeDatabaseUpdate;
Property AfterDatabaseUpdate : TRestDatabaseEvent Read FAfterDatabaseUpdate Write FAfterDatabaseUpdate;
@ -607,6 +615,15 @@ begin
Result:=Nil;
end;
function TSQLDBRestCustomBusinessProcessor.ProcessWhereSQL(aContext : TBaseRestContext; aKind : TSQLKind; const aWhere: UTF8String
): UTF8String;
begin
Result:=aWhere;
// Silence compiler
if aKind<>skSelect then
;
end;
{ TSQLDBRestBusinessProcessor }
procedure TSQLDBRestBusinessProcessor.SetSchema(AValue: TSQLDBRestSchema);
@ -670,6 +687,14 @@ begin
FOnAllowRecord(Self,acontext,aDataset,Result);
end;
function TSQLDBRestBusinessProcessor.ProcessWhereSQL(aContext : TBaseRestContext; aKind: TSQLKind;
const aWhere: UTF8String): UTF8String;
begin
Result:=inherited ProcessWhereSQL(aContext, aKind, aWhere);
if Assigned(FOnGetWhere) then
FOnGetWhere(Self,aContext,aKind,Result);
end;
{ ESQLDBRest }
@ -1442,6 +1467,16 @@ begin
Result:=ProcessSQL(Result,aWhere,aOrderBy,aLimit);
end;
function TSQLDBRestResource.DoCompleteWhere(aContext : TBaseRestContext; aKind: TSQLKind;const aWhere : UTF8String) : UTF8String;
begin
Result:=aWhere;
if Assigned(OnGetWhere) then
FOnGetWhere(Self,aContext, aKind,Result);
if Assigned(BusinessProcessor) then
Result:=BusinessProcessor.ProcessWhereSQL(aContext, aKind, Result);
end;
function TSQLDBRestResource.ProcessSQl(const aSQL: String; const AWhere: UTF8String;
const aOrderBy: UTF8String; const aLimit: UTF8String): UTF8String;