(* File: NameMap.m3
|------------------
|
| Fri Nov  6 16:30:21 MET 1992 by preschern
| Rewritten by Carsten Weich, Aug. 1993
****************************************************************)


MODULE NameMap;

IMPORT TxtTxtTbl, FileIO, Filename, Text, Rd, Wr, Stdio, Fmt,
       DOSTextRd, DOSTextWr, Thread, RdUtils, Char;

<*FATAL Thread.Alerted*>

VAR LogLevel:= 0;  (* Pseudoconstant:
			0 for nolog
			1 to log procedure calls, 
			2 to log nametransformation *)
PROCEDURE Log(l: TEXT; logLevel:= 1) =
    <*FATAL Wr.Failure*>
    BEGIN IF logLevel <= LogLevel THEN
	 Wr.PutText(Stdio.stderr,l&"\n"); Wr.Flush(Stdio.stderr) END;
    END Log;


VAR
    dosUnixTable:= TxtTxtTbl.New();     (* DOS-name is key *)
    unixDosTable:= TxtTxtTbl.New();     (* long-name is key *)

(* Change Text to all lowercase-letters *)
    
PROCEDURE Caps(t: TEXT): TEXT =
    VAR result:= "";
    BEGIN
	FOR i:= 0 TO Text.Length(t)-1 DO
	    VAR c:= Text.GetChar(t, i); 
	    BEGIN
		IF c >= 'A' AND c <= 'Z' THEN
		    c:= VAL(ORD(c)+ORD('a')-ORD('A'), CHAR);
		END;
		result:= result&Fmt.Char(c);
	    END;
	END;
	RETURN result;
    END Caps;

PROCEDURE IsDosStyle(name: TEXT): BOOLEAN =
    VAR dots:= 0;
    BEGIN
	FOR i:= 0 TO Text.Length(name)-1 DO
	    IF Text.GetChar(name, i) = '.' THEN INC(dots) END;
	END;
	CASE dots OF
	    0=> RETURN Text.Length(name) <= 8;
	 | 1=> RETURN Text.FindChar(name, '.') <= 8 AND
			Text.FindChar(name, '.') >= Text.Length(name)-4;
	  ELSE RETURN FALSE;
	END;
    END IsDosStyle;

PROCEDURE ReadNameMap () RAISES {Rd.Failure} =
    VAR rd: Rd.T;
	 tabPos: CARDINAL;
	 line, long, short: TEXT;
    BEGIN
	IF NOT Filename.FileIsReadable(MapFile) THEN
	    RAISE Rd.Failure("no mapfile (should be "&MapFile&")");
	END;
	TRY
	    rd:= DOSTextRd.New (FileIO.OpenRead (MapFile));
	    WHILE NOT Rd.EOF (rd) DO
		line:= Rd.GetLine (rd); 
		tabPos:= Text.FindChar(line, Char.HT);
		IF tabPos<0 THEN
		    RAISE Rd.Failure("Bad mapfile-format");
		END;
		short:= Caps(Text.Sub(line, 0, tabPos));
		long:= Text.Sub(line, tabPos+1, Text.Length(line)-tabPos-1);
		Log("enter in namemap >"&short&"|"&long&"<", 2);
		IF dosUnixTable.put (short, long) OR
		   unixDosTable.put (long, short) THEN
		    RAISE Rd.Failure("dublicate entry in mapfile");
		END;
	    END;
	    Rd.Close (rd);
	EXCEPT
	    Rd.EndOfFile=> RAISE Rd.Failure("Bad mapfile-format");
	END;
    END ReadNameMap;

PROCEDURE WriteNameMap () RAISES {Wr.Failure} =
  VAR wr: Wr.T;
      key: TxtTxtTbl.Key;
      value: TxtTxtTbl.Value;

    PROCEDURE WriteOut (<* UNUSED *> data : REFANY; 
						  key  : TxtTxtTbl.Key; 
						  VAR value: TxtTxtTbl.Value): BOOLEAN =
	BEGIN
	    TRY
		Wr.PutText (wr, key & "\t" & value & "\n");
		RETURN FALSE;
	    EXCEPT
		Wr.Failure=> RETURN TRUE;
	    END;
	END WriteOut;

    BEGIN
	wr := DOSTextWr.New (FileIO.OpenWrite(MapFile)); 
	IF dosUnixTable.enumerate (WriteOut, NIL, key, value) THEN
	    RAISE Wr.Failure("cannot write mapfile");
	END;
	Wr.Close (wr);
	Log("New Mapfile");
    END WriteNameMap;

PROCEDURE Add (name: TEXT) RAISES {Wr.Failure} =
    (* This procedure chooses the DOS filename for 'name': Leading dots
	(for unix "hidden" files) are replaced by minus. Everything before the
	first dot is cut off at the seventh character and a DollarChar is appended.
	If such a name is already in use, the DollarChar is moved to the seventh
	position and a count-character (starting at '1') is appended. *)

    VAR short, root, ext: TEXT;
	dosname:= "";
	found:= FALSE;
	fill:= "-";
	dot: INTEGER;
    BEGIN
	Log("NameMap.Add("&name&")");
	(* no entries for DOS-style unixnames *)
	IF NOT IsDosStyle(name) THEN
	    WITH dollar = Fmt.Char(DollarChar) DO
		name:= Filename.Tail(name); (* throw away path-informations *)
		root:= Filename.Root(name);
		ext:= Filename.Extension(name);
		Log("-> name: "&name&" / root: "&root& " / ext: "&ext, 2);
		IF Text.Equal(root, "") THEN
		    root:= dollar & ext;
		    ext:= Filename.Extension(root);
		END;
		IF Text.Length(ext) > 3 THEN ext:= Text.Sub(ext, 0,2)&dollar END;
		REPEAT                  (* replace remaining dots to dollars *)
		    dot:= Text.FindChar(root, '.');
		    IF dot  >= 0 THEN
			root:= Text.Sub(root, 0, dot) & dollar &
				  Text.Sub(root, dot+1, Text.Length(root)-dot-1);
		    END;
		    Log("--> root: " & root, 2);
		UNTIL dot < 0;
		Log("-> root: "&root& " / ext: "&ext, 2);
		WHILE Text.Length(root) < 7 DO root:= root & fill END; 
		short:= Text.Sub(root, 0, 7) & dollar & "." & ext;
		Log("-> short: "&short, 2);
		IF dosUnixTable.in(Caps(short), dosname) THEN (* there already is an entry *)
		    VAR count:= '0';
		    BEGIN (* get all entries to see if "name" is already there.
				       If it is terminate else loop until there are no more long
				       names that start the 6 first characters of 'name'. *)
			LOOP
			    IF Text.Equal(dosname, Filename.Tail(name)) THEN
				found:= TRUE;
				EXIT;
			    END;
			    IF count # '9' THEN INC(count) ELSE count:= 'A' END;
			    <*ASSERT count <= 'Z' *>
			    short:= Text.Sub(short, 0,6) & dollar & Fmt.Char(count) 
					& "." & ext;
			    Log("--> short: "&short, 2);
			    IF NOT dosUnixTable.in(Caps(short), dosname) THEN EXIT END;
			END;
		    END;
		END;
	    END;
	    IF NOT found THEN
		IF dosUnixTable.put (Caps(short), name) OR 
		   unixDosTable.put (name, Caps(short)) THEN
		    RAISE Wr.Failure("NameMap: implementation error");
		END;
		WriteNameMap();
	    END;
	END;
    END Add;

PROCEDURE Remove (name: TEXT) RAISES {Wr.Failure} =
    VAR value: TEXT;
    BEGIN
	Log("NameMap.Remove("&name&")");
	IF unixDosTable.delete (name, value) THEN
	    IF NOT dosUnixTable.delete (Caps(value), name) THEN
		RAISE Wr.Failure("NameMap: inconsistency in namemap: remove '"&value);
	    END;
	    WriteNameMap();
	END;
    END Remove;

PROCEDURE GetDos (name: TEXT; add:= FALSE): TEXT RAISES {Rd.Failure} =
    VAR value, path, par: TEXT;
    BEGIN
	par:= name;
	path:= Filename.Head(name);
	name:= Filename.Tail(name);
	IF Text.Equal(path, name) THEN path:= "" ELSE path:= path&"/" END;
	TRY                                               
	    IF NOT unixDosTable.in (name, value) THEN
		IF add AND NOT IsDosStyle(name) THEN
		    Add(name);
		    value:= GetDos(name);
		    Log("NameMap.GetDos1("&par&") = "&path&value);
		    RETURN path&value;
		ELSE
		    Log("NameMap.GetDos2("&par&") = "&path&name);
		    RETURN path&name;
		END
	    ELSE
		Log("NameMap.GetDos3("&par&") = "&path&value);
		RETURN path&value
	    END;
	EXCEPT
	    Rd.Failure(err)=> RAISE Rd.Failure(err);
	 | Wr.Failure(err)=> RAISE Rd.Failure(err);
	END;
    END GetDos;

PROCEDURE GetLong (name: TEXT): TEXT RAISES {Rd.Failure} =
    VAR value, path, par: TEXT;
    BEGIN
	par:= name;
	name:= Caps(name);
	path:= Filename.Head(name);
	name:= Filename.Tail(name);
	IF Text.Equal(path, name) THEN path:= "" ELSE path:= path&"/" END;
	IF Text.FindChar(name, '.') < 0 THEN name:= name&"." END;
	IF dosUnixTable.in (name, value) THEN
	    Log("NameMap.GetLong1("&par&") = "&path&value);
	    RETURN path&value;
	ELSE
	    Log("NameMap: No entry for DOS name "&name);
	    Log("NameMap.GetLong2("&par&") = "&par);
	    RETURN par;
	END;
    END GetLong;


PROCEDURE RereadNameMap() RAISES {Rd.Failure} =
    BEGIN
	dosUnixTable:= TxtTxtTbl.New(); (* throw away old tables ... *)
	unixDosTable:= TxtTxtTbl.New();
	ReadNameMap();                  (* ... and make new ones. *)
    END RereadNameMap;


BEGIN
    TRY
	IF Filename.FileIsReadable("/m3-new/lib/loglevel.1") THEN
	    LogLevel:= 1;
	ELSIF Filename.FileIsReadable("/m3-new/lib/loglevel.2") THEN
	    LogLevel:= 2;
	END;
	ReadNameMap();
    EXCEPT
	Wr.Failure(err)=> <*FATAL Wr.Failure*> BEGIN 
		 Wr.PutText(Stdio.stderr, "TestMap: "&
				  RdUtils.FailureText(err)&"\n");
		 <*ASSERT FALSE*>
	    END;
     |  Rd.Failure(err)=> <*FATAL Wr.Failure*> BEGIN 
		 Wr.PutText(Stdio.stderr, "TestMap: "&
				  RdUtils.FailureText(err)&"\n");
		 <*ASSERT FALSE*>
	    END;
    END;
END NameMap.