(* Copyright (C) 1989, 1992, Digital Equipment Corporation                   *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)

(* Last modified on Wed Mar  4 12:02:38 PST 1992 by muller                   *)
(*      modified on Tue Jan 28 16:03:43 PST 1992 by kalsow                   *)


(*      modified on Thu Oct 25 00:59:14 1990 by orgass@ibm.com *)

UNSAFE MODULE Filename;

IMPORT Text, Rd, FileStream, M3toC, 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} =
  VAR pathname := SearchPath (path, filename);
  BEGIN
    IF pathname = NIL THEN RETURN NIL END;
    RETURN FileStream.OpenRead (pathname);
  END RdFromPath;

BEGIN
END Filename.