mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-19 14:19:31 +02:00
* Implemented CSVDataset
git-svn-id: trunk@30417 -
This commit is contained in:
michael
parent
c37720d12d
commit
6b130438eb
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -2101,6 +2101,7 @@ packages/fcl-db/src/base/Makefile svneol=native#text/plain
|
||||
packages/fcl-db/src/base/Makefile.fpc svneol=native#text/plain
|
||||
packages/fcl-db/src/base/bufdataset.pas svneol=native#text/plain
|
||||
packages/fcl-db/src/base/bufdataset_parser.pp svneol=native#text/plain
|
||||
packages/fcl-db/src/base/csvdataset.pp svneol=native#text/plain
|
||||
packages/fcl-db/src/base/database.inc svneol=native#text/plain
|
||||
packages/fcl-db/src/base/dataset.inc svneol=native#text/plain
|
||||
packages/fcl-db/src/base/datasource.inc svneol=native#text/plain
|
||||
@ -2314,6 +2315,7 @@ packages/fcl-db/tests/memdstoolsunit.pas svneol=native#text/plain
|
||||
packages/fcl-db/tests/reruntest.sh svneol=native#text/plain
|
||||
packages/fcl-db/tests/sdfdstoolsunit.pas svneol=native#text/plain
|
||||
packages/fcl-db/tests/sqldbtoolsunit.pas svneol=native#text/plain
|
||||
packages/fcl-db/tests/tccsvdataset.pp svneol=native#text/plain
|
||||
packages/fcl-db/tests/tcgensql.pas svneol=native#text/plain
|
||||
packages/fcl-db/tests/tcparser.pas svneol=native#text/plain
|
||||
packages/fcl-db/tests/tcsdfdata.pp svneol=native#text/plain
|
||||
|
||||
@ -92,6 +92,13 @@ begin
|
||||
AddUnit('dbconst');
|
||||
end;
|
||||
|
||||
T:=P.Targets.AddUnit('csvdataset.pp');
|
||||
with T.Dependencies do
|
||||
begin
|
||||
AddUnit('db');
|
||||
AddUnit('bufdataset');
|
||||
end;
|
||||
|
||||
T:=P.Targets.AddUnit('bufdataset_parser.pp');
|
||||
with T.Dependencies do
|
||||
begin
|
||||
|
||||
389
packages/fcl-db/src/base/csvdataset.pp
Normal file
389
packages/fcl-db/src/base/csvdataset.pp
Normal file
@ -0,0 +1,389 @@
|
||||
{
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1999-2014 by Michael Van Canneyt, member of the
|
||||
Free Pascal development team
|
||||
|
||||
CSV Dataset implementation.
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
unit csvdataset;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, bufdataset, csvreadwrite, db, sqldb;
|
||||
|
||||
Type
|
||||
|
||||
|
||||
{ TCSVOptions }
|
||||
|
||||
TCSVOptions = Class(TCSVHandler)
|
||||
private
|
||||
FDefaultFieldLength: Word;
|
||||
FFirstLineAsFieldNames: Boolean;
|
||||
Public
|
||||
Constructor Create; override;
|
||||
Procedure Assign(Source : TPersistent); override;
|
||||
Published
|
||||
// Does first line of the file contain the field names to use ?
|
||||
property FirstLineAsFieldNames : Boolean Read FFirstLineAsFieldNames Write FFirstLineAsFieldNames;
|
||||
// Default is to create all fields as strings with the same length. Default string field length.
|
||||
// If the CSV dataset has field defs prior to loading, this is ignored.
|
||||
property DefaultFieldLength : Word Read FDefaultFieldLength Write FDefaultFieldLength;
|
||||
// Field delimiter
|
||||
property Delimiter;
|
||||
// Character used to quote "problematic" data
|
||||
// (e.g. with delimiters or spaces in them)
|
||||
// A common quotechar is "
|
||||
property QuoteChar;
|
||||
// String at the end of the line of data (e.g. CRLF)
|
||||
property LineEnding;
|
||||
// Ignore whitespace between delimiters and field data
|
||||
property IgnoreOuterWhitespace;
|
||||
// Use quotes when outer whitespace is found
|
||||
property QuoteOuterWhitespace;
|
||||
end;
|
||||
|
||||
{ TCSVDataPacketReader }
|
||||
|
||||
TCSVDataPacketReader = class(TDataPacketReader)
|
||||
private
|
||||
FOptions: TCSVOptions;
|
||||
FOwnsOptions: Boolean;
|
||||
FParser : TCSVParser;
|
||||
FBuilder : TCSVBuilder;
|
||||
FLine : TStringList;
|
||||
FCurrentRow : Integer;
|
||||
FEOF : Boolean;
|
||||
FCreateFieldDefs : TFieldDefs;
|
||||
// Read next row in Fline
|
||||
Protected
|
||||
Procedure ReadNextRow;virtual;
|
||||
procedure SetCreateFieldDefs(AValue: TFieldDefs);virtual;
|
||||
public
|
||||
constructor Create(ADataSet: TCustomBufDataset; AStream : TStream); override;
|
||||
constructor Create(ADataSet: TCustomBufDataset; AStream : TStream; AOptions : TCSVOptions);
|
||||
Destructor Destroy; override;
|
||||
procedure LoadFieldDefs(var AnAutoIncValue : integer); override;
|
||||
procedure StoreFieldDefs(AnAutoIncValue : integer); override;
|
||||
function GetRecordRowState(out AUpdOrder : Integer) : TRowState; override;
|
||||
procedure FinalizeStoreRecords; override;
|
||||
function GetCurrentRecord : boolean; override;
|
||||
procedure GotoNextRecord; override;
|
||||
procedure InitLoadRecords; override;
|
||||
procedure RestoreRecord override;
|
||||
procedure StoreRecord(ARowState : TRowState; AUpdOrder : integer = 0); override;
|
||||
class function RecognizeStream(AStream : TStream) : boolean; override;
|
||||
Property Options : TCSVOptions Read FOptions;
|
||||
Property CreateFieldDefs : TFieldDefs read FCreateFieldDefs Write SetCreateFieldDefs;
|
||||
end;
|
||||
|
||||
{ TCustomCSVDataset }
|
||||
|
||||
TCustomCSVDataset = Class(TBufDataset)
|
||||
private
|
||||
FCSVOptions: TCSVOptions;
|
||||
procedure SetCSVOptions(AValue: TCSVOptions);
|
||||
Protected
|
||||
procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField); override;
|
||||
procedure InternalInitFieldDefs; override;
|
||||
Public
|
||||
Constructor Create(AOwner : TComponent); override;
|
||||
Destructor Destroy; override;
|
||||
{ If FieldDefs is filled prior to calling one of the load functions,
|
||||
the fielddefs definitions will be checked against file contents
|
||||
as far as possible: count and names if names are on first line}
|
||||
procedure LoadFromCSVStream(AStream : TStream);
|
||||
procedure LoadFromCSVFile(Const AFileName: string);
|
||||
procedure SaveToCSVStream(AStream : TStream);
|
||||
procedure SaveToCSVFile(AFileName: string = '');
|
||||
Protected
|
||||
Property CSVOptions : TCSVOptions Read FCSVOptions Write SetCSVOptions;
|
||||
end;
|
||||
|
||||
TCSVDataset = Class(TCustomCSVDataset)
|
||||
Published
|
||||
Property CSVOptions;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TCSVDataPacketReader }
|
||||
|
||||
Procedure TCSVDataPacketReader.ReadNextRow;
|
||||
|
||||
|
||||
begin
|
||||
FLine.Clear;
|
||||
if not FEOF then
|
||||
begin
|
||||
if (FCurrentRow>0) then
|
||||
FLine.Add(FParser.CurrentCellText);
|
||||
Repeat
|
||||
FEOF:=Not FParser.ParseNextCell;
|
||||
if (not FEOF) and (FParser.CurrentRow=FCurrentRow) then
|
||||
FLine.Add(FParser.CurrentCellText);
|
||||
until FEOF or (FParser.CurrentRow>FCurrentRow);
|
||||
end;
|
||||
FCurrentRow:=FParser.CurrentRow;
|
||||
end;
|
||||
|
||||
procedure TCSVDataPacketReader.SetCreateFieldDefs(AValue: TFieldDefs);
|
||||
begin
|
||||
if FCreateFieldDefs=AValue then Exit;
|
||||
if (FCreateFieldDefs=Nil) then
|
||||
begin
|
||||
FCreateFieldDefs:=TFieldDefs.Create(AValue.Dataset);
|
||||
FCreateFieldDefs.Assign(AValue);
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TCSVDataPacketReader.Create(ADataSet: TCustomBufDataset; AStream: TStream);
|
||||
begin
|
||||
inherited Create(ADataSet,AStream);
|
||||
if FOptions=Nil then
|
||||
begin
|
||||
FOptions:=TCSVOptions.Create;
|
||||
FOptions.FFirstLineAsFieldNames:=True;
|
||||
FOwnsOptions:=True;
|
||||
end;
|
||||
FLine:=TStringList.Create;
|
||||
end;
|
||||
|
||||
constructor TCSVDataPacketReader.Create(ADataSet: TCustomBufDataset; AStream: TStream; AOptions: TCSVOptions);
|
||||
begin
|
||||
FOptions:=AOptions;
|
||||
Create(ADataset,AStream);
|
||||
FOwnsOptions:=AOptions=Nil;
|
||||
end;
|
||||
|
||||
Destructor TCSVDataPacketReader.Destroy;
|
||||
begin
|
||||
If FOwnsOptions then
|
||||
FreeAndNil(FOPtions);
|
||||
FreeAndNil(Fline);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TCSVDataPacketReader.LoadFieldDefs(var AnAutoIncValue: integer);
|
||||
Var
|
||||
FN : String;
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
FParser:=TCSVParser.Create;
|
||||
FParser.SetSource(Stream);
|
||||
FCurrentRow:=0;
|
||||
ReadNextRow;
|
||||
If Assigned(CreateFieldDefs) then
|
||||
begin
|
||||
if (CreateFieldDefs.Count<>Fline.Count) then
|
||||
DatabaseErrorFmt('CSV File Field count (%d) does not match dataset field count (%d).',[Fline.Count,CreateFieldDefs.Count],Dataset.FieldDefs.Dataset);
|
||||
If FOptions.FirstLineAsFieldNames then
|
||||
For I:=0 to FLine.Count-1 do
|
||||
If (CompareText(FLine[i],CreateFieldDefs[i].Name)<>0) then
|
||||
DatabaseErrorFmt('CSV File field %d: name "%s" does not match dataset field name "%s".',[I,FLine[i],CreateFieldDefs[i].Name],Dataset.FieldDefs.Dataset);
|
||||
Dataset.FieldDefs.Assign(CreateFieldDefs);
|
||||
end
|
||||
else if (FLine.Count>0) then
|
||||
For I:=0 to FLine.Count-1 do
|
||||
begin
|
||||
If FOptions.FirstLineAsFieldNames then
|
||||
FN:=FLine[i]
|
||||
else
|
||||
FN:=Format('Column%d',[i+1]);
|
||||
Dataset.FieldDefs.Add(FN,ftString,Foptions.DefaultFieldLength);
|
||||
end;
|
||||
if FOptions.FirstLineAsFieldNames then
|
||||
ReadNextRow;
|
||||
end;
|
||||
|
||||
procedure TCSVDataPacketReader.StoreFieldDefs(AnAutoIncValue: integer);
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
FBuilder:=TCSVBuilder.Create;
|
||||
FBuilder.SetOutput(Stream);
|
||||
if FOptions.FirstLineAsFieldNames then
|
||||
begin
|
||||
For I:=0 to Dataset.FieldDefs.Count-1 do
|
||||
FBuilder.AppendCell(Dataset.FieldDefs[i].Name);
|
||||
FBuilder.AppendRow;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCSVDataPacketReader.GetRecordRowState(out AUpdOrder: Integer
|
||||
): TRowState;
|
||||
begin
|
||||
AUpdOrder:=0;
|
||||
Result:=[];
|
||||
end;
|
||||
|
||||
procedure TCSVDataPacketReader.FinalizeStoreRecords;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
function TCSVDataPacketReader.GetCurrentRecord: boolean;
|
||||
begin
|
||||
Result:=Fline.Count>0;
|
||||
end;
|
||||
|
||||
procedure TCSVDataPacketReader.GotoNextRecord;
|
||||
begin
|
||||
ReadNextRow;
|
||||
end;
|
||||
|
||||
procedure TCSVDataPacketReader.InitLoadRecords;
|
||||
begin
|
||||
// Do nothing
|
||||
end;
|
||||
|
||||
procedure TCSVDataPacketReader.RestoreRecord;
|
||||
|
||||
Var
|
||||
I : integer;
|
||||
|
||||
begin
|
||||
For I:=0 to Fline.Count-1 do
|
||||
Dataset.Fields[i].AsString:=Copy(FLine[i],1,Dataset.Fields[i].Size)
|
||||
end;
|
||||
|
||||
procedure TCSVDataPacketReader.StoreRecord(ARowState: TRowState; AUpdOrder: integer);
|
||||
Var
|
||||
I : integer;
|
||||
|
||||
begin
|
||||
For I:=0 to Dataset.Fields.Count-1 do
|
||||
FBuilder.AppendCell(Dataset.Fields[i].AsString);
|
||||
FBuilder.AppendRow;
|
||||
end;
|
||||
|
||||
class function TCSVDataPacketReader.RecognizeStream(AStream: TStream): boolean;
|
||||
begin
|
||||
Result:=False;
|
||||
end;
|
||||
|
||||
{ TCSVOptions }
|
||||
|
||||
Constructor TCSVOptions.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
DefaultFieldLength:=255;
|
||||
end;
|
||||
|
||||
Procedure TCSVOptions.Assign(Source: TPersistent);
|
||||
begin
|
||||
if (Source is TCSVOptions) then
|
||||
begin
|
||||
FFirstLineAsFieldNames:=TCSVOptions(Source).FirstLineAsFieldNames;
|
||||
FDefaultFieldLength:=TCSVOptions(Source).FDefaultFieldLength
|
||||
end;
|
||||
inherited Assign(Source);
|
||||
end;
|
||||
|
||||
{ TCustomCSVDataset }
|
||||
|
||||
procedure TCustomCSVDataset.SetCSVOptions(AValue: TCSVOptions);
|
||||
begin
|
||||
if (FCSVOptions=AValue) then Exit;
|
||||
FCSVOptions.Assign(AValue);
|
||||
end;
|
||||
|
||||
procedure TCustomCSVDataset.LoadBlobIntoBuffer(FieldDef: TFieldDef;
|
||||
ABlobBuf: PBufBlobField);
|
||||
begin
|
||||
// Do nothing
|
||||
end;
|
||||
|
||||
procedure TCustomCSVDataset.InternalInitFieldDefs;
|
||||
begin
|
||||
// Do nothing
|
||||
end;
|
||||
|
||||
Constructor TCustomCSVDataset.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FCSVOptions:=TCSVOptions.Create;
|
||||
end;
|
||||
|
||||
Destructor TCustomCSVDataset.Destroy;
|
||||
begin
|
||||
FreeAndNil(FCSVOptions);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TCustomCSVDataset.LoadFromCSVStream(AStream: TStream);
|
||||
|
||||
Var
|
||||
P : TCSVDataPacketReader;
|
||||
|
||||
begin
|
||||
CheckInactive;
|
||||
P:=TCSVDataPacketReader.Create(Self,AStream,FCSVOptions);
|
||||
try
|
||||
if FieldDefs.Count>0 then
|
||||
P.CreateFieldDefs:=FieldDefs;
|
||||
SetDatasetPacket(P);
|
||||
finally
|
||||
P.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomCSVDataset.LoadFromCSVFile(Const AFileName: string);
|
||||
|
||||
Var
|
||||
F : TFileStream;
|
||||
|
||||
begin
|
||||
F:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite);
|
||||
try
|
||||
LoadFromCSVStream(F);
|
||||
finally
|
||||
F.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomCSVDataset.SaveToCSVStream(AStream: TStream);
|
||||
|
||||
Var
|
||||
P : TCSVDataPacketReader;
|
||||
|
||||
begin
|
||||
First;
|
||||
MergeChangeLog;
|
||||
P:=TCSVDataPacketReader.Create(Self,AStream,FCSVOPtions);
|
||||
try
|
||||
GetDatasetPacket(P);
|
||||
finally
|
||||
P.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomCSVDataset.SaveToCSVFile(AFileName: string);
|
||||
Var
|
||||
F : TFileStream;
|
||||
|
||||
begin
|
||||
F:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite);
|
||||
try
|
||||
SaveToCSVStream(F);
|
||||
finally
|
||||
F.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -28,7 +28,7 @@ uses
|
||||
TestSpecificTBufDataset,
|
||||
TestSpecificTDBF,
|
||||
TestSpecificTMemDataset,
|
||||
TestDBExport,
|
||||
TestDBExport, tccsvdataset,
|
||||
consoletestrunner;
|
||||
|
||||
Procedure LegacyOutput;
|
||||
|
||||
@ -27,12 +27,6 @@
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="../src/base;../src/sqldb/odbc;../src/sqldb/mssql;../src/sqldb/sqlite;../src/sqldb/postgres;../src/sqldb/oracle;../src/memds;../src/sqldb;../src/sqldb/interbase;../src/sqldb/mysql;../src/dbase;../src/sdf"/>
|
||||
</SearchPaths>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<UseMsgFile Value="True"/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
</Item2>
|
||||
<Item3 Name="Default_no_local_ppus">
|
||||
@ -46,12 +40,6 @@
|
||||
<GenerateDebugInfo Value="False"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<UseMsgFile Value="True"/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
</Item3>
|
||||
<Item4 Name="Default_no_local_ppus_debug">
|
||||
@ -65,12 +53,6 @@
|
||||
<OptimizationLevel Value="0"/>
|
||||
</Optimizations>
|
||||
</CodeGeneration>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<UseMsgFile Value="True"/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
</Item4>
|
||||
</BuildModes>
|
||||
@ -82,7 +64,6 @@
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
<LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="4">
|
||||
@ -99,17 +80,20 @@
|
||||
<PackageName Value="FCL"/>
|
||||
</Item4>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Units Count="3">
|
||||
<Unit0>
|
||||
<Filename Value="dbtestframework_gui.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="dbtestframework_gui"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="dbguitestrunner.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="DBGuiTestRunner"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="tccsvdataset.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="tccsvdataset"/>
|
||||
</Unit2>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
@ -123,12 +107,6 @@
|
||||
<GenerateDebugInfo Value="False"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<UseMsgFile Value="True"/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="7">
|
||||
|
||||
@ -35,7 +35,7 @@ uses
|
||||
TestSpecificTBufDataset,
|
||||
TestSpecificTDBF,
|
||||
TestSpecificTMemDataset,
|
||||
TestDBExport;
|
||||
TestDBExport, tccsvdataset;
|
||||
|
||||
{$R *.res}
|
||||
|
||||
|
||||
404
packages/fcl-db/tests/tccsvdataset.pp
Normal file
404
packages/fcl-db/tests/tccsvdataset.pp
Normal file
@ -0,0 +1,404 @@
|
||||
unit tccsvdataset;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, db, SysUtils, fpcunit, testutils, testregistry, csvdataset;
|
||||
|
||||
type
|
||||
|
||||
{ TTestCSVDataset }
|
||||
|
||||
TTestCSVDataset= class(TTestCase)
|
||||
private
|
||||
FCSVDataset: TCSVDataset;
|
||||
// Load CSVDataset from CSV stream containing lines
|
||||
Procedure LoadFromLines(Const Lines: Array of string);
|
||||
// Save CSVDataset to CSV stream, transform to lines
|
||||
Procedure SaveToLines(Const Lines: TStrings);
|
||||
// Save CSVDataset to CSV stream, transform to lines, compare with given lines
|
||||
Procedure AssertLines(Const Lines: Array of string);
|
||||
protected
|
||||
procedure SetUp; override;
|
||||
procedure TearDown; override;
|
||||
Property CSVDataset : TCSVDataset Read FCSVDataset;
|
||||
published
|
||||
procedure TestEmpty;
|
||||
procedure TestDefaults;
|
||||
Procedure TestLoadEmptyDefault;
|
||||
Procedure TestLoadEmptyFirstLineAsNames;
|
||||
Procedure TestLoad2fieldsFirstLineAsNames;
|
||||
Procedure TestLoad2fields;
|
||||
Procedure TestLoad2Records2fields;
|
||||
Procedure TestSaveEmptyDefault;
|
||||
Procedure TestSaveEmptyFirstLineAsNames;
|
||||
Procedure TestSaveOneRecordDefault;
|
||||
Procedure TestSaveOneRecordFirstLineAsNames;
|
||||
Procedure TestSaveTwoRecordsDefault;
|
||||
Procedure TestSaveTwoRecordsFirstLineAsNames;
|
||||
Procedure TestSaveOneRecord2FieldsDefault;
|
||||
Procedure TestSaveOneRecord2FieldsFirstLineAsNames;
|
||||
Procedure TestLoadPriorFieldDefs;
|
||||
Procedure TestLoadPriorFieldDefsNoFieldNames;
|
||||
Procedure TestLoadPriorFieldDefsNoFieldNamesWrongCount;
|
||||
Procedure TestLoadPriorFieldDefsFieldNamesWrongCount;
|
||||
Procedure TestLoadPriorFieldDefsFieldNamesWrongNames;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
procedure TTestCSVDataset.TestEmpty;
|
||||
begin
|
||||
AssertNotNull('Have CSV dataset',CSVDataset);
|
||||
AssertFalse('Not open',CSVDataset.Active);
|
||||
AssertEquals('No fielddefs',0,CSVDataset.FieldDefs.Count);
|
||||
AssertEquals('Name','DS',CSVDataset.Name);
|
||||
end;
|
||||
|
||||
procedure TTestCSVDataset.TestDefaults;
|
||||
begin
|
||||
With CSVDataset.CSVOptions do
|
||||
begin
|
||||
AssertEquals('DefaultFieldLength',255,DefaultFieldLength);
|
||||
AssertEquals('FirstLineAsFieldNames',False,FirstLineAsFieldNames);
|
||||
AssertEquals('Delimiter',',',Delimiter);
|
||||
AssertEquals('QuoteChar','"',QuoteChar);
|
||||
AssertEquals('LineEnding',sLineBreak,LineEnding);
|
||||
AssertEquals('IgnoreOuterWhitespace',False,IgnoreOuterWhitespace);
|
||||
AssertEquals('QuoteOuterWhitespace',True,QuoteOuterWhitespace);
|
||||
AssertEquals('EqualColCountPerRow',True,EqualColCountPerRow);
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TTestCSVDataset.LoadFromLines(Const Lines : Array of string);
|
||||
|
||||
Var
|
||||
L : TStringList;
|
||||
s : TStream;
|
||||
begin
|
||||
S:=Nil;
|
||||
L:=TStringList.Create;
|
||||
try
|
||||
L.AddStrings(Lines);
|
||||
S:=TStringStream.Create(L.Text);
|
||||
CSVDataset.LoadFromCSVStream(S);
|
||||
finally
|
||||
S.Free;
|
||||
L.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TTestCSVDataset.SaveToLines(Const Lines: TStrings);
|
||||
|
||||
Var
|
||||
S : TStringStream;
|
||||
|
||||
begin
|
||||
S:=TStringStream.Create('');
|
||||
try
|
||||
CSVDataset.SaveToCSVStream(S);
|
||||
Lines.Text:=S.DataString;
|
||||
{
|
||||
Writeln('----');
|
||||
Writeln(S.DataString);
|
||||
Writeln('----');
|
||||
}
|
||||
finally
|
||||
S.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TTestCSVDataset.AssertLines(Const Lines: Array of string);
|
||||
|
||||
Var
|
||||
L : TStrings;
|
||||
I : Integer;
|
||||
begin
|
||||
L:=TStringList.Create;
|
||||
try
|
||||
SaveToLines(L);
|
||||
AssertEquals('Number of lines',Length(Lines),L.Count);
|
||||
For I:=0 to L.Count-1 do
|
||||
AssertEquals('Correct line '+IntToStr(0),Lines[I],L[i]);
|
||||
finally
|
||||
L.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TTestCSVDataset.TestLoadEmptyDefault;
|
||||
begin
|
||||
LoadFromLines(['a']);
|
||||
AssertEquals('Active',True,CSVDataset.Active);
|
||||
AssertEquals('field count',1,CSVDataset.FieldDefs.Count);
|
||||
AssertEquals('field name','Column1',CSVDataset.FieldDefs[0].Name);
|
||||
AssertEquals('field size',CSVDataset.CSVOptions.DefaultFieldLength,CSVDataset.FieldDefs[0].Size);
|
||||
AssertEquals('Not Empty',False,CSVDataset.EOF and CSVDataset.BOF);
|
||||
AssertEquals('field contents','a',CSVDataset.Fields[0].AsString);
|
||||
end;
|
||||
|
||||
Procedure TTestCSVDataset.TestLoadEmptyFirstLineAsNames;
|
||||
|
||||
begin
|
||||
CSVDataset.CSVOptions.FirstLineAsFieldNames:=True;
|
||||
CSVDataset.CSVOptions.DefaultFieldLength:=128;
|
||||
LoadFromLines(['a']);
|
||||
AssertEquals('Active',True,CSVDataset.Active);
|
||||
AssertEquals('field count',1,CSVDataset.FieldDefs.Count);
|
||||
AssertEquals('field name','a',CSVDataset.FieldDefs[0].Name);
|
||||
AssertEquals('field size',CSVDataset.CSVOptions.DefaultFieldLength,CSVDataset.FieldDefs[0].Size);
|
||||
AssertEquals('Empty',True,CSVDataset.EOF and CSVDataset.BOF);
|
||||
end;
|
||||
|
||||
Procedure TTestCSVDataset.TestLoad2fieldsFirstLineAsNames;
|
||||
begin
|
||||
CSVDataset.CSVOptions.FirstLineAsFieldNames:=True;
|
||||
CSVDataset.CSVOptions.DefaultFieldLength:=128;
|
||||
LoadFromLines(['a,b']);
|
||||
AssertEquals('Active',True,CSVDataset.Active);
|
||||
AssertEquals('field count',2,CSVDataset.FieldDefs.Count);
|
||||
AssertEquals('field 0 name','a',CSVDataset.FieldDefs[0].Name);
|
||||
AssertEquals('field 0 size',CSVDataset.CSVOptions.DefaultFieldLength,CSVDataset.FieldDefs[0].Size);
|
||||
AssertEquals('field 1 name','b',CSVDataset.FieldDefs[1].Name);
|
||||
AssertEquals('field 1 size',CSVDataset.CSVOptions.DefaultFieldLength,CSVDataset.FieldDefs[1].Size);
|
||||
AssertEquals('Empty',True,CSVDataset.EOF and CSVDataset.BOF);
|
||||
end;
|
||||
|
||||
Procedure TTestCSVDataset.TestLoad2fields;
|
||||
|
||||
begin
|
||||
CSVDataset.CSVOptions.DefaultFieldLength:=128;
|
||||
LoadFromLines(['a,b']);
|
||||
AssertEquals('Active',True,CSVDataset.Active);
|
||||
AssertEquals('field count',2,CSVDataset.FieldDefs.Count);
|
||||
AssertEquals('field 0 name','Column1',CSVDataset.FieldDefs[0].Name);
|
||||
AssertEquals('field 0 size',CSVDataset.CSVOptions.DefaultFieldLength,CSVDataset.FieldDefs[0].Size);
|
||||
AssertEquals('field 1 name','Column2',CSVDataset.FieldDefs[1].Name);
|
||||
AssertEquals('field 1 size',CSVDataset.CSVOptions.DefaultFieldLength,CSVDataset.FieldDefs[1].Size);
|
||||
AssertEquals('Empty',False,CSVDataset.EOF and CSVDataset.BOF);
|
||||
AssertEquals('Not Empty',False,CSVDataset.EOF and CSVDataset.BOF);
|
||||
AssertEquals('field 0 contents','a',CSVDataset.Fields[0].AsString);
|
||||
AssertEquals('field 1 contents','b',CSVDataset.Fields[1].AsString);
|
||||
end;
|
||||
|
||||
Procedure TTestCSVDataset.TestLoad2Records2fields;
|
||||
begin
|
||||
CSVDataset.CSVOptions.DefaultFieldLength:=128;
|
||||
LoadFromLines(['a,b','c,d']);
|
||||
AssertEquals('Active',True,CSVDataset.Active);
|
||||
AssertEquals('field count',2,CSVDataset.FieldDefs.Count);
|
||||
AssertEquals('field 0 name','Column1',CSVDataset.FieldDefs[0].Name);
|
||||
AssertEquals('field 0 size',CSVDataset.CSVOptions.DefaultFieldLength,CSVDataset.FieldDefs[0].Size);
|
||||
AssertEquals('field 1 name','Column2',CSVDataset.FieldDefs[1].Name);
|
||||
AssertEquals('field 1 size',CSVDataset.CSVOptions.DefaultFieldLength,CSVDataset.FieldDefs[1].Size);
|
||||
AssertEquals('Empty',False,CSVDataset.EOF and CSVDataset.BOF);
|
||||
AssertEquals('Not Empty',False,CSVDataset.EOF and CSVDataset.BOF);
|
||||
AssertEquals('field 0 contents','a',CSVDataset.Fields[0].AsString);
|
||||
AssertEquals('field 1 contents','b',CSVDataset.Fields[1].AsString);
|
||||
CSVDataset.Next;
|
||||
AssertEquals('not At EOF',False,CSVDataset.EOF);
|
||||
AssertEquals('field 0 contents','c',CSVDataset.Fields[0].AsString);
|
||||
AssertEquals('field 1 contents','d',CSVDataset.Fields[1].AsString);
|
||||
CSVDataset.Next;
|
||||
AssertEquals('At EOF',True,CSVDataset.EOF);
|
||||
end;
|
||||
|
||||
Procedure TTestCSVDataset.TestSaveEmptyDefault;
|
||||
begin
|
||||
CSVDataset.FieldDefs.Add('a',ftString);
|
||||
CSVDataset.CreateDataset;
|
||||
AssertLines([]);
|
||||
end;
|
||||
|
||||
Procedure TTestCSVDataset.TestSaveEmptyFirstLineAsNames;
|
||||
begin
|
||||
CSVDataset.CSVOptions.FirstLineAsFieldNames:=True;
|
||||
CSVDataset.FieldDefs.Add('a',ftString);
|
||||
CSVDataset.CreateDataset;
|
||||
AssertLines(['a']);
|
||||
end;
|
||||
|
||||
Procedure TTestCSVDataset.TestSaveOneRecordDefault;
|
||||
begin
|
||||
// CSVDataset.CSVOptions.FirstLineAsFieldNames:=True;
|
||||
CSVDataset.FieldDefs.Add('a',ftString,20);
|
||||
CSVDataset.CreateDataset;
|
||||
CSVDataset.Append;
|
||||
CSVDataset.Fields[0].AsString:='b';
|
||||
CSVDataset.Post;
|
||||
AssertLines(['b']);
|
||||
end;
|
||||
|
||||
Procedure TTestCSVDataset.TestSaveOneRecordFirstLineAsNames;
|
||||
begin
|
||||
CSVDataset.CSVOptions.FirstLineAsFieldNames:=True;
|
||||
CSVDataset.FieldDefs.Add('a',ftString,20);
|
||||
CSVDataset.CreateDataset;
|
||||
CSVDataset.Append;
|
||||
CSVDataset.Fields[0].AsString:='b';
|
||||
CSVDataset.Post;
|
||||
AssertLines(['a','b']);
|
||||
end;
|
||||
|
||||
Procedure TTestCSVDataset.TestSaveTwoRecordsDefault;
|
||||
begin
|
||||
CSVDataset.FieldDefs.Add('a',ftString,20);
|
||||
CSVDataset.CreateDataset;
|
||||
CSVDataset.Append;
|
||||
CSVDataset.Fields[0].AsString:='b';
|
||||
CSVDataset.Post;
|
||||
CSVDataset.Append;
|
||||
CSVDataset.Fields[0].AsString:='c';
|
||||
CSVDataset.Post;
|
||||
AssertLines(['b','c']);
|
||||
end;
|
||||
|
||||
Procedure TTestCSVDataset.TestSaveTwoRecordsFirstLineAsNames;
|
||||
begin
|
||||
CSVDataset.CSVOptions.FirstLineAsFieldNames:=True;
|
||||
CSVDataset.FieldDefs.Add('a',ftString,20);
|
||||
CSVDataset.CreateDataset;
|
||||
CSVDataset.Append;
|
||||
CSVDataset.Fields[0].AsString:='b';
|
||||
CSVDataset.Post;
|
||||
CSVDataset.Append;
|
||||
CSVDataset.Fields[0].AsString:='c';
|
||||
CSVDataset.Post;
|
||||
AssertLines(['a','b','c']);
|
||||
end;
|
||||
|
||||
Procedure TTestCSVDataset.TestSaveOneRecord2FieldsDefault;
|
||||
begin
|
||||
CSVDataset.FieldDefs.Add('a',ftString,20);
|
||||
CSVDataset.FieldDefs.Add('b',ftString,20);
|
||||
CSVDataset.CreateDataset;
|
||||
CSVDataset.Append;
|
||||
CSVDataset.Fields[0].AsString:='c';
|
||||
CSVDataset.Fields[1].AsString:='d';
|
||||
CSVDataset.Post;
|
||||
AssertLines(['c,d']);
|
||||
end;
|
||||
|
||||
Procedure TTestCSVDataset.TestSaveOneRecord2FieldsFirstLineAsNames;
|
||||
begin
|
||||
CSVDataset.CSVOptions.FirstLineAsFieldNames:=True;
|
||||
CSVDataset.FieldDefs.Add('a',ftString,20);
|
||||
CSVDataset.FieldDefs.Add('b',ftString,20);
|
||||
CSVDataset.CreateDataset;
|
||||
CSVDataset.Append;
|
||||
CSVDataset.Fields[0].AsString:='c';
|
||||
CSVDataset.Fields[1].AsString:='d';
|
||||
CSVDataset.Post;
|
||||
AssertLines(['a,b','c,d']);
|
||||
end;
|
||||
|
||||
Procedure TTestCSVDataset.TestLoadPriorFieldDefs;
|
||||
begin
|
||||
CSVDataset.CSVOptions.FirstLineAsFieldNames:=True;
|
||||
CSVDataset.FieldDefs.Add('a',ftString,20);
|
||||
CSVDataset.FieldDefs.Add('b',ftInteger,4);
|
||||
LoadFromLines(['a,b','1,2']);
|
||||
AssertEquals('field count',2,CSVDataset.FieldDefs.Count);
|
||||
AssertEquals('field 0 name','a',CSVDataset.FieldDefs[0].Name);
|
||||
AssertEquals('field 0 size',20,CSVDataset.FieldDefs[0].Size);
|
||||
AssertEquals('field 1 name','b',CSVDataset.FieldDefs[1].Name);
|
||||
AssertEquals('field 1 size',4,CSVDataset.FieldDefs[1].Size);
|
||||
AssertEquals('field 1 typee',Ord(ftInteger),Ord(CSVDataset.FieldDefs[1].DataType));
|
||||
AssertEquals('Not Empty',False,CSVDataset.EOF and CSVDataset.BOF);
|
||||
AssertEquals('field 0 contents','1',CSVDataset.Fields[0].AsString);
|
||||
AssertEquals('field 1 contents',2,CSVDataset.Fields[1].AsInteger);
|
||||
end;
|
||||
|
||||
Procedure TTestCSVDataset.TestLoadPriorFieldDefsNoFieldNames;
|
||||
begin
|
||||
CSVDataset.FieldDefs.Add('a',ftString,20);
|
||||
CSVDataset.FieldDefs.Add('b',ftInteger,4);
|
||||
LoadFromLines(['1,2']);
|
||||
AssertEquals('field count',2,CSVDataset.FieldDefs.Count);
|
||||
AssertEquals('field 0 name','a',CSVDataset.FieldDefs[0].Name);
|
||||
AssertEquals('field 0 size',20,CSVDataset.FieldDefs[0].Size);
|
||||
AssertEquals('field 1 name','b',CSVDataset.FieldDefs[1].Name);
|
||||
AssertEquals('field 1 size',4,CSVDataset.FieldDefs[1].Size);
|
||||
AssertEquals('field 1 typee',Ord(ftInteger),Ord(CSVDataset.FieldDefs[1].DataType));
|
||||
AssertEquals('Not Empty',False,CSVDataset.EOF and CSVDataset.BOF);
|
||||
AssertEquals('field 0 contents','1',CSVDataset.Fields[0].AsString);
|
||||
AssertEquals('field 1 contents',2,CSVDataset.Fields[1].AsInteger);
|
||||
end;
|
||||
|
||||
Procedure TTestCSVDataset.TestLoadPriorFieldDefsNoFieldNamesWrongCount;
|
||||
|
||||
Var
|
||||
OK : Boolean;
|
||||
begin
|
||||
CSVDataset.FieldDefs.Add('a',ftString,20);
|
||||
CSVDataset.FieldDefs.Add('b',ftInteger,4);
|
||||
try
|
||||
LoadFromLines(['1']);
|
||||
OK:=False;
|
||||
except
|
||||
OK:=true;
|
||||
end;
|
||||
if not OK then
|
||||
Fail('Expected exception, but none raised');
|
||||
end;
|
||||
|
||||
Procedure TTestCSVDataset.TestLoadPriorFieldDefsFieldNamesWrongCount;
|
||||
|
||||
const
|
||||
EM = 'DS : CSV File Field count (1) does not match dataset field count (2).';
|
||||
Var
|
||||
OK : String;
|
||||
begin
|
||||
CSVDataset.CSVOptions.FirstLineAsFieldNames:=True;
|
||||
CSVDataset.FieldDefs.Add('a',ftString,20);
|
||||
CSVDataset.FieldDefs.Add('b',ftInteger,4);
|
||||
try
|
||||
LoadFromLines(['A']);
|
||||
OK:='Expected exception, but none raised';
|
||||
except
|
||||
on E : Exception do
|
||||
if (E.Message<>EM) then
|
||||
OK:=ComparisonMsg(EM,E.Message);
|
||||
end;
|
||||
if (OK<>'') then
|
||||
Fail(OK);
|
||||
end;
|
||||
|
||||
Procedure TTestCSVDataset.TestLoadPriorFieldDefsFieldNamesWrongNames;
|
||||
const
|
||||
EM = 'DS : CSV File field 1: name "c" does not match dataset field name "b".';
|
||||
Var
|
||||
OK : String;
|
||||
begin
|
||||
CSVDataset.CSVOptions.FirstLineAsFieldNames:=True;
|
||||
CSVDataset.FieldDefs.Add('a',ftString,20);
|
||||
CSVDataset.FieldDefs.Add('b',ftInteger,4);
|
||||
try
|
||||
LoadFromLines(['a,c']);
|
||||
OK:='No exception raised';
|
||||
except
|
||||
on E : Exception do
|
||||
if (E.Message<>EM) then
|
||||
OK:=ComparisonMsg(EM,E.Message)
|
||||
end;
|
||||
if (OK<>'') then
|
||||
Fail(OK);
|
||||
end;
|
||||
|
||||
procedure TTestCSVDataset.SetUp;
|
||||
begin
|
||||
FCSVDataset:=TCSVDataset.Create(Nil);
|
||||
FCSVDataset.Name:='DS';
|
||||
end;
|
||||
|
||||
procedure TTestCSVDataset.TearDown;
|
||||
begin
|
||||
FreeAndNil(FCSVDataset);
|
||||
end;
|
||||
|
||||
Initialization
|
||||
|
||||
RegisterTest(TTestCSVDataset);
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user