{**************************************************************
 ***                                                        ***
 ***                     FOR ALL JIMMYS                     ***
 ***                                                  Mar 97***
 **************************************************************}
{$I compflgs}
unit AllJimmy;

interface

uses jimmys;

type
	TDoWhatProc = procedure(var JImmy : PJimmy; var RecSize : word);
	TOnNilDoWhatProc = Procedure(srtype : longint; var REcNo : longint); {do what on finding nil}

function ForAllJimmys(MsgTitle,MsgMsg : string; DoWhat : TDoWhatProc; OnNilDoWhat : TOnNilDoWhatProc) : word;

{for use with above}
procedure DoClearJimmyPtrs(	var JImmy : PJimmy; var RecSize : word);
procedure DoJimmyStoreSelf(	var Jimmy : PJimmy; var RecSize : word); {forces re-index}
procedure DoJimmyPut(				var Jimmy : PJimmy; var RecSize : word);

procedure OnNilDoStd(srType : longint; var RecNo : longint);

implementation

uses
	tuimsgs,
	global,
	files,
	dbg,
	help,
	indexes,
	indxutil,
	tasks,
	ordproc, kinvoice,
	minilib;

const
	MaxIndexTime = 4;  {if longer or equal to this num secs, do a rehole}
	{minimum sensible seems to be 3}

{****************************************************************************
 ***                                                                      ***
 ***                           FOR ALL JIMMYS                             ***
 ***                                                                      ***
 ****************************************************************************}
{A general purpose routine that runs through the jimmy file picking up each
jimmy and running the DoWhat procedure with that jimmy as a parameter.  With
checking for nil pointers, etc.

Useful for updates, reconstructing below, etc

Returns cmCancel if progress box cancelled}

procedure OnNilDoStd;
begin
	{certain old srtypes that we know about - makes it faster and reduces
	risk of rubbish producing jimmy srtypes}
	case srtype of
		1016 : RecNo := RecNo + 380; {v2 alternative address (!)}
		1018 : RecNo := RecNo + 100; {v3 invoice (!)}
		1037 : RecNo := RecNo + 250; {product}
		1041 : RecNo := RecNo + 480; {old company}
		1040 : REcNo := RecNo + 360;{530; {old person}
		1052 : RecNo := RecNo + 100; {purchase order}
		1054 : RecNo := RecNo + 100; {packing slip}
		1071 : RecNo := RecNo + 360; {staff/users on non-user systems}
		1072 : RecNo := RecNo + 360; {new person}
		1105 : RecNo := RecNo + 100; {old? membership?}
		1106 : RecNo := RecNo + 250; {address - early v4.1}
		1123 : RecNo := RecNo + 100; {sales order}
		1127 : RecNo := RecNo + 100; {letter}
		1130 : RecNo := RecNo + 404; {no idea - size guessed}
		1250 : RecNo := RecNo + 20; {old diary repeater}
	else
		INC(RecNo);
	end;
end;

type
	PVMTTable = ^TVMTTable;
	TVMTTable = record
		Size : integer;
		NSize : integer;
		DMT : word;
		NU : word;
		Ptr : array[1..999] of pointer;  {use pvmttable()^ not tvmt!}
	end;

function JImmyDescendant(const Jimmy : PJimmy) : boolean;
var	I : integer;
		vmt : PVMTTable;
		L : integer;

begin
	JimmyDescendant := False;

	if Jimmy<>nil then begin
		{look at vmt table and look through for pointer to Jimmymarker}
		vmt := typeof(Jimmy^);

		if vmt^.size=-vmt^.nsize then begin
			L := VMT^.Size div 4;
			for I := 1 to L do
				if VMT^.Ptr[I]=@TJimmy.JimmyMarker then
					JimmyDescendant := True;
		end;

	end;

end;



function ForAllJimmys(MsgTitle,MsgMsg : string; DoWhat : TDoWhatProc; OnNilDoWhat : TOnNilDoWhatProc) : word;
var ProBox : PProgressBox;
		OJimmyRec, JimmyRec : longint;
		Jimmy : PJimmy;
		WarnNil : boolean;
		Srtype : integer;
		RecSize : word;
		Mem : longint;

begin
	FileAdmin(fiJimmys)^.LogOn;

	ProBox := NewProgressBox(MsgTitle,'',mfSkipButton or mfCancelButton, hcNoContext);
	WarnNil := True;

	JimmyRec := 0;  {dbg}
	while (JimmyREc<JimmyStream^.NoRecs) and (ProBox^.Command<>cmCancel) and (ProBox^.Command<>cmSkip) do begin

		ProBox^.Update(MsgMsg+#13#10,JimmyRec, JimmyStream^.NoRecs-1);

		Mem := MemAvail;

		if WarnNil then Debug.Writeln('Doing '+N2Str(JimmyRec)+'...');{}

		if JimmyRec=100 then Jimmy := nil else
			Jimmy := PJImmy(JimmyStream^.GetAt(JimmyRec));

		{check it's a descendant of TJImmy....}
		if (Jimmy<>nil) and not JimmyDescendant(Jimmy) then begin
			dispose(Jimmy, done);
			Jimmy := nil;
			JimmyStream^.Seek(JimmyRec);
			JimmyStream^.Read(JimmyStream^.ErrorInfo, 2); {read ID}
		end;

{if Jimmy<>nil then
	DebugNote('Fixit: before get mem:'+N2Str(Memavail)+' ID '+N2Str(Jimmy^.RecNo)
				+' sr'+N2Str(Jimmy^.srType));{}

		if Jimmy<>nil then begin

			RecSize := Jimmy^.RecSize; {do before dowhat in case jimmy changes}

			if @DoWhat<>nil then DoWhat(Jimmy, RecSize);

			OJimmyREc := JimmyRec;
			JimmyREc := JimmyREc + RecSize;
			WarnNil := True;

			if Jimmy<>nil then begin
				srType := Jimmy^.srType; {for below, memory check}
				dispose(Jimmy, done);
			end;

		end else begin
			srType := JimmyStream^.ErrorInfo;
			JimmyStream^.Reset;

			OJimmyRec := JimmyRec;
			OnNilDoWhat(srType, JimmyRec);{}
{			inc(JimmyRec);{}

			if (WarnNil) or (JimmyRec<>OJimmyRec+1) then begin
				Debug.Writeln('NIL JIMMY AT '+N2Str(OJimmyRec)+' srType='+N2Str(srType));{}
{				ProgramWarning('nil JImmy At '+N2Str(OJimmyRec)+#13#10
													+' srType='+N2Str(srType),hcInternalErrorMsg);{}
				if JimmyRec=OJimmyRec+1 then WarnNil := False;
												{so it doesn't keep warning while it looks for the next, if no old srtype known}
			end;

		end;

		if Mem>MemAvail then
			Debug.Writeln('after above, mem from '+N2Str(Mem)+' to '+N2Str(MemAvail)+' ='+N2Str(mem-memavail)+' loss');

{DebugNote('Fixit: after disp mem:'+N2Str(Memavail)+' Change '+N2Str(Mem-MemAvail));{}
{		if Mem>MemAvail then
				ProgramWarning('Leaking heap? #'+N2Str(OJimmyRec)+' srtype '+N2Str(srtype)+#13#10
																				+N2Str(Mem-MemAvail)+' bytes');{}

	end;

	FileAdmin(fiJimmys)^.LogOff;

	ForAllJimmys := ProBox^.Command;

	dispose(ProBox, done);
end;




{****************************************************************************
 ***                                                                      ***
 ***                           RE-CONSTRUCT ADMIN                         ***
 ***                                                                      ***
 ****************************************************************************}
{Reconstructs the admin files - ie hooks and indexes - from the main jimmy
data file.  Effectively also does an update of all jimmys as they all get

Before running this, delete all *.idx and *.cha.

It RUns through the jimmy data file, getting each jimmy, storing a blank
one so new indexes, etc are created, and then doing a storeself. It is
(I think) interruptable to make holes, etc}

procedure DoClearJimmyPtrs(var JImmy : PJimmy; var RecSize : word);
var B,fiType : byte;
begin
	{Clear pointers}
	for B := 0 to 15 do begin
		if Jimmy^.GetIdxPtr(B)>-1 then Jimmy^.SetIdxPtr(B, -1);
		if Jimmy^.GetFirstHookPtr(B)>-1 then Jimmy^.SetFirstHookPtr(B, -1);
		if Jimmy^.GetopPtr(B)>-1 then Jimmy^.SetopPtr(B, -1);
	end;

	{if an order, clear TotallerGroup}
	case Jimmy^.srType of
		srInvoice, srEstimate, srSalesOrder, srPurchaseOrder : begin
			POrder(Jimmy)^.TotallerGroup.Init; {clear}
			POrder(Jimmy)^.TotallerGroup.Calculate(False);
		end;
	end;
	if Jimmy^.srType = srInvoice then begin
		PInvoice(Jimmy)^.PaidTotal.Clear;
		PInvoice(Jimmy)^.LastPmnt.Clear;
		PInvoice(Jimmy)^.Due.Clear;
	end;

	JimmyStream^.PutAt(Jimmy^.RecNo, Jimmy);
end;



procedure DoJimmyStoreSelf(var Jimmy : PJimmy; var RecSize : word);
var fiType, ixtype, hktype, htType, lastfiType : byte;
		Key : longint;
		PL,BHookToID,BSubHookToID,HookToID,SubHookToID : PLongint;
		BlankJimmy : PJimmy;
		InsBias, BInsBias : boolean;

begin
	{Blank the jimmy on disk so that the keys are changed and a re-index
	is forced}
	BlankJimmy := Create(Jimmy^.srType, nil);
	if blankjimmy = nil then exit; {obsolete srtype}
	BLankJimmy^.RecNo := Jimmy^.RecNo;

	BlankJimmy^.LoadAllPtrs; {load all index & hooking on pointers}
	{also need to load hooking to pointers so that the jimmy can be unhooked properly}
	for htType := 1 to BlankJimmy^.NumHookTo do begin
		BlankJimmy^.GetHookTo(htType, BHookToID, BSubHookToID, hkType, Key, BInsBias);
		Jimmy^.GetHookTo(htType, HookToID, SubHookToID, hkType, Key, InsBias);
		if (BHookToID<>nil) then BHookToID^ := HookToID^;
		if BSubHookToID<>nil then BSubHookToID^ := SubHookToID^;
	end;

	PutJimmy(BlankJimmy);
	dispose(BlankJimmy, done);

	Jimmy^.StoreSelf;

	{add holes?}
	if Jimmy^.InsertTime.Secs>=MaxIndexTime then begin
		fitype := 0;
		for ixType := 0 to Jimmy^.NumixTypes do begin
			lastfitype := fitype; {so it doesn't keep doing same one over and over}
			Jimmy^.GetIndex(ixType, PL, fiType);
			if (fiType<>0) and (fitype<>lastfitype) then begin
				FileAdmin(fiType)^.LogOn;
				MakeHoles(PIndexStream(Stream(fiType)), 2);
				FileAdmin(fiType)^.logoff;
			end;
		end;
	end;
end;

{procedure DoJimmyStoreSelf(var Jimmy : PJimmy);
var BlankJimmy : PJimmy;
		fiType : byte;

begin
	{Store blank jimmy of right type so keys are "changed"}
{	BlankJimmy := Create(Jimmy^.srType, nil);
	BLankJimmy^.RecNo := Jimmy^.RecNo;
	JImmyStream^.PutAt(Jimmy^.RecNo, BlankJimmy);

	dispose(BlankJimmy, done);

	Jimmy^.StoreSelf;

	if InsertTime.Secs>3 then {see jimindxs}
{		for fiType:=1 to 99 do
			if FIleAdmin(fiType)<>nil then begin
				FileAdmin(fiType)^.LogOn;
				if Right(Stream(fiType)^.FileName,3)='IDX' then
					MakeHoles(PIndexStream(Stream(fiType)), 2);
				FileAdmin(fiType)^.LogOff;
			end;
end;{}


procedure DoJimmyPut(var Jimmy : PJimmy; var RecSize : word);
begin
	JimmyStream^.PutAt(Jimmy^.RecNo, Jimmy);
end;





end.
