paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 15:49:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@43643 -
This commit is contained in:
michael 2019-12-05 14:01:43 +00:00
parent e28b39e395
commit 76a4638a46
3 changed files with 170 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

93
packages/fcl-db/src/base/bufdataset.pas
View File

@ -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
begin
if (AStream=nil) or (RegisteredDatapacketReaders[i].ReaderClass.RecognizeStream(AStream)) then
for i := 0 to length(RegisteredDatapacketReaders)-1 do
if ((AFormat=dfAny) or (AFormat=RegisteredDatapacketReaders[i].Format)) then
begin
ADataReaderClass := RegisteredDatapacketReaders[i];
Result := True;
if (AStream <> nil) then AStream.Seek(0,soFromBeginning);
break;
if (AStream=nil) or (RegisteredDatapacketReaders[i].ReaderClass.RecognizeStream(AStream)) then
begin
ADataReaderClass := RegisteredDatapacketReaders[i];
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
SaveToFile(FFileName);
if (FFileName<>'') then
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;
APacketReaderReg: TDatapacketReaderRegistration;
var
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;
Format: TDataPacketFormat);
var AFileStream : TFileStream;
procedure TCustomBufDataset.SaveToFile(AFileName: string; Format: TDataPacketFormat);
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;

20
packages/fcl-db/src/base/csvdataset.pp
View File

@ -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);

85
packages/fcl-db/tests/tccsvdataset.pp
View File

@ -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);