* Rework default file mechanism in bufdataset to fix bug #34435

git-svn-id: trunk@43643 -

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

@@ -353,7 +353,7 @@ type
 
   { TDataPacketReader }
 
-  TDataPacketFormat = (dfBinary,dfXML,dfXMLUTF8,dfAny);
+  TDataPacketFormat = (dfBinary,dfXML,dfXMLUTF8,dfAny,dfDefault);
 
   TDatapacketReaderClass = class of TDatapacketReader;
   TDataPacketReader = class(TObject)
@@ -564,6 +564,9 @@ type
     Property BufIndexes[Aindex : Integer] : TBufIndex Read GetBufIndex;
   protected
     // abstract & virtual methods of TDataset
+    class function DefaultReadFileFormat : TDataPacketFormat; virtual;
+    class function DefaultWriteFileFormat : TDataPacketFormat; virtual;
+    class function DefaultPacketClass : TDataPacketReaderClass ; virtual;
     procedure SetPacketRecords(aValue : integer); virtual;
     procedure SetRecNo(Value: Longint); override;
     function  GetRecNo: Longint; override;
@@ -640,9 +643,9 @@ type
 
     procedure SetDatasetPacket(AReader : TDataPacketReader);
     procedure GetDatasetPacket(AWriter : TDataPacketReader);
-    procedure LoadFromStream(AStream : TStream; Format: TDataPacketFormat = dfAny);
+    procedure LoadFromStream(AStream : TStream; Format: TDataPacketFormat = dfDefault);
     procedure SaveToStream(AStream : TStream; Format: TDataPacketFormat = dfBinary);
-    procedure LoadFromFile(AFileName: string = ''; Format: TDataPacketFormat = dfAny);
+    procedure LoadFromFile(AFileName: string = ''; Format: TDataPacketFormat = dfDefault);
     procedure SaveToFile(AFileName: string = ''; Format: TDataPacketFormat = dfBinary);
     procedure CreateDataset;
     Procedure Clear; // Will close and remove all field definitions.
@@ -738,17 +741,18 @@ var
 
 begin
   Result := False;
-  for i := 0 to length(RegisteredDatapacketReaders)-1 do if ((AFormat=dfAny) or (AFormat=RegisteredDatapacketReaders[i].Format)) then
+  for i := 0 to length(RegisteredDatapacketReaders)-1 do
-    begin
+    if ((AFormat=dfAny) or (AFormat=RegisteredDatapacketReaders[i].Format)) then
-    if (AStream=nil) or (RegisteredDatapacketReaders[i].ReaderClass.RecognizeStream(AStream)) then
       begin
-      ADataReaderClass := RegisteredDatapacketReaders[i];
+      if (AStream=nil) or (RegisteredDatapacketReaders[i].ReaderClass.RecognizeStream(AStream)) then
-      Result := True;
+        begin
-      if (AStream <> nil) then AStream.Seek(0,soFromBeginning);
+        ADataReaderClass := RegisteredDatapacketReaders[i];
-      break;
+        Result := True;
+        if (AStream <> nil) then AStream.Seek(0,soFromBeginning);
+        break;
+        end;
+      AStream.Seek(0,soFromBeginning);
       end;
-    AStream.Seek(0,soFromBeginning);
-    end;
 end;
 
 function DBCompareText(subValue, aValue: pointer; size: integer; options: TLocateOptions): LargeInt;
@@ -1431,8 +1435,8 @@ end;
 procedure TCustomBufDataset.DoBeforeClose;
 begin
   inherited DoBeforeClose;
-  if FFileName<>'' then
+  if (FFileName<>'') then
-    SaveToFile(FFileName);
+    SaveToFile(FFileName,dfDefault);
 end;
 
 procedure TCustomBufDataset.InternalClose;
@@ -2258,6 +2262,22 @@ begin
       FMaxIndexesCount:=FIndexes.Count+2; // Custom+Default order
 end;
 
+class function TCustomBufDataset.DefaultReadFileFormat: TDataPacketFormat;
+begin
+  Result:=dfAny;
+end;
+
+class function TCustomBufDataset.DefaultWriteFileFormat: TDataPacketFormat;
+begin
+  Result:=dfBinary;
+end;
+
+class function TCustomBufDataset.DefaultPacketClass: TDataPacketReaderClass;
+begin
+  Result:=TFpcBinaryDatapacketReader;
+end;
+
+
 procedure TCustomBufDataset.SetIndexFieldNames(const AValue: String);
 
 begin
@@ -3056,11 +3076,17 @@ end;
 
 function TCustomBufDataset.GetPacketReader(const Format: TDataPacketFormat; const AStream: TStream): TDataPacketReader;
 
-var APacketReader: TDataPacketReader;
+var
-    APacketReaderReg: TDatapacketReaderRegistration;
+  APacketReader: TDataPacketReader;
-
+  APacketReaderReg: TDatapacketReaderRegistration;
+  Fmt : TDataPacketFormat;
 begin
-  if GetRegisterDatapacketReader(AStream, format, APacketReaderReg) then
+  fmt:=Format;
+  if (Fmt=dfDefault) then
+    fmt:=DefaultReadFileFormat;
+  if fmt=dfDefault then
+    APacketReader := DefaultPacketClass.Create(Self, AStream)
+  else if GetRegisterDatapacketReader(AStream, fmt, APacketReaderReg) then
     APacketReader := APacketReaderReg.ReaderClass.Create(Self, AStream)
   else if TFpcBinaryDatapacketReader.RecognizeStream(AStream) then
     begin
@@ -3433,11 +3459,17 @@ end;
 procedure TCustomBufDataset.SaveToStream(AStream: TStream; Format: TDataPacketFormat);
 var APacketReaderReg : TDatapacketReaderRegistration;
     APacketWriter : TDataPacketReader;
+    Fmt : TDataPacketFormat;
 begin
   CheckBiDirectional;
-  if GetRegisterDatapacketReader(Nil,format,APacketReaderReg) then
+  fmt:=Format;
+  if Fmt=dfDefault then
+    fmt:=DefaultWriteFileFormat;
+  if fmt=dfDefault then
+    APacketWriter := DefaultPacketClass.Create(Self, AStream)
+  else if GetRegisterDatapacketReader(Nil,fmt,APacketReaderReg) then
     APacketWriter := APacketReaderReg.ReaderClass.Create(Self, AStream)
-  else if Format = dfBinary then
+  else if fmt = dfBinary then
     APacketWriter := TFpcBinaryDatapacketReader.Create(Self, AStream)
   else
     DatabaseError(SNoReaderClassRegistered,Self);
@@ -3449,9 +3481,13 @@ begin
 end;
 
 procedure TCustomBufDataset.LoadFromFile(AFileName: string; Format: TDataPacketFormat);
-var AFileStream : TFileStream;
+
+var
+  AFileStream : TFileStream;
+
 begin
-  if AFileName='' then AFileName := FFileName;
+  if AFileName='' then
+     AFileName := FFileName;
   AFileStream := TFileStream.Create(AFileName,fmOpenRead);
   try
     LoadFromStream(AFileStream, Format);
@@ -3460,11 +3496,14 @@ begin
   end;
 end;
 
-procedure TCustomBufDataset.SaveToFile(AFileName: string;
+procedure TCustomBufDataset.SaveToFile(AFileName: string; Format: TDataPacketFormat);
-  Format: TDataPacketFormat);
+
-var AFileStream : TFileStream;
+var
+  AFileStream : TFileStream;
+
 begin
-  if AFileName='' then AFileName := FFileName;
+  if AFileName='' then
+    AFileName := FFileName;
   AFileStream := TFileStream.Create(AFileName,fmCreate);
   try
     SaveToStream(AFileStream, Format);
@@ -3536,7 +3575,7 @@ begin
   if not assigned(FDatasetReader) then
     begin
     FFileStream := TFileStream.Create(FileName, fmOpenRead);
-    FDatasetReader := GetPacketReader(dfAny, FFileStream);
+    FDatasetReader := GetPacketReader(dfDefault, FFileStream);
     end;
 
   FieldDefs.Clear;

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

@@ -95,6 +95,9 @@ Type
     FCSVOptions: TCSVOptions;
     procedure SetCSVOptions(AValue: TCSVOptions);
   Protected
+    class function DefaultReadFileFormat : TDataPacketFormat; override;
+    class function DefaultWriteFileFormat : TDataPacketFormat; override;
+    class function DefaultPacketClass : TDataPacketReaderClass ; override;
     function GetPacketReader(const Format: TDataPacketFormat; const AStream: TStream): TDataPacketReader; override;
     procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField); override;
     procedure InternalInitFieldDefs; override;
@@ -305,10 +308,25 @@ begin
   FCSVOptions.Assign(AValue);
 end;
 
+class function TCustomCSVDataset.DefaultReadFileFormat: TDataPacketFormat;
+begin
+  Result:=dfDefault;
+end;
+
+class function TCustomCSVDataset.DefaultWriteFileFormat: TDataPacketFormat;
+begin
+  Result:=dfDefault;
+end;
+
+class function TCustomCSVDataset.DefaultPacketClass: TDataPacketReaderClass;
+begin
+  Result:=TCSVDataPacketReader;
+end;
+
 function TCustomCSVDataset.GetPacketReader(const Format: TDataPacketFormat;
   const AStream: TStream): TDataPacketReader;
 begin
-  If (Format=dfAny) then
+  If (Format in [dfAny,dfDefault]) then
     Result:=TCSVDataPacketReader.Create(Self,AStream,FCSVOptions)
   else
     Result:=Inherited GetPacketReader(Format,AStream);

packages/fcl-db/tests/tccsvdataset.pp

@@ -15,6 +15,7 @@ type
   private
     FCSVDataset: TCSVDataset;
     // Load CSVDataset from CSV stream containing lines
+    procedure DoOpenClose;
     Procedure LoadFromLines(Const Lines: Array of string);
     // Save CSVDataset to CSV stream, transform to lines
     Procedure SaveToLines(Const Lines: TStrings);
@@ -47,6 +48,7 @@ type
     Procedure TestLoadPriorFieldDefsNoFieldNamesWrongCount;
     Procedure TestLoadPriorFieldDefsFieldNamesWrongCount;
     Procedure TestLoadPriorFieldDefsFieldNamesWrongNames;
+    Procedure TestOpenCloseCycle;
   end;
 
 implementation
@@ -421,6 +423,89 @@ begin
     Fail(OK);
 end;
 
+const
+  FILENAME = 'test.dat';
+
+procedure TTestCSVDataset.DoOpenClose;
+
+begin
+  CSVDataset.FileName := FILENAME;
+  With CSVDataset do
+     begin
+     CSVOptions.FirstLineAsFieldNames := True;
+     CSVOptions.DefaultFieldLength := 255;
+     CSVOptions.Delimiter := ',';
+     CSVOptions.QuoteChar := '"';
+     CSVOptions.IgnoreOuterWhitespace := False;
+     CSVOptions.QuoteOuterWhitespace := True;
+     end;
+  // When the program runs for the first time, the data file does not yet exist.
+  // We must create the FieldDefs and create the dataset.
+  if FileExists(CSVDataset.FileName) then
+    CSVDataset.Open
+  else
+    with CSVDataset do
+      begin
+      FieldDefs.Add('FirstName', ftString, 20);
+      FieldDefs.Add('LastName', ftstring, 20);
+      FieldDefs.Add('City', ftString, 20);
+      FieldDefs.Add('Address', ftString, 30);
+      FieldDefs.Add('Birthdate', ftDate);
+      CreateDataset;
+
+      // Open the dataset...
+      Open;
+
+      // ... and add some dummy data:
+      // Names from https://donatellanobatti.blogspot.de/
+      Append;
+      FieldByName('FirstName').AsString := 'Walter';
+      FieldByName('LastName').AsString := 'Mellon';
+      FieldByName('City').AsString := 'Oklahoma City';
+      FieldByName('Address').AsString :=  '1261, Main Street';
+      FieldbyName('Birthdate').AsDateTime := EncodeDate(1980, 1, 1);
+      Post;
+
+      Append;
+      FieldByName('FirstName').AsString := 'Mario';
+      FieldByName('LastName').AsString := 'Speedwagon';
+      FieldByName('City').AsString := 'Hollywood';
+      FieldByName('Address').AsString :=  '1500, Hollywood Blvd';
+      FieldbyName('Birthdate').AsDateTime := EncodeDate(1982, 12, 17);
+      Post;
+
+      Append;
+      FieldByName('FirstName').AsString := 'Anna';
+      FieldByName('LastName').AsString := 'Mull';
+      FieldByName('City').AsString := 'Los Angeles';
+      FieldByName('Address').AsString :=  '2202, Capitol Square';
+      FieldbyName('Birthdate').AsDateTime := EncodeDate(1982, 12, 17);
+      Post;
+      end;
+  // This will write the file;
+  CSVDataset.Close;
+end;
+
+procedure TTestCSVDataset.TestOpenCloseCycle;
+begin
+  if FileExists(FileName) then
+    AssertTrue('Delete before',DeleteFile(FileName));
+  try
+    // This will create the file
+    DoOpenClose;
+    // Recreate to be sure
+    FreeAndNil(FCSVDataset);
+    FCSVDataset:=TCSVDataset.Create(Nil);
+    FCSVDataset.Name:='DS';
+    DoOpenClose;
+  except
+    On E : Exception do
+      Fail('Failed using exception %s : %s',[E.ClassName,E.Message]);
+  end;
+  if FileExists(FileName) then
+    AssertTrue('Delete after',DeleteFile(FileName));
+end;
+
 procedure TTestCSVDataset.SetUp;
 begin
   FCSVDataset:=TCSVDataset.Create(Nil);