-- MoveFilesImpl.mesa
-- last edit by Schmidt, January 6, 1983 2:02 pm
-- last edit by Satterthwaite, February 9, 1983 10:33 am


DIRECTORY
  ConvertUnsafe: TYPE USING[ToRope],
  CWF: TYPE USING [FWF1, FWF2, SWF1, SWF2, SWF4, WF0, WF1, WF2, WF3, WF4],
  DateAndTimeUnsafe: TYPE USING [Parse],
  Dir: TYPE USING [FileInfo],
  Directory: TYPE USING [DeleteFile, Error, Handle, ignore, Lookup, Rename],
  File: TYPE USING [Capability, Unknown],
  FileStream: TYPE USING [GetLength, SetIndex],
  MDModel: TYPE USING [GetBcdCreate, GetFileInfo, GetSrcCreate, LOCSymbol, MODELSymbol, 
  	NarrowToLOC, Symbol, SymbolSeq, TraverseTree],
  MDUtil: TYPE USING [PrintNewModelStream],
  MoveFiles: TYPE USING [],
  IO: TYPE USING[Handle],
  STPSubr: TYPE USING [AddUserName, CachedRetrieve, Connect, HandleSTPError,
  	StpStateRecord, StopSTP, Store],
  Stream: TYPE USING [Delete, Handle, PutChar],
  Subr: TYPE USING [AbortMyself, CheckForModify, errorflg, FileError, 
  	GetCreateDate, NewStream, SetRemoteFilenameProp, TTYProcs, Write],
  Time: TYPE USING [Current],
  TypeScript: TYPE USING[TS, UserAbort],
  UnsafeSTP: TYPE USING [Enumerate, Error, FileInfo, GetFileInfo, Handle, NoteFileProcType],
  ViewerClasses: TYPE USING[Viewer],
  ViewerOps: TYPE USING[FindViewer, RestoreViewer];
	
MoveFilesImpl: PROGRAM
IMPORTS
	ConvertUnsafe, CWF, DateAndTimeUnsafe, Directory, File, FileStream,
	MDModel, MDUtil, STP: UnsafeSTP, STPSubr, Stream, Subr, Time, TypeScript, ViewerOps 
EXPORTS MoveFiles = {

useCIFS: BOOL = FALSE;

-- think of this as running in the monitor of MDMainImpl
InternalPermanentOrTemporary: PUBLIC PROC[symbolseq: MDModel.SymbolSeq,
	working: MDModel.LOCSymbol, temporary, force: BOOL, typeScript: TypeScript.TS, 
	ttyout: IO.Handle, window: Subr.TTYProcs] = {
ENABLE {
	STP.Error => {
		CWF.WF0["FTP Error. "L];
		IF error ~= NIL THEN CWF.WF1["message: %s\n"L,error];
		GOTO leave;
		};
	};
nxfer: CARDINAL _ 0;
changes: BOOL _ FALSE;
outofspace: BOOL _ FALSE;
logsh: Stream.Handle _ NIL;
fi: Dir.FileInfo;

	ProcFile: PROC[spl: MDModel.Symbol, spmodel: MDModel.MODELSymbol] 
		RETURNS[proceed: BOOL _ TRUE] = {
	sploc: MDModel.LOCSymbol;
	name: STRING _ [100];
	IF spl.stype ~= typeLOC THEN RETURN;
	sploc _ MDModel.NarrowToLOC[spl];
	IF sploc.nestedmodel ~= NIL THEN {
		-- this may make a new model
		IF sploc.nestedmodel.modelchanged OR force THEN {
			changes _ TRUE;
			MakeANewModel[sploc, symbolseq, typeScript, ttyout, window];
			};
		-- given there may be a new model,
		-- we must update the next model higher up with
		-- the new version stamp
		IF sploc.nestedmodel.modelcreate ~= sploc.createtime THEN {
			fi _ MDModel.GetFileInfo[sploc];
			fi.srcNotSaved _ TRUE;
			sploc.createtime _ sploc.nestedmodel.modelcreate;
			};
		};
	IF temporary OR outofspace THEN RETURN;
	fi _ MDModel.GetFileInfo[sploc];
	IF fi.srcPresent AND fi.srcNotSaved THEN {
		-- transfer it
		stored: BOOL _ FALSE;
		[stored, logsh] _ StoreTheFile[sploc, typeScript, window, logsh
		! STP.Error => IF code = undefinedError OR code = requestRefused THEN {
			CWF.WF1["\nError - %s\n"L, error];
			CWF.WF0["Only some of the files have been transferred.\n"L];
			CWF.WF0["Go and clean up your remote directories, then run XPermanent\n"L];
			CWF.WF0["EXACTLY as you did this time.\n"L];
			Subr.errorflg _ TRUE;
			outofspace _ TRUE;
			GOTO out;
			}];
		IF stored THEN nxfer _ nxfer + 1;
		fi.srcNotSaved _ FALSE;
		EXITS
		out => NULL;
		};
	};
	
-- IF temporary THEN Dir.WriteOutUnsavedFiles[];
IF temporary AND force THEN [] _ ProcFile[working, NIL]	-- only top one
ELSE -- postorder is important here!
	MDModel.TraverseTree[symbolseq.toploc, symbolseq, 
		ProcFile, FALSE];
IF NOT temporary THEN {
	IF logsh ~= NIL THEN Stream.Delete[logsh];
	logsh _ NIL;
	STPSubr.StopSTP[];
	CWF.WF1["%u files stored.\n"L, @nxfer];
	IF NOT outofspace THEN
		Directory.DeleteFile["NonPermanentFiles"L
		! File.Unknown => {	-- bugs in directory package
			CWF.WF0["Log: File/Directory Error.\n"L];
			CONTINUE;
			};
	  	Directory.Error => CONTINUE
		];
	};
IF NOT changes THEN { 
	CWF.WF0["Nothing has been changed in the file,"L];
	CWF.WF0[" the model doesn't have to be saved.\n"L];
	};
EXITS
leave => NULL;
};

-- called by InternalTemporaryOrPermanent
MakeANewModel: PROC[sproot: MDModel.LOCSymbol, symbolseq: MDModel.SymbolSeq, 
	typeScript: TypeScript.TS, ttyout: IO.Handle,
	window: Subr.TTYProcs] = {
oldname: STRING _ [100];
sh: Stream.Handle;
spmodel: MDModel.MODELSymbol;
spmodel _ sproot.nestedmodel;
CWF.SWF1[oldname, "%s$"L, spmodel.modelfilename];
CWF.WF1["Old model on %s,"L, oldname];
IF Subr.CheckForModify[oldname, window] THEN {
	Directory.DeleteFile[fileName: oldname ! Directory.Error => CONTINUE];
	Directory.Rename[oldName: spmodel.modelfilename, newName: oldname];
	IF Subr.CheckForModify[spmodel.modelfilename, window] THEN {
		log: ViewerClasses.Viewer;
		sh _ Subr.NewStream[spmodel.modelfilename, Subr.Write];
		-- printing w/o defaults
		MDUtil.PrintNewModelStream[symbolseq, sproot, sh, NIL,
			 TRUE, typeScript, ttyout];
		Stream.Delete[sh];
		spmodel.modelcap _ Directory.Lookup[fileName: spmodel.modelfilename,
			permissions: Directory.ignore];
		spmodel.modelcreate _ Subr.GetCreateDate[spmodel.modelcap];
		spmodel.modelchanged _ FALSE;		-- reset
		CWF.WF1[" new model on %s.\n"L, spmodel.modelfilename];
		log _ ViewerOps.FindViewer[ConvertUnsafe.ToRope[spmodel.modelfilename]];
		IF log ~= NIL THEN ViewerOps.RestoreViewer[log];
		};
	};
};

-- called by MakeDepSeqForFile in MDDBImpl
BringOverRemoteFile: PUBLIC PROC[sploc: MDModel.LOCSymbol, makethismodel: BOOL,
	typeScript: TypeScript.TS, window: Subr.TTYProcs] = {
retrieved, present: BOOL;
fn: LONG STRING;
time: LONG CARDINAL;
fi: Dir.FileInfo _ MDModel.GetFileInfo[sploc];
fi.alreadyLookedFor _ TRUE;
IF (fi.isBcd AND (NOT fi.bcdPresent OR MDModel.GetBcdCreate[fi] ~= sploc.createtime)) THEN {
	fn _ fi.bcdFileName;
	time _ MDModel.GetBcdCreate[fi];
	present _ fi.bcdPresent;
	}
ELSE IF (NOT fi.isBcd AND (NOT fi.srcPresent OR MDModel.GetSrcCreate[fi] ~= sploc.createtime)) THEN {
	fn _ fi.srcFileName;
	time _ MDModel.GetSrcCreate[fi];
	present _ fi.srcPresent;
	}
ELSE RETURN;	-- files already here
IF TypeScript.UserAbort[typeScript] THEN SIGNAL Subr.AbortMyself;
IF NOT present THEN {
	-- retrieve from remote servers	
	retrieved _ RetrieveTheFile[sploc, typeScript, window];
	IF NOT retrieved THEN {
		CWF.WF1["RemoteRetrieve: Can't find %s.\n"L, fn];
		RETURN;
		};
	time _ IF fi.isBcd THEN MDModel.GetBcdCreate[fi] ELSE MDModel.GetSrcCreate[fi];
	};
IF time ~= sploc.createtime THEN {
	IF makethismodel AND sploc.createtime ~= 0 THEN {
		-- retrieve from remote servers
		[] _ RetrieveTheFile[sploc, typeScript, window];
		time _ IF fi.isBcd THEN MDModel.GetBcdCreate[fi] ELSE MDModel.GetSrcCreate[fi];
		};
	};
IF sploc.createtime ~= 0 AND time ~= sploc.createtime THEN 
	CWF.WF3["RemoteRetrieve: You wanted %s of %lt but %lt is on the disk.\n"L,
		fn, @sploc.createtime, @time];
};

-- these are procedures to retrieve and store files
RetrieveTheFile: PROC[sploc: MDModel.LOCSymbol, typeScript: TypeScript.TS, window: Subr.TTYProcs] 
	RETURNS[retrieved: BOOL] = {
stpStateRecord: STPSubr.StpStateRecord _ [];
cap: File.Capability;
fi: Dir.FileInfo;
retrieved _ FALSE;
IF useCIFS THEN {
	-- will use Cedar features
	-- cap _ RetFiles[sploc, srcsfn, usedirseq, window];
	RETURN;
	};
IF sploc.host = NIL OR sploc.path = NIL THEN RETURN[FALSE];
IF TypeScript.UserAbort[typeScript]THEN SIGNAL Subr.AbortMyself;
fi _ MDModel.GetFileInfo[sploc];
-- look for source
IF NOT fi.isBcd THEN {
	cap _ STPSubr.CachedRetrieve[sploc.host, sploc.path, fi.srcFileName, 0, 
		sploc.createtime, window, @stpStateRecord, FALSE, TRUE
		! Subr.FileError => {
		IF error = notFound THEN
			CWF.WF3["File/Directory [%s]<%s>%s not found.\n"L,  
				sploc.host, sploc.path, fi.srcFileName]
			ELSE CWF.WF4["File [%s]<%s>%s of %lt not found.\n"L, 
				sploc.host, sploc.path, fi.srcFileName, @sploc.createtime];
			GOTO leave
			}];
	fi.srcDepSeq _ NIL;
	fi.srcPresent _ TRUE;
	fi.srcCap _ cap;
	fi.srcCreate _ sploc.createtime;
	};
IF TypeScript.UserAbort[typeScript] THEN SIGNAL Subr.AbortMyself;
-- now consider the bcd
IF TypeScript.UserAbort[typeScript] THEN SIGNAL Subr.AbortMyself;
cap _ STPSubr.CachedRetrieve[sploc.host, sploc.path, fi.bcdFileName, 
	0, 0, window, @stpStateRecord, FALSE, TRUE
	 ! Subr.FileError => {
		CWF.WF3["File/Directory [%s]<%s>%s not found.\n"L, 
			sploc.host, sploc.path, fi.bcdFileName];
		GOTO leave;
	}];
fi.bcdDepSeq _ NIL;
fi.bcdPresent _ TRUE;
fi.bcdCap _ cap;
fi.bcdCreate _ 0;	-- will be recomputed
retrieved _ TRUE;
EXITS
leave => RETURN[FALSE];
};

-- first look and see if the file is already out there,
-- if not, store it
StoreTheFile: PROC[sploc: MDModel.LOCSymbol, typeScript: TypeScript.TS, window: Subr.TTYProcs,
	oldlogsh: Stream.Handle] RETURNS[actuallyxferred: BOOL _ FALSE,
	newlogsh: Stream.Handle] = {
nbytes: LONG CARDINAL;
longname: STRING _ [100];
fullname: STRING _ [125];
stphandle: STP.Handle;
info: STP.FileInfo;
found: BOOL _ FALSE;
pattern: STRING _ [100];
time: LONG CARDINAL;
logfile: STRING _ [100];
fi: Dir.FileInfo;

	WFStore: PROC[ch: CHAR] = {
	Stream.PutChar[newlogsh, ch];
	};
	
	EnumProcessFile: STP.NoteFileProcType = {
	info: STP.FileInfo;
	continue _ yes;
	info _ STP.GetFileInfo[stphandle];
	IF found OR time ~= DateAndTimeUnsafe.Parse[info.create].dt THEN RETURN;
	found _ TRUE;
	};
	
newlogsh _ oldlogsh;
IF TypeScript.UserAbort[typeScript] THEN SIGNAL Subr.AbortMyself[];
IF sploc.host = NIL OR sploc.path = NIL THEN RETURN[FALSE, newlogsh];
fi _ MDModel.GetFileInfo[sploc];
IF NOT fi.srcPresent THEN ERROR;
CWF.SWF2[longname, "<%s>%s"L, sploc.path, fi.srcFileName];
time _ MDModel.GetSrcCreate[fi];
CWF.SWF1[pattern, "%s!**"L, longname];
-- first look and see where it is
stphandle _ STPSubr.Connect[host: sploc.host, h: window, onlyOne: TRUE];
STP.Enumerate[stphandle, pattern, EnumProcessFile
	! STP.Error => IF code = noSuchFile THEN CONTINUE
	ELSE IF STPSubr.HandleSTPError[stphandle, code, error, 
		window] THEN RETRY;
	];
IF found THEN {
	CWF.WF2["Store [%s]%s ... not necessary.\n"L, sploc.host, longname];
	RETURN;		-- need to xfer it
	};
--
-- aha   we must xfer it
--
actuallyxferred _ TRUE;
IF TypeScript.UserAbort[typeScript] THEN SIGNAL Subr.AbortMyself;
IF oldlogsh = NIL THEN {
	time: LONG CARDINAL;
	STPSubr.AddUserName[logfile, "%s-modeller.files$"L, window];
	newlogsh _ Subr.NewStream[logfile, Subr.Write];
	FileStream.SetIndex[newlogsh, FileStream.GetLength[newlogsh]];
	time _ Time.Current[];
	CWF.FWF1[WFStore, "\n(Last run on %lt)\n"L, @time];
	CWF.WF1["Files to be transferred are recorded on '%s'\n"L, logfile];
	}
ELSE newlogsh _ oldlogsh;
CWF.FWF2[WFStore, "[%s]%s"L, sploc.host, longname];
CWF.WF2["Store [%s]%s ... "L, sploc.host, longname];
nbytes _ STPSubr.Store[stphandle: stphandle, remoteName: longname, localCap: fi.srcCap, 
	createDate: MDModel.GetSrcCreate[fi], h: window
	! STP.Error =>
		IF STPSubr.HandleSTPError[stphandle, code, error, 
			window] THEN RETRY];
info _ STP.GetFileInfo[stphandle];
CWF.WF2["!%s, %lu bytes.\n"L, info.version, @nbytes];
CWF.SWF4[fullname, "[%s]<%s>%s!%s"L, sploc.host, info.directory, 
	info.body, info.version];
Subr.SetRemoteFilenameProp[fi.srcCap, fullname
	! Directory.Error => {
		CWF.WF1["Directory Error for %s.\n"L, fi.srcFileName];
		CONTINUE;
		}
	];
RETURN[actuallyxferred, newlogsh];
};

}.