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

fcl-db: sdfdataset: Added support for reading of CSV files, which have embedded CRLF between double-quotes (Added TSDFStringList) + test.

Browse Source 
git-svn-id: trunk@31243 -
This commit is contained in:
lacak 2015-07-30 05:49:05 +00:00
parent 55669f62b1
commit 6f3da41769
2 changed files with 109 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

109
packages/fcl-db/src/sdf/sdfdata.pp
View File

@ -13,6 +13,9 @@ unit SdfData;
---------------
Modifications
---------------
30/Jul/15 LacaK:
Added TSDFStringList to support reading of CSV files, which have embedded
CRLF between double-quotes.
7/Jun/12 BigChimp:
Quote fields with delimiters or quotes to match Delphi SDF definition
(see e.g. help on TStrings.CommaText)
@ -50,7 +53,7 @@ Modifications
characters.
Altered buffer method to create on constructor and cleared when opened.
New Resource File. Nice Icons
SavetoStream method included
SaveToStream method included
LoadFromStream method included
****** THANKS LESLIE *****
14/Ago/01 Version 2.00 (Orlando Arrocha)
@ -141,10 +144,18 @@ type
BookmarkFlag: TBookmarkFlag;
end;
//-----------------------------------------------------------------------------
// TBaseTextDataSet
{ TFixedFormatDataSet }
{ TSDFStringList }
TSDFStringList = class(TStringList)
protected
FMultiLine: boolean;
procedure SetTextStr(const Value: string); override;
end;
//-----------------------------------------------------------------------------
// TFixedFormatDataSet
//-----------------------------------------------------------------------------
TFixedFormatDataSet = class(TDataSet)
private
FSchema :TStringList;
@ -152,7 +163,7 @@ type
FFilterBuffer :TRecordBuffer;
FFileMustExist :Boolean;
FReadOnly :Boolean;
FLoadfromStream :Boolean;
FLoadFromStream :Boolean;
FTrimSpace :Boolean;
procedure SetSchema(const Value: TStringList);
procedure SetFileName(Value : TFileName);
@ -164,7 +175,7 @@ type
function GetActiveRecBuf(out RecBuf: TRecordBuffer): Boolean;
procedure SetFieldOfs(var Buffer : TRecordBuffer; FieldNo : Integer);
protected
FData :TStringlist;
FData :TSDFStringList;
FDataOffset :Integer;
FCurRec :Integer;
FRecordSize :Integer;
@ -217,7 +228,7 @@ type
procedure SaveFileAs(strFileName : String); dynamic;
property CanModify;
procedure LoadFromStream(Stream :TStream);
procedure SavetoStream(Stream :TStream);
procedure SaveToStream(Stream :TStream);
published
property FileMustExist: Boolean read FFileMustExist write SetFileMustExist;
property ReadOnly: Boolean read FReadOnly write SetReadOnly;
@ -256,6 +267,7 @@ type
//-----------------------------------------------------------------------------
// TSdfDataSet
//-----------------------------------------------------------------------------
TSdfDataSet = class(TFixedFormatDataSet)
private
FDelimiter : Char;
@ -285,6 +297,7 @@ type
procedure Register;
implementation
//{$R *.Res}
//-----------------------------------------------------------------------------
@ -294,11 +307,11 @@ constructor TFixedFormatDataSet.Create(AOwner : TComponent);
begin
FDefaultRecordLength := 250;
FFileMustExist := TRUE;
FLoadfromStream := False;
FLoadFromStream := False;
FRecordSize := 0;
FTrimSpace := TRUE;
FSchema := TStringList.Create;
FData := TStringList.Create; // Load the textfile into a StringList
FData := TSDFStringList.Create; // Load the textfile into a StringList
inherited Create(AOwner);
end;
@ -344,8 +357,7 @@ var
i, Len, MaxLen :Integer;
LstFields :TStrings;
begin
if not Assigned(FData) then
exit;
if not Assigned(FData) then Exit;
MaxLen := 0;
FieldDefs.Clear;
@ -382,15 +394,15 @@ procedure TFixedFormatDataSet.InternalOpen;
var
Stream : TStream;
begin
if not Assigned(FData) then Exit;
FSaveChanges := FALSE;
if not Assigned(FData) then
FData := TStringList.Create;
if (not FileMustExist) and (not FileExists(FileName)) then
begin
Stream := TFileStream.Create(FileName, fmCreate);
Stream.Free;
end;
if not FLoadfromStream then
if not FLoadFromStream then
FData.LoadFromFile(FileName);
FRecordSize := FDefaultRecordLength;
InternalInitFieldDefs;
@ -413,7 +425,7 @@ procedure TFixedFormatDataSet.InternalClose;
begin
if (not FReadOnly) and (FSaveChanges) then // Write any edits to disk
FData.SaveToFile(FileName);
FLoadfromStream := False;
FLoadFromStream := False;
FData.Clear; // Clear data
BindFields(FALSE);
if DefaultFields then // Destroy the TField
@ -444,9 +456,9 @@ begin
begin
Active := False; //Make sure the Dataset is Closed.
Stream.Position := 0; //Make sure you are at the top of the Stream.
FLoadfromStream := True;
FLoadFromStream := True;
if not Assigned(FData) then
raise Exception.Create('Data buffer unassigned');
raise Exception.Create('Data buffer unassigned');
FData.LoadFromStream(Stream);
Active := True;
end
@ -455,7 +467,7 @@ begin
end;
// Saves Data as text to a stream.
procedure TFixedFormatDataSet.SavetoStream(Stream: TStream);
procedure TFixedFormatDataSet.SaveToStream(Stream: TStream);
begin
if assigned(stream) then
FData.SaveToStream(Stream)
@ -886,6 +898,62 @@ begin
end;
end;
//-----------------------------------------------------------------------------
// TSDFStringList
//-----------------------------------------------------------------------------
procedure TSDFStringList.SetTextStr(const Value: string);
var
S: string;
P: integer;
function GetNextLine(const Value: string; out S: string; var P: Integer): Boolean;
const
CR: char = #13;
LF: char = #10;
DQ: char = '"';
var
L, P1: integer;
InDQ: boolean;
begin
// RFC 4180:
// Each record is located on a separate line, delimited by a line break (CRLF)
// Fields containing line breaks (CRLF), double quotes, and commas should be enclosed in double-quotes.
Result := False;
L := Length(Value);
if P > L then Exit;
P1 := P;
InDQ := False;
while (P <= L) and (not(Value[P] in [CR,LF]) or InDQ) do
begin
if Value[P] = DQ then InDQ := not InDQ;
inc(P);
end;
S := Copy(Value, P1, P-P1);
if (P <= L) and (Value[P] = CR) then
inc(P);
if (P <= L) and (Value[P] = LF) then
inc(P);
Result := True;
end;
begin
if FMultiLine then // CRLF can be enclosed between double-quotes
try
BeginUpdate;
Clear;
P:=1;
while GetNextLine(Value,S,P) do
Add(S);
finally
EndUpdate;
end
else
inherited;
end;
//-----------------------------------------------------------------------------
// TSdfDataSet
//-----------------------------------------------------------------------------
@ -919,7 +987,7 @@ begin
if (S[Pos] = DQ) then
// quoted field
begin
// skip leading quote
// skip leading double-quote
Inc(Pos);
// allocate output buffer
SetLength(Result, Len-P1+1);
@ -931,7 +999,7 @@ begin
begin
if (pSrc[1] = DQ) then // doubled DQ
begin
Inc(pSrc);
Inc(pSrc); // dequote double-quote
Inc(Pos);
end
else if (pSrc[1] in [Delimiter,' ',CR,LF,#0]) then // DQ followed by delimiter or end of record
@ -950,7 +1018,7 @@ begin
Inc(Pos);
end
else
// unquoted field name
// unquoted field
begin
while (Pos <= Len) and not(S[Pos] in [Delimiter,CR,LF,#0]) do
Inc(Pos);
@ -1118,6 +1186,7 @@ end;
procedure TSdfDataSet.SetMultiLine(const Value: Boolean);
begin
FMultiLine:=Value;
FData.FMultiLine:=Value;
end;

34
packages/fcl-db/tests/tcsdfdata.pp
View File

@ -228,9 +228,7 @@ end;
procedure Ttestsdfspecific.TestDelimitedTextOutput;
// Test if saving and loading data keeps the original values.
// Mainly check if writing & reading quotes works.
// to do: more fully test RFC4180
// Mainly check if writing & reading embedded quotes and CRLF works.
const
Value1='Delimiter,"and";quote';
Value2='J"T"';
@ -241,6 +239,7 @@ const
Value7='Some "random" quotes';
Var
F : Text;
i : integer;
begin
// with Schema, with Header line
TestDataset.Close;
@ -250,21 +249,28 @@ begin
Assign(F, TestDataset.FileName);
Rewrite(F);
Writeln(F,'Field1,Field2,Field3,Field4,Field5,Field6,Field7');
Writeln(F,'"Delimiter,""and"";quote","J""T""",Just a long line,"Just a quoted long line","multi');
Writeln(F,'line","Delimiter,and;done","Some ""random"" quotes"');
for i:=1 to 3 do
begin
Writeln(F,'"Delimiter,""and"";quote","J""T""",Just a long line,"Just a quoted long line","multi');
Writeln(F,'line","Delimiter,and;done","Some ""random"" quotes"');
end;
Close(F);
// Load our dataset
TestDataset.Open;
// AssertEquals('Field count',7,TestDataset.FieldDefs.Count);
// AssertEquals('Record count',1,TestDataset.RecordCount);
AssertEquals('FieldDefs.Count', 7, TestDataset.FieldDefs.Count);
AssertEquals('RecordCount', 3, TestDataset.RecordCount);
TestDataset.First;
AssertEquals('Field1', Value1, TestDataSet.Fields[0].AsString);
AssertEquals('Field2', Value2, TestDataSet.Fields[1].AsString);
AssertEquals('Field3', Value3, TestDataSet.Fields[2].AsString);
AssertEquals('Field4', Value4, TestDataSet.Fields[3].AsString);
AssertEquals('Field5', Value5, TestDataSet.Fields[4].AsString);
AssertEquals('Field6', Value6, TestDataSet.Fields[5].AsString);
AssertEquals('Field7' ,Value7, TestDataSet.Fields[6].AsString);
for i:=1 to 3 do
begin
AssertEquals('Field1', Value1, TestDataSet.Fields[0].AsString);
AssertEquals('Field2', Value2, TestDataSet.Fields[1].AsString);
AssertEquals('Field3', Value3, TestDataSet.Fields[2].AsString);
AssertEquals('Field4', Value4, TestDataSet.Fields[3].AsString);
AssertEquals('Field5', Value5, TestDataSet.Fields[4].AsString);
AssertEquals('Field6', Value6, TestDataSet.Fields[5].AsString);
AssertEquals('Field7' ,Value7, TestDataSet.Fields[6].AsString);
TestDataSet.Next;
end;
end;
procedure Ttestsdfspecific.TestEmptyFieldContents;