Copyright (C) 1994, Digital Equipment Corp.
UNSAFE MODULE Filename;
IMPORT Text, Rd, FileRd, M3toC, OSError, Uugid, Upwd, Unix;
PROCEDURE FileIsReadable (filename: TEXT): BOOLEAN =
BEGIN
RETURN Unix.access (M3toC.TtoS (filename), Unix.R_OK) = 0;
END FileIsReadable;
PROCEDURE Root (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;
PROCEDURE Extension (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;
PROCEDURE Head (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;
PROCEDURE Tail (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;
*************************************************************
DefaultExtension(filename, .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
*************************************************************
PROCEDURE DefaultExtension (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;
PROCEDURE ExpandTilde (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;
PROCEDURE SearchPath (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;
PROCEDURE RdFromPath (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.