Browse Source

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

Michaël Van Canneyt 2 years ago
parent
commit
dbb0b013d6

+ 4 - 1
packages/fcl-web/src/restbridge/sqldbrestbridge.pp

@@ -40,7 +40,8 @@ Type
                            // rdoServerInfo            // Enable querying server info through /_serverinfo  resource
                            // 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.
                            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.
                            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;
   TRestDispatcherOptions = set of TRestDispatcherOption;
@@ -1414,6 +1415,8 @@ begin
     Include(opts,rhoCheckupdateCount);
     Include(opts,rhoCheckupdateCount);
   if (rdoAllowMultiRecordUpdates in DispatchOptions) then
   if (rdoAllowMultiRecordUpdates in DispatchOptions) then
     Include(opts,rhoAllowMultiUpdate);
     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.
   // Options may have been set in handler class, make sure we don't unset any.
   Result.Options:=Result.Options+Opts;
   Result.Options:=Result.Options+Opts;
   Result.UpdatedData:=IO.UpdatedData;
   Result.UpdatedData:=IO.UpdatedData;

+ 16 - 13
packages/fcl-web/src/restbridge/sqldbrestdata.pp

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

+ 35 - 0
packages/fcl-web/src/restbridge/sqldbrestschema.pp

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