fcl-db: base: improve Blob handling. When writting empty blob set null on. raise data event FieldChange after data are written, not before.

git-svn-id: trunk@25411 -

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

@@ -41,15 +41,18 @@ type
 
   TBufBlobStream = class(TStream)
   private
+    FField      : TBlobField;
+    FDataSet    : TCustomBufDataset;
     FBlobBuffer : PBlobBuffer;
     FPosition   : ptrint;
-    FDataset    : TCustomBufDataset;
+    FModified   : boolean;
   protected
+    function Seek(Offset: Longint; Origin: Word): Longint; override;
     function Read(var Buffer; Count: Longint): Longint; override;
     function Write(const Buffer; Count: Longint): Longint; override;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
   public
     constructor Create(Field: TBlobField; Mode: TBlobStreamMode);
+    destructor Destroy; override;
   end;
 
   { TCustomBufDataset }
@@ -2330,11 +2333,14 @@ begin
     ABuff := ActiveBuffer;
     NullMask := PByte(ABuff);
 
-    inc(ABuff,FFieldBufPositions[FUpdateBlobBuffers[i]^.FieldNo-1]);
+    inc(ABuff,FFieldBufPositions[blobbuf.BlobBuffer^.FieldNo-1]);
-    Move(blobbuf, ABuff^, GetFieldSize(FieldDefs[FUpdateBlobBuffers[i]^.FieldNo-1]));
+    Move(blobbuf, ABuff^, GetFieldSize(FieldDefs[blobbuf.BlobBuffer^.FieldNo-1]));
-    unSetFieldIsNull(NullMask,FUpdateBlobBuffers[i]^.FieldNo-1);
+    if blobbuf.BlobBuffer^.Size = 0 then
+      SetFieldIsNull(NullMask, blobbuf.BlobBuffer^.FieldNo-1)
+    else
+      unSetFieldIsNull(NullMask, blobbuf.BlobBuffer^.FieldNo-1);
     
-    FUpdateBlobBuffers[i]^.FieldNo := -1;
+    blobbuf.BlobBuffer^.FieldNo := -1;
     end;
 
   if State = dsInsert then
@@ -2582,6 +2588,8 @@ begin
   ABlobBuffer := Nil;
 end;
 
+{ TBufBlobStream }
+
 function TBufBlobStream.Seek(Offset: Longint; Origin: Word): Longint;
 
 begin
@@ -2617,6 +2625,7 @@ begin
   move(buffer,ptr^,count);
   inc(FBlobBuffer^.Size,count);
   inc(FPosition,count);
+  FModified := True;
   Result := count;
 end;
 
@@ -2625,12 +2634,14 @@ constructor TBufBlobStream.Create(Field: TBlobField; Mode: TBlobStreamMode);
 var bufblob : TBufBlobField;
 
 begin
-  FDataset := Field.DataSet as TCustomBufDataset;
+  FField := Field;
+  FDataSet := Field.DataSet as TCustomBufDataset;
+  with FDataSet do
     if Mode = bmRead then
       begin
       if not Field.GetData(@bufblob) then
         DatabaseError(SFieldIsNull);
-    if not assigned(bufblob.BlobBuffer) then with FDataSet do
+      if not assigned(bufblob.BlobBuffer) then
         begin
         FBlobBuffer := GetNewBlobBuffer;
         bufblob.BlobBuffer := FBlobBuffer;
@@ -2639,7 +2650,7 @@ begin
       else
         FBlobBuffer := bufblob.BlobBuffer;
       end
-  else if Mode=bmWrite then with FDataSet as TCustomBufDataset do
+    else if Mode=bmWrite then
       begin
       FBlobBuffer := GetNewWriteBlobBuffer;
       FBlobBuffer^.FieldNo := Field.FieldNo;
@@ -2647,9 +2658,24 @@ begin
         FBlobBuffer^.OrgBufID := bufblob.BlobBuffer^.OrgBufID
       else
         FBlobBuffer^.OrgBufID := -1;
+      FModified := True;
       end;
 end;
 
+destructor TBufBlobStream.Destroy;
+begin
+  if FModified then
+    begin
+    // if TBufBlobStream was requested, but no data was written, then Size = 0;
+    //  used by TBlobField.Clear, so in this case set Field to null in InternalPost
+    //FField.Modified := True; // should be set to True, but TBlobField.Modified is never reset
+
+    if not (FDataSet.State in [dsFilter, dsCalcFields, dsNewValue]) then
+      FDataSet.DataEvent(deFieldChange, Ptrint(FField));
+    end;
+  inherited Destroy;
+end;
+
 function TCustomBufDataset.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
 
 var bufblob : TBufBlobField;
@@ -2669,9 +2695,6 @@ begin
       DatabaseErrorFmt(SNotEditing,[Name],self);
 
     result := TBufBlobStream.Create(Field as TBlobField, bmWrite);
-
-    if not (State in [dsCalcFields, dsFilter, dsNewValue]) then
-      DataEvent(deFieldChange, Ptrint(Field));
     end;
 end;
 

packages/fcl-db/src/base/fields.inc

@@ -2928,7 +2928,7 @@ end;
 procedure TBlobField.Clear;
 
 begin
-  GetBlobStream(bmWrite).free;
+  GetBlobStream(bmWrite).Free;
 end;
 
 

packages/fcl-db/tests/testbufdatasetstreams.pas

@@ -7,7 +7,7 @@ unit TestBufDatasetStreams;
 interface
 
 uses
-  fpcunit, testutils, testregistry, testdecorator,
+  fpcunit, testregistry,
   Classes, SysUtils, db, BufDataset;
 
 type
@@ -71,6 +71,7 @@ type
     procedure TestDeleteAllInsertXML;
     procedure TestStreamingBlobFieldsXML;
     procedure TestStreamingBigBlobFieldsXML;
+    procedure TestStreamingNullFieldsXML;
     procedure TestStreamingCalculatedFieldsXML;
 
     procedure TestAppendDeleteBIN;
@@ -473,8 +474,8 @@ begin
   SaveDS.First;
   while not LoadDS.EOF do
     begin
-    AssertEquals(LoadDS.FieldByName('FBLOB').AsString,SaveDS.FieldByName('FBLOB').AsString);
+    AssertEquals(SaveDS.FieldByName('FBLOB').AsString, LoadDS.FieldByName('FBLOB').AsString);
-    AssertEquals(LoadDS.FieldByName('FMEMO').AsString,SaveDS.FieldByName('FMEMO').AsString);
+    AssertEquals(SaveDS.FieldByName('FMEMO').AsString, LoadDS.FieldByName('FMEMO').AsString);
     LoadDS.Next;
     SaveDS.Next;
     end;
@@ -547,6 +548,44 @@ begin
   end;
 end;
 
+procedure TTestBufDatasetStreams.TestStreamingNullFieldsXML;
+var
+  SaveDs: TCustomBufDataset;
+  LoadDs: TCustomBufDataset;
+  i: integer;
+begin
+  SaveDs := DBConnector.GetFieldDataset(true) as TCustomBufDataset;
+  with SaveDs do
+    begin
+    Open;
+    Next;
+    Edit;
+    // set all fields to null
+    for i:=0 to FieldCount-1 do
+      Fields[i].Clear;
+    Post;
+    // check if they are null
+    for i:=0 to FieldCount-1 do
+      AssertTrue(Fields[i].FieldName, Fields[i].IsNull);
+    SaveToFile(TestXMLFileName, dfXML);
+    end;
+
+  LoadDs := TCustomBufDataset.Create(nil);
+  try
+    LoadDs.LoadFromFile(TestXMLFileName);
+    SaveDs.First;
+    while not SaveDs.EOF do
+      begin
+      for i:=0 to SaveDs.FieldCount-1 do
+        AssertEquals(SaveDs.Fields[i].FieldName, SaveDs.Fields[i].IsNull, LoadDs.Fields[i].IsNull);
+      LoadDs.Next;
+      SaveDs.Next;
+      end;
+  finally
+    LoadDs.Free;
+  end;
+end;
+
 procedure TTestBufDatasetStreams.TestStreamingCalculatedFieldsXML;
 var
   ADataset: TCustomBufDataset;