filename/src/POSIX/Filename.m3


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.

interface Filename is in:


interface Uugid is in:


interface Upwd is in:


interface Unix is in: