(**************************************************************************

:Remark.			Format: ein TAB in jeder 3. Spalte: ..tab..tab..tab..


:Program.		WoIst

:Contents.		Sucht nach einem anzugebenden Eintrag rekursiv im aktuellen
:Contents.		Verzeichnis. Nur im CLI zu verwenden.

:Bugs.			"Shit happens." (Murphy)


:Copyright.		Freeware---you may copy and use it, but all rights remain
:Copyright.		at the author

:Author.			Thomas Ansorge

:Address.		Dinkelackerring 55, 67435 Neustadt, Deutschland, Europa


:Language.		Modula-2

:Translator.	M2Amiga V4.3 (deutsch)


:History.		1.0 vom 20.02.1994

:History.		2.0 as of 19-Apr-1995:
:History.			- forgotton $VER-String included
:History.			- changed from module Arguments to DosL.RDArgs
:History.			- changed from module Heap to ExecL.AllocMem
:History.			- changed from module Terminal to DosL.Write
:History.			- new templates: NODIRS, NOFILES, NAMESONLY included
:History.			- new templates: SINCE, UPTO, TIME
:History.			- PrintFault (IoErr, ADR (ver_str)) added


**************************************************************************)


MODULE WoIst;

FROM Arts IMPORT Assert, returnVal, Terminate, thisTask, wbStarted;

FROM ASCII IMPORT lf, nul;

FROM Conversions IMPORT ValToStr;

FROM DosD IMPORT accessRead, ctrlC, Date, DateFormat, DateTime, DateTimeFlags, DateTimeFlagSet, DateTimePtr, dosFib, error, fail, FileInfoBlock, FileInfoBlockPtr, FileLock, FileLockPtr, ProcessPtr, RDArgsPtr, warn;

FROM DosL IMPORT AllocDosObject, CompareDates, CurrentDir, dosVersion, Examine, ExNext, FreeArgs, FreeDosObject, IoErr, Lock, MatchPatternNoCase, NameFromLock, Output, ParsePatternNoCase, PrintFault, ReadArgs, StrToDate, UnLock, Write;

FROM ExecD IMPORT MemReqs, MemReqSet;

FROM ExecL IMPORT AllocMem, FreeMem, SetSignal;

FROM LocaleD IMPORT CatalogPtr;

FROM LocaleL IMPORT CloseCatalog, GetCatalogStr, OpenCatalogA;

FROM String IMPORT Length;

FROM SYSTEM IMPORT ADDRESS, ADR, CAST, LONGSET;

(* --------------------------------------------------------------------- *)

CONST
	prog_str = "WoIst 2.0/";
	date_str = "(19.04.95)";

	(*$ IF M68881 OR M68040 *)
		ver_str = prog_str + "68020+FPU " + date_str;
	(*$ ELSIF M68020 *)
		ver_str = prog_str + "68020 " + date_str;
	(*$ ELSIF M68010 *)
		ver_str = prog_str + "68010 " + date_str;
	(*$ ELSE *)
		ver_str = prog_str + "68000 " + date_str;
	(*$ ENDIF *)
	
	ver_ptr = ADR ("$VER: " + ver_str);

CONST
	dosMinVersion = 37;
	patternBufferStep = 512;

	(* korrespondiert zu ArgsRecord *)
	template = "PATTERN/A,ND=NODIRS/S,NF=NOFILES/S,NO=NAMESONLY/S,SINCE/K,UPTO/K,TIME/K";

	woistCatName = "WoIst.catalog";

	(* obsolete
	copyrightNr = 0;
	usageNr = 1;
	*)

	lookFor = "WoIst: looking for \"";
	lookForNr = 2;

	foundBeforeDir = "WoIst: found directory \"\e[1m";
	foundBeforeDirNr = 3;

	foundBeforeFile = "WoIst: found   file    \"\e[1m";
	foundBeforeFileNr = 4;

	foundAfter = "\e[0m\".";
	foundAfterNr = 5;

	nothingElseFound = "WoIst: nothing (else) found.";
	nothingElseFoundNr = 6;

	found_dirs_str = " directory (-ies) found!";
	found_dirs_id = 7;

	found_files_str = " file (-s) found!";
	found_files_id = 8;

	total_str = "total:";
	total_id = 9;

	bytes_str = "bytes";
	bytes_id = 10;

	blocks_str = "blocks";
	blocks_id = 11;
	
	upto_since_str = "Warning: UPTO will be ignored if SINCE is given!";
	upto_since_id = 12;

	time_ignored_str = "Warning: TIME without SINCE or UPTO will be ignored!";
	time_ignored_id = 13;

	dosCatName = "sys/dos.catalog";
	breakStrNr = 304;
	breakStr = "*** Break";

TYPE
	ArgsRecord = RECORD
		pattern_ptr: ADDRESS;
		no_dirs: LONGINT;
		no_files: LONGINT;
		names_only: LONGINT;
		since: ADDRESS;
		upto: ADDRESS;
		time: ADDRESS;
	END; (* RECORD ArgsRecord *)

	PatternBufferPtr = ADDRESS;

	Str255Ptr = POINTER TO ARRAY [0..255] OF CHAR;

VAR
	(* Pointer *)
	dosCatPtr: CatalogPtr;
	patternBuffer: PatternBufferPtr;
	rdargs_ptr: RDArgsPtr;
	woistCatPtr: CatalogPtr;

	(* other 32bit stuff *)
	args: ArgsRecord;
	found_blocks: LONGCARD;
	found_bytes: LONGCARD;
	found_dirs: LONGCARD;
	found_files: LONGCARD;
	patternBufferSize: LONGCARD;

	(* others *)
	date_time: DateTime;
	date_flag: BOOLEAN;

(* --------------------------------------------------------------------- *)

PROCEDURE WriteLn (); FORWARD;

PROCEDURE WriteString (str_ptr: ADDRESS); FORWARD;

(* --------------------------------------------------------------------- *)

PROCEDURE GetDate (date_str_ptr: ADDRESS; VAR date_time: DateTime; time_str_ptr: ADDRESS): BOOLEAN;

	(* date_str_ptr ist garantiert # NIL *)

	BEGIN (* Funktion GetDate *)
		WITH date_time DO
			format := formatDOS;
			flags := DateTimeFlagSet {};
			strDate := date_str_ptr;
			strTime := time_str_ptr;
		END; (* WITH date_time DO *)

		IF StrToDate (ADR (date_time)) = 0 THEN
			IF PrintFault (IoErr (), ADR ("SINCE/UPTO/TIME")) THEN END;
			
			returnVal := fail;
			Terminate ();
		END; (* IF StrToDate (ADR (date_time)) = 0 *)
		
		RETURN TRUE;
	END GetDate; (* Funktion GetDate *)

(* --------------------------------------------------------------------- *)

PROCEDURE Search (dirLockPtr: FileLockPtr; buffer: PatternBufferPtr; date_flag: BOOLEAN; dos_date: Date);

	VAR
		infoBlockPtr: FileInfoBlockPtr;
		lockPtr     : FileLockPtr;
		oldLockPtr  : FileLockPtr;

	(* ------------------------------------------------------------------ *)

	PROCEDURE WriteFound (
		dirLockPtr  : FileLockPtr;
		infoBlockPtr: FileInfoBlockPtr);

		(* Eigene Prozedur, da Search rekursiv und name ziemlich groß ist. *)

		TYPE
			NameStr = ARRAY [0..255] OF CHAR;

		VAR
			name: NameStr;

		(* --------------------------------------------------------------- *)

		BEGIN (* Prozedur WriteFound *)
			IF NameFromLock (dirLockPtr, ADR (name), SIZE (name)) THEN
				IF infoBlockPtr^.dirEntryType > 0 THEN
					(* Verzeichnis *)

					IF args.no_dirs = 0 THEN
						IF args.names_only = 0 THEN
							WriteString (GetCatalogStr (woistCatPtr, foundBeforeDirNr, ADR (foundBeforeDir)));
						END; (* IF args.names_only = 0 *)

						WriteString (ADR (name));

						IF name [Length (name) - 1] # ":" THEN
							WriteString (ADR ("/" + nul));
						END (* IF name [Length (name)] # ":" *);

						WriteString (ADR (infoBlockPtr^.fileName));
						WriteString (ADR ("/"+nul));

						IF args.names_only = 0 THEN
							WriteString (GetCatalogStr (woistCatPtr, foundAfterNr, ADR (foundAfter)));
						END; (* IF args.names_only = 0 *)

						WriteLn ();

						INC (found_dirs);
					END; (* IF args.no_dirs = 0 *)

				ELSE (* IF infoBlockPtr^.dirEntryType > 0 *)
					(* Datei *)

					IF args.no_files = 0 THEN
						IF args.names_only = 0 THEN
							WriteString (GetCatalogStr (woistCatPtr, foundBeforeFileNr, ADR (foundBeforeFile)));
						END; (* IF args.names_only = 0 *)

						WriteString (ADR (name));

						IF name [Length (name) - 1] # ":" THEN
							WriteString (ADR ("/" + nul));
						END (* IF name [Length (name)] # ":" *);

						WriteString (ADR (infoBlockPtr^.fileName));

						IF args.names_only = 0 THEN
							WriteString (GetCatalogStr (woistCatPtr, foundAfterNr, ADR (foundAfter)));
						END; (* IF args.names_only = 0 *)

						WriteLn ();

						INC (found_files);
						found_bytes := found_bytes + LONGCARD (infoBlockPtr^.size);
						found_blocks := found_blocks + LONGCARD (infoBlockPtr^.numBlocks);
					END; (* IF args.no_files = 0 *)
				END (* IF infoBlockPtr^.dirEntryType > 0 *);
			END (* IF NameFromLock ( *);
		END WriteFound (* Prozedur *);

	(* ------------------------------------------------------------------ *)

	BEGIN (* Prozedur Search *)

	infoBlockPtr := AllocDosObject (dosFib, NIL);

	IF infoBlockPtr = NIL THEN
		WriteString (ADR ("WoIst: Error: AllocDosObject () (AllocMemory ()?) failed!"));
		WriteLn ();

		RETURN; (* Locks freigeben... *)
	END (* IF infoBlockPtr = NIL *);

	oldLockPtr := CurrentDir (dirLockPtr);

	LOOP
		IF Examine (dirLockPtr, infoBlockPtr) THEN
			WHILE ExNext (dirLockPtr, infoBlockPtr) DO
				IF MatchPatternNoCase (buffer, ADR (infoBlockPtr^.fileName)) THEN
					IF date_flag THEN
						IF args.since # NIL THEN
							IF CompareDates (ADR (dos_date), ADR (infoBlockPtr^.date)) >= 0 THEN
								WriteFound (dirLockPtr, infoBlockPtr);
							END; (* IF CompareDates (ADR (dos_date), ADR (infoBlockPtr^.date)) >= 0 *)

						ELSE (* IF args.since # NIL *)
							IF CompareDates (ADR (dos_date), ADR (infoBlockPtr^.date)) <= 0 THEN
								WriteFound (dirLockPtr, infoBlockPtr);
							END; (* IF CompareDates (ADR (dos_date), ADR (infoBlockPtr^.date)) <= 0 *)
						END; (* IF args.since # NIL ELSE *)

					ELSE (* IF date_flag *)
						WriteFound (dirLockPtr, infoBlockPtr);
					END; (* IF date_flag ELSE *)
				END (* IF MatchPatternNoCase *);

				IF infoBlockPtr^.dirEntryType > 0 THEN
					lockPtr := Lock (ADR (infoBlockPtr^.fileName), accessRead);

					IF lockPtr # NIL THEN
						Search (lockPtr, buffer, date_flag, dos_date);

						UnLock (lockPtr);
						lockPtr := NIL;
					END (* IF lockPtr # NIL *);
				END (* IF infoBlockPtr^.dirEntryType > 0 *);

				IF ctrlC IN SetSignal (LONGSET {}, LONGSET {}) THEN
					EXIT (* LOOP *);
				END (* IF ctrlC IN SetSignal (LONGSET {}, LONGSET {}) *);
			END (* WHILE ExNext (dirLockPtr, infoBlockPtr) *);
		END (* IF Examine (dirLockPtr, infoBlockPtr) *);

		EXIT (* LOOP *);
	END (* LOOP *);

	oldLockPtr := CurrentDir (oldLockPtr);

	FreeDosObject (dosFib, infoBlockPtr);
END Search (* Prozedur *);

(* --------------------------------------------------------------------- *)

PROCEDURE WriteLn ();

	CONST
		lf_str = lf + nul;

	BEGIN (* Prozedur WriteLn *)
		WriteString (ADR (lf_str));
	END WriteLn; (* Prozedur *)

(* --------------------------------------------------------------------- *)

PROCEDURE WriteString (str_ptr: ADDRESS);

	BEGIN (* Prozedur WriteString *)
		IF Output () # NIL THEN
			(* Bug: -1 statt Length (...) funktioniert nicht mit der Commandline-History der WShell! *)
			IF 0 # Write (Output (), str_ptr, Length (CAST (Str255Ptr, str_ptr)^)) THEN END;
		END; (* IF Output () # NIL *)
	END WriteString; (* Prozedur *)

(* --------------------------------------------------------------------- *)

PROCEDURE WriteNum (l: LONGINT);

	VAR
		(* 32bit stuff *)
		str: ARRAY [0..11] OF CHAR;

		(* other stuff *)
		err: BOOLEAN;

	BEGIN (* Prozedur WriteNum *)
		ValToStr (l, FALSE, str, 10, 1, " ", err);

		IF err THEN
			str := "(???)";
		END; (* IF err *)

		WriteString (ADR (str));
	END WriteNum; (* Prozedur *)

(* --------------------------------------------------------------------- *)
(* --------------------------------------------------------------------- *)

BEGIN (* MODULE WoIst *)
	Assert (NOT wbStarted, ADR ("CLI!"));

	IF dosVersion < dosMinVersion THEN
		WriteString (ADR ("WhereIs: Error: You need Kickstart 2.04 and Workbench 2.1 or newer!"));
		WriteLn ();

		returnVal := fail;
		Terminate ();
	END (* IF dosVersion < dosMinVersion *);

	woistCatPtr := OpenCatalogA (NIL, ADR (woistCatName), NIL);

	(* Pattern bearbeiten *)

	rdargs_ptr := ReadArgs (ADR (template), ADR (args), NIL);

	IF rdargs_ptr = NIL THEN
		IF PrintFault (IoErr (), NIL) THEN END;
		
		returnVal := fail;
		Terminate ();
	END; (* IF rdargs_ptr = NIL *)

	WriteLn ();

	(* Template zum Suchen: *)

	patternBufferSize := 2;

	REPEAT
		IF patternBuffer # NIL THEN
			FreeMem (patternBuffer, patternBufferSize);
			patternBuffer := NIL;
		END (* IF patternBuffer # NIL *);

		INC (patternBufferSize, patternBufferStep);

		patternBuffer := AllocMem (patternBufferSize, MemReqSet {public, memClear});
	UNTIL (patternBuffer = NIL) OR (ParsePatternNoCase (args.pattern_ptr, patternBuffer, patternBufferSize) # -1);

	(* evt. SINCE, UPTO: *)

	date_flag := FALSE;

	IF args.since # NIL THEN
		IF args.time # NIL THEN
			date_flag := GetDate (args.since, date_time, args.time);

		ELSE (* IF args.time # NIL *)
			date_flag := GetDate (args.since, date_time, ADR ("00:00:00"));
		END; (* IF args.time # NIL ELSE *)

		IF args.upto # NIL THEN
			WriteString (GetCatalogStr (woistCatPtr, upto_since_id, ADR (upto_since_str)));
			WriteLn ();

			returnVal := warn;
		END; (* IF args.upto # NIL *)

	ELSIF args.upto # NIL THEN
		IF args.time # NIL THEN
			date_flag := GetDate (args.upto, date_time, args.time);

		ELSE (* IF args.time # NIL *)
			date_flag := GetDate (args.upto, date_time, ADR ("23:59:59"));
		END; (* IF args.time # NIL ELSE *)

	ELSIF args.time # NIL THEN
		WriteString (GetCatalogStr (woistCatPtr, time_ignored_id, ADR (time_ignored_str)));
		WriteLn ();
		
		returnVal := warn;
	END; (* ELSIF args.time # NIL *)

	(* suchen *)

	IF args.names_only = 0 THEN
		WriteLn ();
		WriteString (GetCatalogStr (woistCatPtr, lookForNr, ADR (lookFor)));
		WriteString (args.pattern_ptr);
		WriteString (ADR ("\"..."));
		WriteLn ();
		WriteLn ();
	END; (* IF args.names_only = 0 *)

	IF (args.no_files = 0) OR (args.no_dirs = 0) THEN
		Search (CAST (ProcessPtr, thisTask)^.currentDir, patternBuffer, date_flag, date_time.date);
	END; (* IF (args.no_files = 0) OR (args.no_dirs = 0) *)

	IF args.names_only = 0 THEN
		WriteLn ();
	END; (* IF args.names_only = 0 *)

	IF ctrlC IN SetSignal (LONGSET {}, LONGSET {}) THEN
		dosCatPtr := OpenCatalogA (NIL, ADR (dosCatName), NIL);
		WriteString (GetCatalogStr (dosCatPtr, breakStrNr, ADR (breakStr)));
		CloseCatalog (dosCatPtr);

	ELSE (* IF ctrlC IN SetSignal (LONGSET {}, LONGSET {}) *)
		IF args.names_only = 0 THEN
			WriteString (GetCatalogStr (woistCatPtr, nothingElseFoundNr, ADR (nothingElseFound)));
		END; (* IF args.names_only = 0 *)
	END (* IF ctrlC IN SetSignal (LONGSET {}, LONGSET {}) *);

	IF args.names_only = 0 THEN
		WriteLn ();
		WriteLn ();

		WriteString (GetCatalogStr (woistCatPtr, total_id, ADR (total_str)));
		WriteLn ();

		WriteNum (found_dirs);
		WriteString (GetCatalogStr (woistCatPtr, found_dirs_id, ADR (found_dirs_str)));
		WriteLn ();

		WriteNum (found_files);
		WriteString (GetCatalogStr (woistCatPtr, found_files_id, ADR (found_files_str)));
		WriteString (ADR (" ("));
		WriteNum (found_bytes);
		WriteString (ADR (" \o"));
		WriteString (GetCatalogStr (woistCatPtr, bytes_id, ADR (bytes_str)));
		WriteString (ADR ("/\o"));
		WriteNum (found_blocks);
		WriteString (ADR (" \o"));
		WriteString (GetCatalogStr (woistCatPtr, blocks_id, ADR (blocks_str)));
		WriteString (ADR (")\o"));
		WriteLn ();
	END; (* IF args.names_only = 0 *)

	CLOSE; (* ----------------------------------------------------------- *)

	IF rdargs_ptr # NIL THEN
		FreeArgs (rdargs_ptr);
		rdargs_ptr := NIL;
	END; (* IF rdargs_ptr # NIL *)

	IF patternBuffer # NIL THEN
		FreeMem (patternBuffer, patternBufferSize);
		patternBuffer := NIL;
	END (* IF patternBuffer # NIL *);

	CloseCatalog (woistCatPtr);
END WoIst (* MODULE *).