{****************************************************************************
 ***                                                                      ***
 ***                        ASCII IMPORT                                  ***
 ***                                                                      ***
 ****************************************************************************}
{provides some routines for helping to import from ascii csv files, but as yet
no super-dooper general purpose method.  An example at the end for importing
for mum's referendum party database}
unit KImport;

interface

implementation

uses
		files,
		kperson, jimmys,
		objects,
		tasks,
		global,
		lstrings,
		address,
		dosutils, indexes,
		help,
		views,
		tuiboxes, stddlg,
		tuimsgs,
		indxutil, jimindxs,
		messtext,
{		alljimmy,{}
		minilib;

{*******************************************************
 ***             IMPORT TOOLS                        ***
 *******************************************************}
{Provides a way of defining in what order the fields are to be arranged
prior to inserting into the relevant Kameleon object, etc, etc}
{NumFields is the number of fields to read from each line}

type
	TImportCriteria = record
		NumFields : word;
		LinesToSkip : word; {number of lines to skip at beginning of file}
		Title : String;
	end;


{============= FIELDS ==============================}

type
	PFields = ^TFields;
	TFields = array[1..99] of PString;

procedure NilFields(var Field : TFields);
var I : word;
begin
	for I := 1 to 99 do Field[i] := nil;
end;

procedure ClearFields(var Field : TFields);
var I : word;
begin
	for I := 1 to 99 do
		if Field[I]<>nil then begin
			disposeStr(Field[I]);
			Field[I] := nil;
		end;
end;

type
	TInterpretProc = procedure (var Fields : PFields; var srType : word);


{*******************************************************
 ***             READ A LINE OF FIELDS INTO ARRAY    ***
 *******************************************************}


function ReadFields(var CSVFile : text; const Criteria : TImportCriteria; var Field : TFields) : longint;
var CurrField,S : string;
		FieldNo : word;
		DoneBytes : longint;

	procedure GetNextField;
	begin
		DoneBytes := DoneBytes + ReadCSV(CSVFile, CurrField);
		CurrField := delspace(CurrField);
	end;

begin
	ClearFields(Field);	{clear array}

	{read array}
	DoneBytes := 0;

	for FieldNo := 1 to Criteria.NumFields do begin
		GetNextField;
		Field[FieldNo] := NewStr(CurrField);
	end;

	{throw away rest of line}
	readln(CSVFile,S);
	ReadFields := DoneBytes + length(S)+2;
end;


{*********************************************************************
 ***                                                               ***
 ***                      IMPORT OBJECTS                           ***
 ***                                                               ***
 *********************************************************************}

{********************************************
 ***            IMPORT PERSON             ***
 ********************************************}
procedure ImportPerson(const Field : TFields);
var Person,DupPerson : PPerson;
		Dups : integer;
		IdxRec, HoleRec, WorkID : longint;
		ixType, fiType : byte;
		I : integer;
		Control : word;

	function GetField(const FieldNo : word) : string;
	begin
		if Field[FieldNo]=nil then GetField := '' else GetField := Field[FieldNo]^;
	end;


begin
	New(Person, init(nil));

	with Person^ do begin
		Tag := True; {so we can immediately pick out imported ones}

		Surname := GetField(1);
		ForName := GetField(2);
		Title 	:= GetField(3);
		DearName:= GetField(4);
		JobTitle:= GetField(6);
		Dept		:= GetField(7);

		New(Address, init(nil));

		with Address^ do begin
			adType := adUK;

			for I := 1 to 6 do
				Line[I] := NewStr(GetField(I+7));

			for I := 1 to 3 do
				Tel[I] := NewStr(GetField(I+13));

			Fax := NewStr(GetField(17));
		end;

		CategoryCodes := GetField(18);
		LSAppendStr(Comment^.Text, GetField(19));
	end;

	{check for duplicates}

	Dups := IndexStream(fiFullDirIdx)^.FindMatch(Person^.GetIndexKey(1), IdxRec, Holerec, WorkID);

	if Dups<>-1 then begin
		{if it seems duplicate, check the postcode}
		DupPerson := PPerson(PIndexedJimmyStream(Stream(fiFullDirIdx))^.GetJimmyAtIdx(IdxREc));

		if (DupPerson^.Title<>'') and (Person^.Title<>'')	and (ucase(Person^.Title)<>ucase(DupPerson^.Title)) then Dups := -1;

		if (Dups<>-1) and (DupPerson^.GetAddress^.Postcode<>'') and (Person^.GetAddress^.Postcode<>'')
			and (Person^.GetAddress^.PostCode<>DupPerson^.GetAddress^.postCode) then Dups := -1;

		dispose(DupPerson, done);
	end;

	if Dups<>-1 then
{		Control := MessageBox('IMPORT','Duplicate already exists for'#13#10+
															Person^.GetName(naDisplay,0)+#13#10+
															'Add anyway?', mfYesNoCancel or mfWarning){}
		Control := cmNo {ignore duplicates}
	else
		Control := cmYes;

	if Control = cmYes then begin
		{store}
		Person^.StoreSelf;
		Person^.Address^.ForWho := Person^.RecNo;
		Person^.Address^.StoreSelf;
		Person^.AddressID := Person^.Address^.RecNo;
		Person^.LoadAllPtrs;
		PutJimmy(Person);

		CheckToDoHoles(Person);
	end;

	dispose(Person, done);
end;



{*********************************************************************
 ***                                                               ***
 ***                      TRANSLATIONS                             ***
 ***                                                               ***
 *********************************************************************}

{**************************************
 **         REFERENDUM PARTY         **
 **************************************}
procedure SetRefPartyCriteria(var Criteria : TImportCriteria);
begin
	with Criteria do begin
		NumFields := 14;
		LinesToSkip := 1;
		Title := 'REFERENDUM';
	end;
end;

{Converts fields as read from file into fields as expected by ImportPerson, etc:
"DESCR","DESCR","TITLE","FORENAME","INITIALS","SURNAME","ADD1","ADD2","ADD3","ADD4","ADD5","POST_CODE","TEL_HOME","TEL_WORK"
{}
{Oh dear, they've changed the layout again...:
1        2       3          4          5         6            7        8      9      10     11     12     13          14
"DESCR","TITLE","FORENAME","INITIALS","SURNAME","HONOURIFIC","STATUS","ADD1","ADD2","ADD3","ADD4","ADD5","POST_CODE","WARD_COD
{}

const
	ffTitle = 2;
	ffForeName = 3;
	ffInitials = 4;
	ffSurname = 5;
	ffHonour = 6;
	ffStatus = 7;
	ffAddStart = 8; ffNumAdd = 5;
	ffPostcode = 13;
	ffWard = 14;


procedure RefPartyInterpret(var Field : PFields; var srtype : word); far;
var StdField : PFields;
		C : string;
		I : word;

	function FileField(FieldNo : word) : string;
	var S : string;
	begin
		if Field^[FieldNo]=nil then
			FileField := ''
		else begin
			S := Field^[FieldNo]^;
			if S = ucase(S) then S := CapitalInitials(S); {lower case with capital initials}
			FileField := S;
		end;
	end;


begin
	srType := srPerson; {is always}

	New(StdField);
	NilFields(StdField^);

	StdField^[1] := NewStr(FileField(ffSurname)); {surname}
	if FileField(ffForename)<>'' 	then StdField^[2] := NewStr(FileField(ffForeName))
																else StdField^[2] := NewStr(FileField(ffInitials)); {forname}
	if FileField(ffHonour)<>'' 		then StdField^[3] := NewStr(FileField(ffHonour))
																else StdField^[3] := NewStr(FileField(ffTitle)); {title}

	{address}
	for I := 0 to ffNumAdd-1 do
		StdField^[8+I] := NewStr(FileField(ffAddStart+I));
	if StdField^[11]<>nil then StdField^[11]^ := Ucase(StdField^[11]^); {upper case town}
	StdField^[13] := NewStr(ucase(FileField(ffPostcode))); {postcode}

	{tel no}
{	if FileField(13)<>'' then StdField^[14] := NewStr(FileField(13)+' home');
	if FileField(14)<>'' then StdField^[15] := NewStr(FileField(14)+' work');{}

	{categories}
	C := ucase(Copy(FileField(ffStatus),1,2)); 				{first 2 letters of type - eg helper, etc}
	C := C + ' '+ucase(Copy(FileField(ffWard),4,3));	{ward code}


	StdField^[18] := NewStr(C);


	ClearFields(Field^);
	Dispose(Field);

	Field := StdField;
end;

{************************************************************************
 ***                                                                  ***
 ***                      IMPORT FILE                                 ***
 ***                                                                  ***
 ************************************************************************}

procedure ImportFile(CSVFileName : FNameStr; Criteria : TImportCriteria; InterpretProc : TInterpretProc);
var	S : string;
		Control : word;
		srType : word;
		CSVFile : text;
		Field : PFields;
		Line : word;
		ProBox : PProgressBox;
		DoneBytes : longint;
		TotBytes : longint;
		LastIOError : longint;

begin
	Control := MessageBox('IMPORT','All imported entries will be tagged'#13#10
													+'Do you want to clear existing tags?',
													mfYesNoCancel + mfConfirmation,
													hcUntagAll);

	if Control = cmCancel then exit;
	{note that control is handled below, after everything is opened, etc}

	TotBytes := GetFileSize(CSVFileName);

	{$I-}
	Assign(CSVFile, CSVFileName);
	reset(CSVFIle);
	{$I+}
	LastIOError := IOResult;
	if LastIOError<>0 then begin
		ProgramWarning('Could not open Import File '+CSVFIleName+#13#10
										+IOError(LastIOError),
										hcIOErrorMsg);
		exit;
	end;

	Line := 0;
	DoneBytes := 0;

	FileAdmin(fiFullDirIdx)^.LogOn;
	FileAdmin(fiJimmys)^.LogOn;

	{clear tags, from box above}
	if Control = cmYes then
		PIndexedJimmyStream(Stream(fiFullDirIdx))^.TagAll(1, fiFullDirIdx, 0, Stream(fiFullDirIdx)^.NoRecs-1);

	ProBox := NewProgressBox('IMPORT '+Criteria.Title,space(30),mfCancelButton, hcNoContext);

	New(Field);
	NilFields(Field^);

	while not eof(CSVFile) and (ProBox^.Command<>cmCancel) and (Control<>cmCancel) do begin
		inc(Line);

		ProBox^.Update('Done Bytes ',DoneBytes, TotBytes);

		if Line<=Criteria.LinesToSkip then begin
			{ignore first line}
			Readln(CSVFile,S);
			DoneBytes := DoneBytes + length(S)+2;
		end else{} begin

			{--- Import One Line ----}
			DoneBytes := DoneBytes + ReadFields(CSVFile, Criteria, Field^);
			InterpretProc(Field, srType);

			case srType of
				srPerson : ImportPerson(Field^);
				0 : ProgramWarning('Could not decode line '+N2Str(Line), hcImport);
			else
				ProgramWarning('Not sure what to do with srtype='+N2Str(srType)+#13#10
												+'Line '+N2Str(Line), hcInternalErrorMsg);
			end;

		end; {line passed 1}
	end; {while not eof}

	Close(CSVFile);

	FileAdmin(fiFullDirIdx)^.LogOff;
	FileAdmin(fiJimmys)^.LogOff;

	dispose(ProBox, done);
end;



{====================== USER IMPORT =========================}
procedure Import; far;
var CSVFileName : FNameStr;
		Control : word;
		Criteria : TImportCriteria;

begin
	{---- Ask for which import --------}


	{Referendum party}
	CSVFileName := '';
	SetRefPartyCriteria(Criteria);

	Control := FileSelectBox('IMPORT '+Criteria.Title,'CSV File', CSVFileName, 'CSV', '',
																fdAcceptButton + fdFullPath, hcNoContext);

	if Control <>cmAccept then exit;

	ImportFile(CSVFileName, Criteria, RefPartyInterpret);
end;



begin
	RegisterTask(DesktopTasks, cmImport, @Import);
end.








