* Restructured the ApplyRecUpdates mechanism. Update-queries are only created when necessary and improved error messages. Readonly does not depend on ParseSQL anymore (mantis 9254) + test

git-svn-id: trunk@10926 -

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

@@ -88,8 +88,8 @@ Resourcestring
   SFieldIsNull             = 'The field is null';
   SOnUpdateError           = 'An error occured while applying the updates in a record: %s';
   SApplyRecNotSupported    = 'Applying updates is not supported by this TDataset descendent';
-  SNoWhereFields           = 'There are no fields found to generate the where-clause';
-  SNoUpdateFields          = 'There are no fields found to include in the update- or insert-clause';
+  SNoWhereFields           = 'No %s query specified and failed to generate one. (No fields for inclusion in where statement found)';
+  SNoUpdateFields          = 'No %s query specified and failed to generate one. (No fields found for insert- or update-statement found)';
   SNotSupported            = 'Operation is not supported by this type of database';
   SDBCreateDropFailed      = 'Creation or dropping of database failed';
   SMaxIndexes              = 'The maximum amount of indexes is reached';

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

@@ -293,9 +293,9 @@ type
     property Transaction;
     property ReadOnly : Boolean read FReadOnly write SetReadOnly;
     property SQL : TStringlist read FSQL write FSQL;
-    property UpdateSQL : TStringlist read FUpdateSQL write FUpdateSQL;
-    property InsertSQL : TStringlist read FInsertSQL write FInsertSQL;
-    property DeleteSQL : TStringlist read FDeleteSQL write FDeleteSQL;
+    property UpdateSQL : TStringlist read FUpdateSQL;
+    property InsertSQL : TStringlist read FInsertSQL;
+    property DeleteSQL : TStringlist read FDeleteSQL;
     property Params : TParams read FParams write FParams;
     property UpdateMode : TUpdateMode read FUpdateMode write SetUpdateMode;
     property UsePrimaryKeyAsKey : boolean read FUsePrimaryKeyAsKey write SetUsePrimaryKeyAsKey;
@@ -1157,20 +1157,6 @@ end;
 
 procedure TCustomSQLQuery.InternalOpen;
 
-  procedure InitialiseModifyQuery(var qry : TCustomSQLQuery; aSQL: TSTringList);
-  
-  begin
-    qry := TCustomSQLQuery.Create(nil);
-    with qry do
-      begin
-      ParseSQL := False;
-      DataBase := Self.DataBase;
-      Transaction := Self.Transaction;
-      SQL.Assign(aSQL);
-      end;
-  end;
-
-
 var tel, fieldc : integer;
     f           : TField;
     s           : string;
@@ -1213,12 +1199,11 @@ begin
         end
       else
         BindFields(True);
-      if FUpdateable then
+      if not ReadOnly and not FUpdateable then
         begin
-        InitialiseModifyQuery(FDeleteQry,FDeleteSQL);
-        InitialiseModifyQuery(FUpdateQry,FUpdateSQL);
-        InitialiseModifyQuery(FInsertQry,FInsertSQL);
-        end;
+        if (trim(FDeleteSQL.Text) <> '') or (trim(FUpdateSQL.Text) <> '') or
+           (trim(FInsertSQL.Text) <> '') then FUpdateable := True;
+        end
       end
     else
       DatabaseError(SErrNoSelectStatement,Self);
@@ -1290,12 +1275,7 @@ procedure TCustomSQLQuery.SetReadOnly(AValue : Boolean);
 
 begin
   CheckInactive;
-  if not AValue then
-    begin
-    if FParseSQL then FReadOnly := False
-      else DatabaseErrorFmt(SNoParseSQL,['Updating ']);
-    end
-  else FReadOnly := True;
+  FReadOnly:=AValue;
 end;
 
 procedure TCustomSQLQuery.SetParseSQL(AValue : Boolean);
@@ -1304,7 +1284,6 @@ begin
   CheckInactive;
   if not AValue then
     begin
-    FReadOnly := True;
     FServerFiltered := False;
     FParseSQL := False;
     end
@@ -1335,6 +1314,19 @@ Procedure TCustomSQLQuery.ApplyRecUpdate(UpdateKind : TUpdateKind);
 
 var FieldNamesQuoteChar : char;
 
+  procedure InitialiseModifyQuery(var qry : TCustomSQLQuery; aSQL: String);
+
+  begin
+    qry := TCustomSQLQuery.Create(nil);
+    with qry do
+      begin
+      ParseSQL := False;
+      DataBase := Self.DataBase;
+      Transaction := Self.Transaction;
+      SQL.text := aSQL;
+      end;
+  end;
+
   procedure UpdateWherePart(var sql_where : string;x : integer);
 
   begin
@@ -1361,9 +1353,9 @@ var FieldNamesQuoteChar : char;
         sql_set := sql_set +FieldNamesQuoteChar + fields[x].FieldName + FieldNamesQuoteChar +'=:' + fields[x].FieldName + ',';
       end;
 
-    if length(sql_set) = 0 then DatabaseError(sNoUpdateFields,self);
+    if length(sql_set) = 0 then DatabaseErrorFmt(sNoUpdateFields,['update'],self);
     setlength(sql_set,length(sql_set)-1);
-    if length(sql_where) = 0 then DatabaseError(sNoWhereFields,self);
+    if length(sql_where) = 0 then DatabaseErrorFmt(sNoWhereFields,['update'],self);
     setlength(sql_where,length(sql_where)-5);
     result := 'update ' + FTableName + ' set ' + sql_set + ' where ' + sql_where;
 
@@ -1386,7 +1378,7 @@ var FieldNamesQuoteChar : char;
         sql_values := sql_values + ':' + fields[x].FieldName + ',';
         end;
       end;
-    if length(sql_fields) = 0 then DatabaseError(sNoUpdateFields,self);
+    if length(sql_fields) = 0 then DatabaseErrorFmt(sNoUpdateFields,['insert'],self);
     setlength(sql_fields,length(sql_fields)-1);
     setlength(sql_values,length(sql_values)-1);
 
@@ -1403,7 +1395,7 @@ var FieldNamesQuoteChar : char;
     for x := 0 to Fields.Count -1 do
       UpdateWherePart(sql_where,x);
 
-    if length(sql_where) = 0 then DatabaseError(sNoWhereFields,self);
+    if length(sql_where) = 0 then DatabaseErrorFmt(sNoWhereFields,['delete'],self);
     setlength(sql_where,length(sql_where)-5);
 
     result := 'delete from ' + FTableName + ' where ' + sql_where;
@@ -1418,20 +1410,34 @@ begin
     FieldNamesQuoteChar := '"'
   else
     FieldNamesQuoteChar := ' ';
-    case UpdateKind of
-      ukModify : begin
-                 qry := FUpdateQry;
-                 if trim(qry.sql.Text) = '' then qry.SQL.Add(ModifyRecQuery);
-                 end;
-      ukInsert : begin
-                 qry := FInsertQry;
-                 if trim(qry.sql.Text) = '' then qry.SQL.Add(InsertRecQuery);
-                 end;
-      ukDelete : begin
-                 qry := FDeleteQry;
-                 if trim(qry.sql.Text) = '' then qry.SQL.Add(DeleteRecQuery);
+
+  case UpdateKind of
+    ukModify : begin
+               if not assigned(FUpdateQry) then
+                 begin
+                 if (trim(FUpdateSQL.Text)<> '') then
+                   InitialiseModifyQuery(FUpdateQry,FUpdateSQL.Text)
+                 else
+                   InitialiseModifyQuery(FUpdateQry,ModifyRecQuery);
                  end;
-    end;
+               qry := FUpdateQry;
+               end;
+    ukInsert : begin
+               if not assigned(FInsertQry) and (trim(FInsertSQL.Text)<> '') then
+                 InitialiseModifyQuery(FInsertQry,FInsertSQL.Text)
+               else
+                 InitialiseModifyQuery(FInsertQry,InsertRecQuery);
+               qry := FInsertQry;
+               end;
+    ukDelete : begin
+               if not assigned(FDeleteQry) and (trim(FDeleteSQL.Text)<> '') then
+                 InitialiseModifyQuery(FDeleteQry,FDeleteSQL.Text)
+               else
+                 InitialiseModifyQuery(FDeleteQry,DeleteRecQuery);
+               qry := FDeleteQry;
+               end;
+  end;
+  assert(qry.sql.Text<>'');
   with qry do
     begin
     for x := 0 to Params.Count-1 do with params[x] do if leftstr(name,4)='OLD_' then

packages/fcl-db/tests/testfieldtypes.pas

@@ -28,6 +28,7 @@ type
     procedure RunTest; override;
   published
     procedure TestClearUpdateableStatus;
+    procedure TestReadOnlyParseSQL; // bug 9254
     procedure TestParseJoins; // bug 10148
     procedure TestParseUnion; // bug 8442
     procedure TestInsertLargeStrFields; // bug 9600
@@ -894,6 +895,104 @@ begin
     end;
 end;
 
+procedure TTestFieldTypes.TestReadOnlyParseSQL;
+begin
+  with TSQLDBConnector(DBConnector) do
+    begin
+
+    GetFieldDataset(True);
+    with query do
+      begin
+      AssertFalse(ReadOnly);
+      AssertTrue(ParseSQL);
+
+      // If ParseSQL is false, and no update-queries are given, the query
+      // shouldn't be updateable after open.
+      ParseSQL := False;
+      AssertFalse(ParseSQL);
+      AssertFalse(ReadOnly);
+      SQL.Text := 'select * from FPDEV;';
+      open;
+      AssertFalse(ParseSQL);
+      AssertFalse(ReadOnly);
+      AssertFalse(CanModify);
+      close;
+
+      // If ParseSQL is true, the query should be updateable after open.
+      ReadOnly := False;
+      ParseSQL := True;
+      AssertTrue(ParseSQL);
+      AssertFalse(ReadOnly);
+      SQL.Text := 'select * from FPDEV;';
+      open;
+      AssertTrue(ParseSQL);
+      AssertFalse(ReadOnly);
+      AssertTrue(CanModify);
+      edit;
+      FieldByName('ID').AsInteger:=321;
+      post;
+      Applyupdates;
+      close;
+      
+      // If ParseSQL is true, but the supplied query isn't updateable, then
+      // the query shouldn't be updateable after open.
+      ReadOnly := False;
+      SQL.Text:='select ID,NAME from FPDEV where ID<5';
+      sql.Add('union');
+      sql.Add('select ID,NAME from FPDEV where ID>5');
+      AssertTrue(ParseSQL);
+      AssertFalse(ReadOnly);
+      open;
+      AssertTrue(ParseSQL);
+      AssertFalse(ReadOnly);
+      AssertFalse(CanModify);
+      close;
+
+      // As above, but now with an update-query, so that the query should
+      // be updateable again.
+      ReadOnly := False;
+      AssertTrue(ParseSQL);
+      AssertFalse(ReadOnly);
+      UpdateSQL.Text:='update FPDEV set ID=:ID where ID=:OLD_ID';
+      open;
+      AssertTrue(ParseSQL);
+      AssertFalse(ReadOnly);
+      AssertTrue(CanModify);
+      edit;
+      post;
+      Applyupdates;
+      close;
+
+      // Also if ParseSQL is False, the query should be updateable if a update-
+      // query is given.
+      ReadOnly := False;
+      ParseSQL := False;
+      AssertFalse(ParseSQL);
+      AssertFalse(ReadOnly);
+      open;
+      AssertFalse(ParseSQL);
+      AssertFalse(ReadOnly);
+      AssertTrue(CanModify);
+      edit;
+      FieldByName('ID').AsInteger:=1;
+      post;
+      Applyupdates;
+      close;
+
+      // But if ReadOnly is true, then CanModify should always be false
+      ReadOnly := True;
+      ParseSQL := False;
+      AssertFalse(ParseSQL);
+      AssertTrue(ReadOnly);
+      open;
+      AssertFalse(ParseSQL);
+      AssertTrue(ReadOnly);
+      AssertFalse(CanModify);
+      close;
+      end;
+    end;
+end;
+
 procedure TTestFieldTypes.TestParseJoins;
 begin
   with TSQLDBConnector(DBConnector) do