* Close a TBufDataset on destroy

 * Always use GetCurrentBuffer in TBufDataset.SetFieldData, the old exception for the dsFilter state is not valid anymore
 * Do not pass an AUpdOrder to StoreRecord when there is no update at all
 * When saving the dataset to file, store not only the complete buffer, but also check if there are still records waiting to be fetched
 * Clean up of obsolete code
 * Added comments
 * Updated TXMLDatapacketReader to the new method of storing/loading records from stream

git-svn-id: trunk@12173 -

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

@@ -286,22 +286,9 @@ type
   { TBufDatasetReader }
 
 type
-  TChangeLogInfo = record
-       FirstChangeNode : pointer;
-       SecondChangeNode : pointer;
-       Bookmark   : TBufBookmark;
-  end;
-  TChangeLogEntry = record
-       UpdateKind : TUpdateKind;
-       OrigEntry  : integer;
-       NewEntry   : integer;
-  end;
-  TChangeLogInfoArr = array of TChangeLogInfo;
-  TChangeLogEntryArr = array of TChangeLogEntry;
   TRowStateValue = (rsvOriginal, rsvDeleted, rsvInserted, rsvUpdated, rsvDetailUpdates);
   TRowState = set of TRowStateValue;
 
-
 type
 
   { TDataPacketReader }
@@ -314,18 +301,28 @@ type
     class function ByteToRowState(const AByte : Byte) : TRowState;
   public
     constructor create(AStream : TStream); virtual;
-
+    // Load a dataset from stream:
+    // Load the field-definitions from a stream.
     procedure LoadFieldDefs(AFieldDefs : TFieldDefs); virtual; abstract;
-    procedure StoreFieldDefs(AFieldDefs : TFieldDefs); virtual; abstract;
+    // Is called before the records are loaded
+    procedure InitLoadRecords; virtual; abstract;
+    // Return the RowState of the current record, and the order of the update
     function GetRecordRowState(out AUpdOrder : Integer) : TRowState; virtual; abstract;
-    procedure EndStoreRecord; virtual; abstract;
+    // Returns if there is at least one more record available in the stream
     function GetCurrentRecord : boolean; virtual; abstract;
-    procedure GotoNextRecord; virtual; abstract;
-    function GetCurrentElement : pointer; virtual; abstract;
-    procedure GotoElement(const AnElement : pointer); virtual; abstract;
+    // Store a record from stream in the current record-buffer
     procedure RestoreRecord(ADataset : TBufDataset); virtual; abstract;
+    // Move the stream to the next record
+    procedure GotoNextRecord; virtual; abstract;
+
+    // Store a dataset to stream:
+    // Save the field-definitions to a stream.
+    procedure StoreFieldDefs(AFieldDefs : TFieldDefs); virtual; abstract;
+    // Save a record from the current record-buffer to the stream
     procedure StoreRecord(ADataset : TBufDataset; ARowState : TRowState; AUpdOrder : integer = 0); virtual; abstract;
-    procedure InitLoadRecords; virtual; abstract;
+    // Is called after all records are stored
+    procedure FinalizeStoreRecords; virtual; abstract;
+    // Checks if the provided stream is of the right format for this class
     class function RecognizeStream(AStream : TStream) : boolean; virtual; abstract;
     property Stream: TStream read FStream;
   end;
@@ -337,12 +334,10 @@ type
     procedure LoadFieldDefs(AFieldDefs : TFieldDefs); override;
     procedure StoreFieldDefs(AFieldDefs : TFieldDefs); override;
     function GetRecordRowState(out AUpdOrder : Integer) : TRowState; override;
-    procedure EndStoreRecord; override;
+    procedure FinalizeStoreRecords; override;
     function GetCurrentRecord : boolean; override;
     procedure GotoNextRecord; override;
-    procedure GotoElement(const AnElement : pointer); override;
     procedure InitLoadRecords; override;
-    function GetCurrentElement: pointer; override;
     procedure RestoreRecord(ADataset : TBufDataset); override;
     procedure StoreRecord(ADataset : TBufDataset; ARowState : TRowState; AUpdOrder : integer = 0); override;
     class function RecognizeStream(AStream : TStream) : boolean; override;
@@ -659,6 +654,7 @@ destructor TBufDataset.Destroy;
 Var
   I : Integer;
 begin
+  if Active then Close;
   SetLength(FUpdateBuffer,0);
   SetLength(FBlobBuffers,0);
   SetLength(FUpdateBlobBuffers,0);
@@ -1675,11 +1671,7 @@ begin
     DatabaseErrorFmt(SNotEditing,[Name],self);
     exit;
     end;
-  if state = dsFilter then  // Set the value into the 'temporary' FLastRecBuf buffer for Locate and Lookup
-    with FCurrentIndex do
-      CurrBuff := SpareBuffer
-  else
-    CurrBuff := GetCurrentBuffer;
+  CurrBuff := GetCurrentBuffer;
   If Field.Fieldno > 0 then // If = 0, then calculated field or something
     begin
     NullMask := CurrBuff;
@@ -2353,8 +2345,6 @@ begin
     ABookMark:=@ATBookmark;
     FDatasetReader.StoreFieldDefs(FieldDefs);
 
-    EntryNr:=1;
-
     StoreDSState:=State;
     SetTempState(dsFilter);
     ScrollResult:=FCurrentIndex.ScrollFirst;
@@ -2390,14 +2380,21 @@ begin
       else
         RowState:=[];
       FFilterBuffer:=FCurrentIndex.CurrentBuffer;
-      FDatasetReader.StoreRecord(Self,RowState,FCurrentUpdateBuffer);
+      if RowState=[] then
+        FDatasetReader.StoreRecord(Self,[])
+      else
+        FDatasetReader.StoreRecord(Self,RowState,FCurrentUpdateBuffer);
 
-      inc(EntryNr);
       ScrollResult:=FCurrentIndex.ScrollForward;
+      if ScrollResult<>grOK then
+        begin
+        if getnextpacket>0 then
+          ScrollResult := FCurrentIndex.ScrollForward;
+        end;
       end;
     RestoreState(StoreDSState);
 
-    FDatasetReader.EndStoreRecord;
+    FDatasetReader.FinalizeStoreRecords;
   finally
     FDatasetReader := nil;
   end;
@@ -2477,14 +2474,12 @@ end;
 procedure TBufDataset.IntLoadRecordsFromFile;
 
 var StoreState      : TDataSetState;
-    EntryNr         : integer;
     AddRecordBuffer : boolean;
     ARowState       : TRowState;
     AUpdOrder       : integer;
 
 begin
   FDatasetReader.InitLoadRecords;
-  EntryNr:=1;
   StoreState:=SetTempState(dsFilter);
 
   while FDatasetReader.GetCurrentRecord do
@@ -2553,7 +2548,6 @@ begin
       end;
 
     FDatasetReader.GotoNextRecord;
-    inc(EntryNr);
     end;
 
   RestoreState(StoreState);
@@ -3070,7 +3064,7 @@ begin
     AUpdOrder := 0;
 end;
 
-procedure TFpcBinaryDatapacketReader.EndStoreRecord;
+procedure TFpcBinaryDatapacketReader.FinalizeStoreRecords;
 begin
 //  Do nothing
 end;
@@ -3086,21 +3080,11 @@ begin
 //  Do Nothing
 end;
 
-procedure TFpcBinaryDatapacketReader.GotoElement(const AnElement: pointer);
-begin
-//  Do nothing
-end;
-
 procedure TFpcBinaryDatapacketReader.InitLoadRecords;
 begin
 //  SetLength(AChangeLog,0);
 end;
 
-function TFpcBinaryDatapacketReader.GetCurrentElement: pointer;
-begin
-//  Do nothing
-end;
-
 procedure TFpcBinaryDatapacketReader.RestoreRecord(ADataset: TBufDataset);
 begin
   Stream.ReadBuffer(ADataset.GetCurrentBuffer^,ADataset.FRecordSize);

packages/fcl-db/src/base/xmldatapacketreader.pp

@@ -23,6 +23,14 @@ interface
 uses
   Classes, SysUtils, Bufdataset, dom, db;
 
+type
+  TChangeLogEntry = record
+       UpdateKind : TUpdateKind;
+       OrigEntry  : integer;
+       NewEntry   : integer;
+  end;
+  TChangeLogEntryArr = array of TChangeLogEntry;
+
 type
   { TXMLDatapacketReader }
 
@@ -34,21 +42,21 @@ type
     FChangeLogNode,
     FParamsNode,
     FRowDataNode,
-    FRecordNode       : TDOMNode;
+    FRecordNode    : TDOMNode;
+    FChangeLog     : TChangeLogEntryArr;
+    FEntryNr       : integer;
+    FLastChange    : integer;
   public
     destructor destroy; override;
-    procedure LoadFieldDefs(AFieldDefs : TFieldDefs); override;
     procedure StoreFieldDefs(AFieldDefs : TFieldDefs); override;
-    procedure GetRecordUpdState(var AIsUpdate, AAddRecordBuffer,
-                     AIsFirstEntry: boolean); override;
-    procedure EndStoreRecord(const AChangeLog : TChangeLogEntryArr); override;
+    procedure StoreRecord(ADataset : TBufDataset; ARowState : TRowState; AUpdOrder : integer = 0); override;
+    procedure FinalizeStoreRecords; override;
+    procedure LoadFieldDefs(AFieldDefs : TFieldDefs); override;
+    procedure InitLoadRecords; override;
     function GetCurrentRecord : boolean; override;
-    procedure GotoNextRecord; override;
-    procedure GotoElement(const AnElement : pointer); override;
-    procedure InitLoadRecords(var AChangeLog : TChangeLogEntryArr); override;
-    function GetCurrentElement: pointer; override;
+    function GetRecordRowState(out AUpdOrder : Integer) : TRowState; override;
     procedure RestoreRecord(ADataset : TBufDataset); override;
-    procedure StoreRecord(ADataset : TBufDataset; RowState : TRowState); override;
+    procedure GotoNextRecord; override;
     class function RecognizeStream(AStream : TStream) : boolean; override;
   end;
 
@@ -101,6 +109,9 @@ const
       ''
     );
 
+resourcestring
+  sUnknownXMLDatasetFormat = 'Unknown XML Dataset format';
+
 { TXMLDatapacketReader }
 
 destructor TXMLDatapacketReader.destroy;
@@ -131,13 +142,13 @@ var i           : integer;
 begin
   ReadXMLFile(XMLDocument,Stream);
   DataPacketNode := XMLDocument.FindNode('DATAPACKET') as TDOMElement;
-  if not assigned(DataPacketNode) then DatabaseError('Onbekend formaat');
+  if not assigned(DataPacketNode) then DatabaseError(sUnknownXMLDatasetFormat);
 
   MetaDataNode := DataPacketNode.FindNode('METADATA');
-  if not assigned(MetaDataNode) then DatabaseError('Onbekend formaat');
+  if not assigned(MetaDataNode) then DatabaseError(sUnknownXMLDatasetFormat);
 
   FieldsNode := MetaDataNode.FindNode('FIELDS');
-  if not assigned(FieldsNode) then DatabaseError('Onbekend formaat');
+  if not assigned(FieldsNode) then DatabaseError(sUnknownXMLDatasetFormat);
 
   with FieldsNode.ChildNodes do for i := 0 to Count - 1 do
     begin
@@ -166,7 +177,6 @@ begin
 
   FRowDataNode := DataPacketNode.FindNode('ROWDATA');
   FRecordNode := nil;
-
 end;
 
 procedure TXMLDatapacketReader.StoreFieldDefs(AFieldDefs: TFieldDefs);
@@ -214,43 +224,24 @@ begin
   MetaDataNode.AppendChild(FParamsNode);
   DataPacketNode.AppendChild(MetaDataNode);
   FRowDataNode := XMLDocument.CreateElement('ROWDATA');
+  setlength(FChangeLog,0);
+  FEntryNr:=0;
+  FLastChange:=-1;
 end;
 
-procedure TXMLDatapacketReader.GetRecordUpdState(var AIsUpdate,
-  AAddRecordBuffer, AIsFirstEntry: boolean);
-var ARowStateNode  : TDOmNode;
-    ARowState      : integer;
-
-begin
-  ARowStateNode := FRecordNode.Attributes.GetNamedItem('RowState');
-  if ARowStateNode = nil then // This item is not edited
-    begin
-    AIsUpdate:=False;
-    AAddRecordBuffer:=True;
-    end
-  else
-    begin
-    AIsUpdate:=True;
-    ARowState:=StrToIntDef(ARowStateNode.NodeValue,0);
-    AAddRecordBuffer:=((ARowState and 5) = 4)      // This item contains an inserted record which is not edited afterwards
-                      or ((ARowState and 9) = 8); // This item contains the last edited record
-    AIsFirstEntry:=((ARowState and 2) = 2)         // This item is deleted
-                 or ((ARowState and 8) = 8)       // This item is a change
-    end;
-end;
-
-procedure TXMLDatapacketReader.EndStoreRecord(const AChangeLog : TChangeLogEntryArr);
+procedure TXMLDatapacketReader.FinalizeStoreRecords;
 var ChangeLogStr : String;
     i            : integer;
 begin
   ChangeLogStr:='';
-  for i := 0 to length(AChangeLog) -1 do with AChangeLog[i] do
+  for i := 0 to length(FChangeLog)-1 do with FChangeLog[i] do
     begin
     ChangeLogStr:=ChangeLogStr+' '+inttostr(NewEntry)+' '+inttostr(OrigEntry)+' ';
     if UpdateKind=ukModify then ChangeLogStr := ChangeLogStr+'8';
     if UpdateKind=ukInsert then ChangeLogStr := ChangeLogStr+'4';
     if UpdateKind=ukDelete then ChangeLogStr := ChangeLogStr+'2';
     end;
+  setlength(FChangeLog,0);
 
   if ChangeLogStr<>'' then
     (FParamsNode as TDomElement).SetAttribute('CHANGE_LOG',Trim(ChangeLogStr));
@@ -266,8 +257,35 @@ begin
   Result := assigned(FRecordNode);
 end;
 
-procedure TXMLDatapacketReader.InitLoadRecords(
-  var AChangeLog: TChangeLogEntryArr);
+function TXMLDatapacketReader.GetRecordRowState(out AUpdOrder: Integer
+  ): TRowState;
+var ARowStateNode  : TDOmNode;
+    ARowState      : integer;
+    i              : integer;
+begin
+  ARowStateNode := FRecordNode.Attributes.GetNamedItem('RowState');
+  if ARowStateNode = nil then // This item is not edited
+    Result := []
+  else
+    begin
+    Result := ByteToRowState(StrToIntDef(ARowStateNode.NodeValue,0));
+    if Result = [rsvOriginal] then
+      begin
+      for i := 0 to length(FChangeLog)-1 do
+        if FChangeLog[i].NewEntry=FEntryNr then break;
+      assert(FChangeLog[i].NewEntry=FEntryNr);
+      end
+    else
+      begin
+      for i := 0 to length(FChangeLog)-1 do
+        if FChangeLog[i].OrigEntry=FEntryNr then break;
+      assert(FChangeLog[i].OrigEntry=FEntryNr);
+      end;
+    AUpdOrder:=i;
+    end;
+end;
+
+procedure TXMLDatapacketReader.InitLoadRecords;
 
 var ChangeLogStr : String;
     i,cp         : integer;
@@ -275,6 +293,8 @@ var ChangeLogStr : String;
 
 begin
   FRecordNode := FRowDataNode.FirstChild;
+  FEntryNr := 1;
+  setlength(FChangeLog,0);
   if assigned(FChangeLogNode) then
     ChangeLogStr:=FChangeLogNode.NodeValue
   else
@@ -289,17 +309,17 @@ begin
       begin
       case (cp mod 3) of
         0 : begin
-            SetLength(AChangeLog,length(AChangeLog)+1);
-            AChangeLog[cp div 3].OrigEntry:=StrToIntDef(ps,0);
+            SetLength(FChangeLog,length(FChangeLog)+1);
+            FChangeLog[cp div 3].OrigEntry:=StrToIntDef(ps,0);
             end;
-        1 : AChangeLog[cp div 3].NewEntry:=StrToIntDef(ps,0);
+        1 : FChangeLog[cp div 3].NewEntry:=StrToIntDef(ps,0);
         2 : begin
             if ps = '2' then
-              AChangeLog[cp div 3].UpdateKind:=ukDelete
+              FChangeLog[cp div 3].UpdateKind:=ukDelete
             else if ps = '4' then
-              AChangeLog[cp div 3].UpdateKind:=ukInsert
+              FChangeLog[cp div 3].UpdateKind:=ukInsert
             else if ps = '8' then
-              AChangeLog[cp div 3].UpdateKind:=ukModify;
+              FChangeLog[cp div 3].UpdateKind:=ukModify;
             end;
       end; {case}
       ps := '';
@@ -308,11 +328,6 @@ begin
     end;
 end;
 
-function TXMLDatapacketReader.GetCurrentElement: pointer;
-begin
-  Result:=FRecordNode;
-end;
-
 procedure TXMLDatapacketReader.RestoreRecord(ADataset : TBufDataset);
 var FieldNr    : integer;
     AFieldNode : TDomNode;
@@ -322,29 +337,37 @@ begin
     AFieldNode := FRecordNode.Attributes.GetNamedItem(Fields[FieldNr].FieldName);
     if assigned(AFieldNode) then
       begin
-      Fields[FieldNr].AsString := AFieldNode.NodeValue;  // set it to the sparebuf
+      Fields[FieldNr].AsString := AFieldNode.NodeValue;  // set it to the filterbuffer
       end
     end;
 end;
 
-procedure TXMLDatapacketReader.StoreRecord(ADataset: TBufDataset;
-  RowState: TRowState);
+procedure TXMLDatapacketReader.StoreRecord(ADataset : TBufDataset; ARowState : TRowState; AUpdOrder : integer = 0);
 var FieldNr : Integer;
-    RowStateInt : Integer;
     ARecordNode : TDOMElement;
 begin
+  inc(FEntryNr);
   ARecordNode := XMLDocument.CreateElement('ROW');
   for FieldNr := 0 to ADataset.Fields.Count-1 do
     begin
     ARecordNode.SetAttribute(ADataset.fields[FieldNr].FieldName,ADataset.fields[FieldNr].AsString);
     end;
-  RowStateInt:=0;
-  if rsvOriginal in RowState then RowStateInt := RowStateInt+1;
-  if rsvInserted in RowState then RowStateInt := RowStateInt+4;
-  if rsvUpdated in RowState then RowStateInt := RowStateInt+8;
-  RowStateInt:=integer(RowState);
-  if RowStateInt<>0 then
-    ARecordNode.SetAttribute('RowState',inttostr(RowStateInt));
+  if ARowState<>[] then
+    begin
+    ARecordNode.SetAttribute('RowState',inttostr(RowStateToByte(ARowState)));
+    if AUpdOrder>=length(FChangeLog) then
+      setlength(FChangeLog,AUpdOrder+1);
+    if (rsvOriginal in ARowState) or (rsvDeleted in ARowState) then
+      FChangeLog[AUpdOrder].OrigEntry:=FEntryNr;
+    if (rsvDeleted in ARowState) or (rsvUpdated in ARowState) or (rsvInserted in ARowState) then
+      FChangeLog[AUpdOrder].NewEntry:=FEntryNr;
+    if ARowState=[rsvUpdated] then
+      FChangeLog[AUpdOrder].UpdateKind := ukModify;
+    if ARowState=[rsvInserted] then
+      FChangeLog[AUpdOrder].UpdateKind := ukInsert;
+    if ARowState=[rsvDeleted] then
+      FChangeLog[AUpdOrder].UpdateKind := ukDelete;
+    end;
   FRowDataNode.AppendChild(ARecordNode);
 end;
 
@@ -365,15 +388,11 @@ end;
 procedure TXMLDatapacketReader.GotoNextRecord;
 begin
   FRecordNode := FRecordNode.NextSibling;
+  inc(FEntryNr);
   while assigned(FRecordNode) and (FRecordNode.CompareName('ROW')<>0) do
     FRecordNode := FRecordNode.NextSibling;
 end;
 
-procedure TXMLDatapacketReader.GotoElement(const AnElement: pointer);
-begin
-  FRecordNode:=TDomNode(AnElement);
-end;
-
 initialization
   RegisterDatapacketReader(TXMLDatapacketReader,dfXML);
 end.