* Implemented RETURNING clause as a way of updating fields

git-svn-id: trunk@30463 -

packages/fcl-db/src/base/dbconst.pas

@@ -122,6 +122,7 @@ Resourcestring
   SErrRefreshNotSingleton     = 'Refresh SQL resulted in multiple records: %d.';
   SErrRefreshEmptyResult      = 'Refresh SQL resulted in empty result set.';
   SErrNoKeyFieldForRefreshClause = 'No key field found to construct refresh SQL WHERE clause';
+  SErrFailedToFetchReturningResult = 'Failed to fetch returning result';
 
 Implementation
 

packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -180,7 +180,7 @@ constructor TIBConnection.Create(AOwner : TComponent);
 
 begin
   inherited;
-  FConnOptions := FConnOptions + [sqSupportParams] + [sqEscapeRepeat];
+  FConnOptions := FConnOptions + [sqSupportParams, sqEscapeRepeat, sqSupportReturning];
   FBlobSegmentSize := 65535; //Shows we're using the maximum segment size
   FDialect := INVALID_DATA;
   ResetDatabaseInfo;

packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -274,7 +274,7 @@ constructor TPQConnection.Create(AOwner : TComponent);
 
 begin
   inherited;
-  FConnOptions := FConnOptions + [sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeRepeat, sqEscapeSlash, sqImplicitTransaction];
+  FConnOptions := FConnOptions + [sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeRepeat, sqEscapeSlash, sqImplicitTransaction,sqSupportReturning];
   FieldNameQuoteChars:=DoubleQuotes;
   VerboseErrors:=True;
   FConnectionPool:=TThreadlist.Create;

packages/fcl-db/src/sqldb/sqldb.pp

@@ -138,7 +138,7 @@ type
 
   { TSQLConnection }
 
-  TConnOption = (sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeSlash, sqEscapeRepeat, sqImplicitTransaction, sqLastInsertID);
+  TConnOption = (sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeSlash, sqEscapeRepeat, sqImplicitTransaction, sqLastInsertID, sqSupportReturning);
   TConnOptions= set of TConnOption;
 
   TSQLConnectionOption = (scoExplicitConnect, scoApplyUpdatesChecksRowsAffected);
@@ -172,11 +172,11 @@ type
     // One day, this may be factored out to a TSQLResolver class.
     // The following allow construction of update queries. They can be adapted as needed by descendents to fit the DB engine.
     procedure AddFieldToUpdateWherePart(var sql_where: string; UpdateMode : TUpdateMode; F: TField); virtual;
-    function ConstructInsertSQL(Query: TCustomSQLQuery): string; virtual;
+    function ConstructInsertSQL(Query: TCustomSQLQuery; Var ReturningClause : Boolean): string; virtual;
-    function ConstructUpdateSQL(Query: TCustomSQLQuery): string; virtual;
+    function ConstructUpdateSQL(Query: TCustomSQLQuery; Var ReturningClause : Boolean): string; virtual;
     function ConstructDeleteSQL(Query: TCustomSQLQuery): string; virtual;
     function ConstructRefreshSQL(Query: TCustomSQLQuery; UpdateKind : TUpdateKind): string; virtual;
-    function InitialiseUpdateStatement(Query: TCustomSQLQuery; var qry: TCustomSQLStatement): TCustomSQLStatement;
+    function InitialiseUpdateStatement(Query: TCustomSQLQuery; var qry: TCustomSQLQuery): TCustomSQLQuery;
     procedure ApplyFieldUpdate(C : TSQLCursor; P: TSQLDBParam; F: TField; UseOldValue: Boolean); virtual;
     // This is the call that updates a record, it used to be in TSQLQuery.
     procedure ApplyRecUpdate(Query : TCustomSQLQuery; UpdateKind : TUpdateKind); virtual;
@@ -402,7 +402,7 @@ type
 
   { TCustomSQLQuery }
 
-  TSQLQueryOption = (sqoKeepOpenOnCommit, sqoAutoApplyUpdates, sqoAutoCommit, sqoCancelUpdatesOnRefresh);
+  TSQLQueryOption = (sqoKeepOpenOnCommit, sqoAutoApplyUpdates, sqoAutoCommit, sqoCancelUpdatesOnRefresh, sqoPreferRefresh);
   TSQLQueryOptions = Set of TSQLQueryOption;
 
   TCustomSQLQuery = class (TCustomBufDataset)
@@ -433,7 +433,7 @@ type
 
     FInsertQry,
     FUpdateQry,
-    FDeleteQry           : TCustomSQLStatement;
+    FDeleteQry           : TCustomSQLQuery;
     FSequence            : TSQLSequence;
     procedure FreeFldBuffers;
     function GetParamCheck: Boolean;
@@ -466,6 +466,7 @@ type
     Function RefreshLastInsertID(Field: TField): Boolean; virtual;
     Function NeedRefreshRecord (UpdateKind: TUpdateKind): Boolean; virtual;
     Function RefreshRecord (UpdateKind: TUpdateKind) : Boolean; virtual;
+    Procedure ApplyReturningResult(Q : TCustomSQLQuery; UpdateKind : TUpdateKind);
     Function Cursor : TSQLCursor;
     Function LogEvent(EventType : TDBEventType) : Boolean;
     Procedure Log(EventType : TDBEventType; Const Msg : String); virtual;
@@ -1587,15 +1588,18 @@ begin
 end;
 
 
-function TSQLConnection.InitialiseUpdateStatement(Query : TCustomSQLQuery; var qry : TCustomSQLStatement): TCustomSQLStatement;
+function TSQLConnection.InitialiseUpdateStatement(Query : TCustomSQLQuery; var qry : TCustomSQLQuery): TCustomSQLQuery;
 
 begin
   if not assigned(qry) then
   begin
-    qry := TCustomSQLStatement.Create(nil);
+    qry := TCustomSQLQuery.Create(nil);
     qry.ParseSQL := False;
     qry.DataBase := Self;
     qry.Transaction := Query.SQLTransaction;
+    qry.Unidirectional:=True;
+    qry.UsePrimaryKeyAsKey:=False;
+    qry.PacketRecords:=1;
   end;
   Result:=qry;
 end;
@@ -1620,16 +1624,19 @@ begin
 end;
 
 
-function TSQLConnection.ConstructInsertSQL(Query : TCustomSQLQuery) : string;
+function TSQLConnection.ConstructInsertSQL(Query : TCustomSQLQuery; Var ReturningClause : Boolean) : string;
 
 var x          : integer;
     sql_fields : string;
     sql_values : string;
+    returning_fields : String;
     F : TField;
 
+
 begin
   sql_fields := '';
   sql_values := '';
+  returning_fields :='';
   for x := 0 to Query.Fields.Count -1 do
     begin
     F:=Query.Fields[x];
@@ -1638,37 +1645,60 @@ begin
       sql_fields := sql_fields + FieldNameQuoteChars[0] + F.FieldName + FieldNameQuoteChars[1] + ',';
       sql_values := sql_values + ':"' + F.FieldName + '",';
       end;
+    if ReturningClause and (pfRefreshOnInsert in F.ProviderFlags) then
+      returning_fields :=returning_fields+FieldNameQuoteChars[0] + F.FieldName + FieldNameQuoteChars[1] + ',';
     end;
   if length(sql_fields) = 0 then
     DatabaseErrorFmt(sNoUpdateFields,['insert'],self);
   setlength(sql_fields,length(sql_fields)-1);
   setlength(sql_values,length(sql_values)-1);
-
   result := 'insert into ' + Query.FTableName + ' (' + sql_fields + ') values (' + sql_values + ')';
+  if ReturningClause then
+    begin
+    ReturningClause:=length(returning_fields) <> 0 ;
+    if ReturningClause then
+      begin
+      setlength(returning_fields,length(returning_fields)-1);
+      result:=Result+' returning '+returning_fields;
+      end;
+    end;
 end;
 
 
-function TSQLConnection.ConstructUpdateSQL(Query: TCustomSQLQuery): string;
+function TSQLConnection.ConstructUpdateSQL(Query: TCustomSQLQuery; Var ReturningClause : Boolean): string;
 
 var x : integer;
     F : TField;
     sql_set    : string;
     sql_where  : string;
+    returning_fields : String;
 
 begin
   sql_set := '';
   sql_where := '';
+  returning_fields :='';
   for x := 0 to Query.Fields.Count -1 do
     begin
     F:=Query.Fields[x];
     AddFieldToUpdateWherePart(sql_where,Query.UpdateMode,F);
     if (pfInUpdate in F.ProviderFlags) and (not F.ReadOnly) then
       sql_set := sql_set +FieldNameQuoteChars[0] + F.FieldName + FieldNameQuoteChars[1] +'=:"' + F.FieldName + '",';
+    if ReturningClause and (pfRefreshOnUpdate in F.ProviderFlags) then
+      returning_fields :=returning_fields+FieldNameQuoteChars[0] + F.FieldName + FieldNameQuoteChars[1] + ',';
     end;
   if length(sql_set) = 0 then DatabaseErrorFmt(sNoUpdateFields,['update'],self);
   setlength(sql_set,length(sql_set)-1);
   if length(sql_where) = 0 then DatabaseErrorFmt(sNoWhereFields,['update'],self);
   result := 'update ' + Query.FTableName + ' set ' + sql_set + ' where ' + sql_where;
+  if ReturningClause then
+    begin
+    ReturningClause:=length(returning_fields) <> 0 ;
+    if ReturningClause then
+      begin
+      setlength(returning_fields,length(returning_fields)-1);
+      result:=Result+' returning '+returning_fields;
+      end;
+    end;
 end;
 
 
@@ -1737,24 +1767,27 @@ end;
 procedure TSQLConnection.ApplyRecUpdate(Query: TCustomSQLQuery; UpdateKind: TUpdateKind);
 
 var
-  qry : TCustomSQLStatement;
+  qry : TCustomSQLQuery;
   s   : string;
   x   : integer;
   Fld : TField;
   P : TParam;
-  B : Boolean;
+  B,ReturningClause : Boolean;
 
 begin
+  qry:=Nil;
+  ReturningClause:=(sqSupportReturning in Connoptions) and not (sqoPreferRefresh in Query.Options);
   case UpdateKind of
     ukInsert : begin
                s := trim(Query.FInsertSQL.Text);
-               if s = '' then s := ConstructInsertSQL(Query);
+               if s = '' then
+                 s := ConstructInsertSQL(Query,ReturningClause);
                qry := InitialiseUpdateStatement(Query,Query.FInsertQry);
                end;
     ukModify : begin
                s := trim(Query.FUpdateSQL.Text);
                if (s='') and (not assigned(Query.FUpdateQry) or (Query.UpdateMode<>upWhereKeyOnly)) then //first time or dynamic where part
-                 s := ConstructUpdateSQL(Query);
+                 s := ConstructUpdateSQL(Query,ReturningClause);
                qry := InitialiseUpdateStatement(Query,Query.FUpdateQry);
                end;
     ukDelete : begin
@@ -1762,11 +1795,12 @@ begin
                if (s='') and (not assigned(Query.FDeleteQry) or (Query.UpdateMode<>upWhereKeyOnly)) then
                  s := ConstructDeleteSQL(Query);
                qry := InitialiseUpdateStatement(Query,Query.FDeleteQry);
+               ReturningClause:=False;
                end;
   end;
   if (s<>'') and (qry.SQL.Text<>s) then
     qry.SQL.Text:=s; //assign only when changed, to avoid UnPrepare/Prepare
-  assert(qry.sql.Text<>'');
+  Assert(qry.sql.Text<>'');
   for x:=0 to Qry.Params.Count-1 do
     begin
     P:=Qry.Params[x];
@@ -1777,9 +1811,18 @@ begin
     Fld:=Query.FieldByName(S);
     ApplyFieldUpdate(Query.Cursor,P as TSQLDBParam,Fld,B);
     end;
+  if ReturningClause then
+    Qry.Open
+  else
     Qry.Execute;
   if (scoApplyUpdatesChecksRowsAffected in Options) and (Qry.RowsAffected<>1) then
+    begin
+    if ReturningClause then
+      Qry.Close;
     DatabaseErrorFmt(SErrFailedToUpdateRecord, [Qry.RowsAffected], Query);
+    end;
+  if ReturningClause then
+    Query.ApplyReturningResult(Qry,UpdateKind);
 end;
 
 function TSQLConnection.RefreshLastInsertID(Query: TCustomSQLQuery; Field: TField): Boolean;
@@ -2310,9 +2353,12 @@ function TCustomSQLQuery.NeedRefreshRecord(UpdateKind: TUpdateKind): Boolean;
 Var
   PF : TProviderFlag;
   I : Integer;
+  DoReturning : Boolean;
+
 begin
   Result:=(FRefreshSQL.Count<>0);
-  if Not Result then
+  DoReturning:=(sqSupportReturning in SQLConnection.ConnOptions) and not (sqoPreferRefresh in Options);
+  if Not (Result or DoReturning) then
     begin
     PF:=RefreshFlags[UpdateKind];
     I:=0;
@@ -2374,6 +2420,25 @@ begin
   end;
 end;
 
+procedure TCustomSQLQuery.ApplyReturningResult(Q: TCustomSQLQuery; UpdateKind : TUpdateKind);
+
+Var
+  S : TDataSetState;
+  refreshFlag  : TProviderFlag;
+  F : TField;
+
+begin
+  RefreshFlag:=RefreshFlags[UpdateKind];
+  S:=SetTempState(dsRefreshFields);
+  try
+    For F in Fields do
+      if RefreshFlag in F.ProviderFlags then
+        F.Assign(Q.FieldByName(F.FieldName));
+  finally
+    RestoreState(S);
+  end;
+end;
+
 procedure TCustomSQLQuery.ApplyFilter;
 
 begin

packages/fcl-db/tests/testsqldb.pas

@@ -54,6 +54,8 @@ type
     Procedure TestRefreshSQLNoRecords;
     Procedure TestFetchAutoInc;
     procedure TestSequence;
+    procedure TestReturningInsert;
+    procedure TestReturningUpdate;
   end;
 
   { TTestTSQLConnection }
@@ -198,7 +200,7 @@ begin
 
     Q := SQLDBConnector.Query;
     Q.SQL.Text:='select * from FPDEV2';
-    Q.Options:=[sqoKeepOpenOnCommit];
+    Q.Options:=[sqoKeepOpenOnCommit,sqoPreferRefresh];
     AssertEquals('PacketRecords forced to -1',-1,Q.PacketRecords);
     Q.Open;
     AssertEquals('Got all records',20,Q.RecordCount);
@@ -402,6 +404,7 @@ begin
       Transaction.Commit;
     end;
   Q:=SQLDBConnector.Query;
+  Q.OPtions:=Q.OPtions+[sqoPreferRefresh];
   Q.SQL.Text:='select * from FPDEV2';
   Q.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
   Q.RefreshSQL.Text:='SELECT a,b FROM FPDEV2 WHERE (id=:id)';
@@ -440,6 +443,7 @@ begin
   Q:=SQLDBConnector.Query;
   Q.SQL.Text:='select * from FPDEV2';
   Q.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
+  Q.OPtions:=Q.OPtions+[sqoPreferRefresh];
   Q.Open;
   With Q.FieldByName('id') do
     ProviderFlags:=ProviderFlags+[pfInKey];
@@ -471,6 +475,7 @@ begin
   Q:=SQLDBConnector.Query;
   Q.SQL.Text:='select * from FPDEV2';
   Q.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
+  Q.OPtions:=Q.OPtions+[sqoPreferRefresh];
   Q.Open;
   With Q.FieldByName('id') do
     ProviderFlags:=ProviderFlags+[pfInKey];
@@ -497,6 +502,7 @@ begin
   FMyQ:=SQLDBConnector.Query;
   FMyQ.SQL.Text:='select * from FPDEV2';
   FMyQ.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
+  FMyQ.OPtions:=FMyQ.OPtions+[sqoPreferRefresh];
   FMyQ.Open;
   With FMyQ.FieldByName('id') do
     ProviderFlags:=ProviderFlags-[pfInKey];
@@ -521,6 +527,7 @@ begin
       Transaction.Commit;
     end;
   FMyQ:=SQLDBConnector.Query;
+  FMyQ.OPtions:=FMyQ.OPtions+[sqoPreferRefresh];
   FMyQ.SQL.Text:='select * from FPDEV2';
   FMyQ.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
   FMyQ.RefreshSQL.Text:='select * from FPDEV2';
@@ -547,6 +554,7 @@ begin
       Transaction.Commit;
     end;
   FMyQ:=SQLDBConnector.Query;
+  FMyQ.OPtions:=FMyQ.OPtions+[sqoPreferRefresh];
   FMyQ.SQL.Text:='select * from FPDEV2';
   FMyQ.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
   FMyQ.RefreshSQL.Text:='select * from FPDEV2 where 1=2';
@@ -647,6 +655,68 @@ begin
   SQLDBConnector.CommitDDL;
 end;
 
+procedure TTestTSQLQuery.TestReturningInsert;
+
+begin
+  with SQLDBConnector do
+    begin
+    if not (sqSupportReturning in Connection.ConnOptions) then
+      Ignore(STestNotApplicable);
+    ExecuteDirect('create table FPDEV2 (id integer not null, a varchar(10) default ''abcde'', b varchar(5) default ''fgh'', constraint PK_FPDEV2 primary key(id))');
+    if Transaction.Active then
+      Transaction.Commit;
+    ExecuteDirect('insert into FPDEV2 (id) values (123)');
+    if Transaction.Active then
+      Transaction.Commit;
+    end;
+  FMyQ:=SQLDBConnector.Query;
+  FMyQ.SQL.Text:='select * from FPDEV2';
+//  FMyQ.InsertSQL.Text:='insert into FPDEV2 (id) values (:id)';
+  FMyQ.Open;
+  With FMyQ.FieldByName('id') do
+    ProviderFlags:=ProviderFlags+[pfInKey];
+  With FMyQ.FieldByName('a') do
+    ProviderFlags:=ProviderFlags+[pfRefreshOnInsert];
+  With FMyQ.FieldByName('b') do
+    ProviderFlags:=[];
+  FMyQ.Insert;
+  FMyQ.FieldByName('id').AsInteger:=1;
+  FMyQ.Post;
+  FMyQ.ApplyUpdates;
+  AssertEquals('a updated','abcde',FMyQ.FieldByName('a').AsString);
+  AssertEquals('b not updated','',FMyQ.FieldByName('b').AsString);
+end;
+
+procedure TTestTSQLQuery.TestReturningUpdate;
+
+begin
+  with SQLDBConnector do
+    begin
+    if not (sqSupportReturning in Connection.ConnOptions) then
+      Ignore(STestNotApplicable);
+    ExecuteDirect('create table FPDEV2 (id integer not null, a varchar(10) default ''abcde'', b varchar(5) default ''fgh'', constraint PK_FPDEV2 primary key(id))');
+    if Transaction.Active then
+      Transaction.Commit;
+    ExecuteDirect('insert into FPDEV2 (id) values (123)');
+    if Transaction.Active then
+      Transaction.Commit;
+    end;
+  FMyQ:=SQLDBConnector.Query;
+  FMyQ.SQL.Text:='select * from FPDEV2';
+  FMyQ.Open;
+  With FMyQ.FieldByName('id') do
+    ProviderFlags:=ProviderFlags+[pfInKey];
+  With FMyQ.FieldByName('b') do
+    ProviderFlags:=[pfRefreshOnUpdate];  // Do not update, just fetch new value
+  FMyQ.Edit;
+  FMyQ.FieldByName('a').AsString:='ccc';
+  FMyQ.Post;
+  SQLDBConnector.ExecuteDirect('update FPDEV2 set b=''123'' where id=123');
+  FMyQ.ApplyUpdates;
+  AssertEquals('a updated','ccc',FMyQ.FieldByName('a').AsString);
+  AssertEquals('b updated','123',FMyQ.FieldByName('b').AsString);
+end;
+
 
 { TTestTSQLConnection }