Copyright (C) 1994, Digital Equipment Corp.
UNSAFE MODULE************************************************************* DefaultExtension(filename,; IMPORT Text, Rd, FileRd, M3toC, OSError, Uugid, Upwd, Unix; PROCEDURE Filename FileIsReadable (filename: TEXT): BOOLEAN = BEGIN RETURN Unix.access (M3toC.TtoS (filename), Unix.R_OK) = 0; END FileIsReadable; PROCEDURERoot (filename: TEXT): TEXT = VAR dotpos := Text.FindCharR (filename, '.'); BEGIN IF (dotpos = -1) OR (Text.FindChar (filename, '/', dotpos + 1) # -1) THEN RETURN filename; ELSE RETURN Text.Sub (filename, 0, dotpos); END; END Root; PROCEDUREExtension (filename: TEXT): TEXT = VAR dotpos := Text.FindCharR (filename, '.'); BEGIN IF (dotpos = -1) OR (Text.FindChar (filename, '/', dotpos + 1) # -1) THEN RETURN ""; ELSE RETURN Text.Sub (filename, dotpos + 1, Text.Length (filename) - (dotpos + 1)); END; END Extension; PROCEDUREHead (filename: TEXT): TEXT = VAR slashpos := Text.FindCharR (filename, '/'); BEGIN IF slashpos = -1 THEN RETURN filename; ELSE RETURN Text.Sub (filename, 0, slashpos); END; END Head; PROCEDURETail (filename: TEXT): TEXT = VAR slashpos := Text.FindCharR (filename, '/'); BEGIN IF slashpos = -1 THEN RETURN filename; ELSE RETURN Text.Sub (filename, slashpos + 1, Text.Length (filename) - (slashpos + 1)); END; END Tail;
.xxx
)
DefaultExtension adds an extension to filename
if none already exists. Alternatively, if the extension
field begins with a *, any old extension in the first
filename is replaced with the given extension. Thus,
DefaultExtension(filename, .xxx
) add .xxx if no ext
DefaultExtension(filename, *.xxx
) force .xxx as ext
*************************************************************
PROCEDUREDefaultExtension (filename, ext: TEXT): TEXT = VAR force := Text.GetChar (ext, 0) = '*'; dotpos := Text.FindCharR (filename, '.'); BEGIN IF force THEN ext := Text.Sub (ext, 1, Text.Length (ext)); END; IF (dotpos = -1) OR (Text.FindChar (filename, '/', dotpos + 1) # -1) THEN force := TRUE; dotpos := Text.Length (filename); END; IF force THEN RETURN Text.Cat (Text.Sub (filename, 0, dotpos), ext); ELSE RETURN filename; END; END DefaultExtension; PROCEDUREExpandTilde (filename: TEXT): TEXT RAISES {Error} = (* Expands the ~ character at the beginning of a file name into the correct directory path. The initial character ~ is replaced by the effective process owner's home directory from /etc/passwd. The initial string ~user is replaced by the home directory of user from /etc/passwd. Exception Error is raised if there is no entry for the appropriate user in /etc/passwd. *) VAR slashIndex: INTEGER; len := Text.Length (filename); BEGIN IF len = 0 OR Text.GetChar (filename, 0) # '~' THEN RETURN filename; END; IF len = 1 OR Text.GetChar (filename, 1) = '/' THEN WITH pwEntry = Upwd.getpwuid (Uugid.getuid ()) DO IF pwEntry = NIL THEN RAISE Error; END; RETURN M3toC.StoT (pwEntry.pw_dir) & Text.Sub (filename, 1, LAST (INTEGER)); END; END; slashIndex := Text.FindChar (filename, '/', 1); IF slashIndex = -1 THEN slashIndex := Text.Length (filename) + 1; END; WITH pwEntry = Upwd.getpwnam (M3toC.TtoS (Text.Sub (filename, 1, slashIndex-1))) DO IF pwEntry = NIL THEN RAISE Error; END; RETURN M3toC.StoT (pwEntry.pw_dir) & Text.Sub (filename, slashIndex, LAST (INTEGER)); END; END ExpandTilde; PROCEDURESearchPath (path, filename: TEXT; pred: FilePredicate := FileIsReadable): TEXT = VAR start, finish: INTEGER; dirname, tempname: TEXT; BEGIN IF Text.Empty (filename) THEN RETURN NIL; END; IF Text.Empty (path) THEN path := "."; END; TRY filename := ExpandTilde (filename); EXCEPT Error => RETURN NIL; END; IF Text.GetChar (filename, 0) = '/' THEN IF pred (filename) THEN RETURN filename; ELSE RETURN NIL; END; ELSE start := 0; WITH path=path & ":" DO LOOP finish := Text.FindChar (path, ':', start); IF finish = -1 THEN RETURN NIL; END; TRY dirname := ExpandTilde (Text.Sub (path, start, finish - start)); IF Text.Empty (dirname) THEN dirname := "."; END; IF Text.GetChar (dirname, Text.Length (dirname) - 1) = '/' THEN tempname := Text.Cat (dirname, filename); ELSE tempname := dirname & "/" & filename; END; IF pred (tempname) THEN RETURN tempname; END; EXCEPT Error => (* skip this directory *) END; start := finish + 1; END; END; (*RETURN NIL;*) END; END SearchPath; PROCEDURERdFromPath (path, filename: TEXT): Rd.T RAISES {Rd.Failure} = <*FATAL OSError.E*> VAR pathname := SearchPath (path, filename); BEGIN IF pathname = NIL THEN RETURN NIL END; RETURN FileRd.Open (pathname); END RdFromPath; BEGIN END Filename.