Преглед на файлове

GetAppDir fixed for Unix when run from Make

Arthur Yefimov преди 2 години
родител
ревизия
0d5ea22050
променени са 1 файла, в които са добавени 110 реда и са изтрити 18 реда
  1. 110 18
      src/Env.Mod

+ 110 - 18
src/Env.Mod

@@ -1,5 +1,5 @@
 MODULE Env;
-IMPORT CmdArgs, Platform, Utf8, SYSTEM;
+IMPORT CmdArgs, Args, Platform, Utf8, SYSTEM;
 TYPE SHORTCHAR = Utf8.SHORTCHAR;
 
 VAR count: INTEGER;
@@ -24,29 +24,121 @@ VAR q: ARRAY 10240 OF SHORTCHAR;
 BEGIN Utf8.Encode(name, z); CmdArgs.GetEnv(z, q); Utf8.Decode(q, val)
 END GetByName;
 
-PROCEDURE GetAppDir*(VAR s: ARRAY OF CHAR);
-VAR c, delim: CHAR;
-  i: INTEGER;
-  z: ARRAY 260 OF SHORTCHAR;
+PROCEDURE SearchPath(arg, path: ARRAY OF CHAR; VAR s: ARRAY OF CHAR): BOOLEAN;
+VAR i, j, k: INTEGER;
+  p: ARRAY 1000 OF CHAR;
+  q: ARRAY 2000 OF SHORTCHAR;
+  found: BOOLEAN;
 BEGIN
-  IF Platform.Windows THEN
-    Platform.GetAppDir(z);
-    Utf8.Decode(z, s)
-  ELSE
-    GetByName('_', s);
-    IF s[0] # 0X THEN
-      s[LEN(s) - 1] := 0X;
+  i := 0; found := FALSE;
+  WHILE (path[i] # 0X) & ~found DO
+    j := 0; (* Copy PATH segment to p *)
+    WHILE (j < LEN(p) - 2) & (path[i] # 0X) & (path[i] # ':') DO
+      p[j] := path[i]; INC(i); INC(j)
+    END;
+    (* Make sure p ends with / *)
+    IF (j # 0) & (p[j - 1] # '/') THEN p[j] := '/'; INC(j) END;
+
+    k := 0; (* Append arg to p *)
+    WHILE (j < LEN(p) - 1) & (arg[k] # 0X) DO
+      p[j] := arg[k]; INC(j); INC(k)
+    END;
+    p[j] := 0X;
+
+    Utf8.Encode(p, q);
+    IF Platform.FileExists(q) THEN found := TRUE END;
+
+    (* Move i to next PATH segment *)
+    IF path[i] = ':' THEN INC(i) END
+  END;
+  IF found THEN
+    i := 0;
+    WHILE (i < LEN(s) - 1) & (p[i] # 0X) DO s[i] := p[i]; INC(i) END;
+    s[i] := 0X
+  END
+RETURN found END SearchPath;
+
+(** Removes base name (and a slash) in path s.
+    Example: 'dir/old/new' -> 'dir/old/'. *)
+PROCEDURE RemoveBaseName(VAR s: ARRAY OF CHAR);
+VAR i: INTEGER;
+BEGIN
+  (* Find 0X *)
+  i := 0; WHILE s[i] # 0X DO INC(i) END;
+  (* Go back and find / *)
+  WHILE (i # -1) & (s[i] # '/') DO DEC(i) END;
+  (* Truncate string at position of / + 1, or clear string *)
+  s[i + 1] := 0X
+END RemoveBaseName;
+
+(** Example: '///' -> '/'. *)
+PROCEDURE RemoveDoubleSlashes(VAR s: ARRAY OF CHAR);
+BEGIN (*!TODO*)
+END RemoveDoubleSlashes;
 
-      i := 0; WHILE s[i] # 0X DO INC(i) END;
+(** Example: './' -> ''. *)
+PROCEDURE RemoveDotDirs(VAR s: ARRAY OF CHAR);
+BEGIN (*!TODO*)
+END RemoveDotDirs;
 
-      IF Platform.Windows THEN delim := '\' ELSE delim := '/' END;
+(** Example: 'dir/..' -> ''. *)
+PROCEDURE RemoveBacktracking(VAR s: ARRAY OF CHAR);
+BEGIN (*!TODO*)
+END RemoveBacktracking;
 
-      c := s[0]; s[0] := delim;
-      REPEAT DEC(i) UNTIL s[i] = delim;
-      s[0] := c;
+PROCEDURE ResolveSymLinks(VAR s: ARRAY OF CHAR);
+BEGIN (*!TODO*)
+END ResolveSymLinks;
 
-      s[i + 1] := 0X
+PROCEDURE GetAppDirUnix(VAR s: ARRAY OF CHAR);
+VAR q: ARRAY 16384 OF SHORTCHAR;
+  path: ARRAY 16384 OF CHAR;
+  pwd, arg: ARRAY 1024 OF CHAR;
+  i, j: INTEGER;
+  argHasSlash: BOOLEAN;
+BEGIN
+  GetByName('PWD', pwd);
+  GetByName('PATH', path);
+  CmdArgs.Get(0, q); Utf8.Decode(q, arg);
+  (* Remove / from end of pwd *)
+  i := 0; WHILE pwd[i] # 0X DO INC(i) END;
+  IF i # 0 THEN
+    DEC(i);
+    IF pwd[i] = '/' THEN pwd[i] := 0X END
+  END;
+
+  IF arg[0] = '/' THEN i := 0;
+    WHILE (i < LEN(s) - 1) & (arg[i] # 0X) DO s[i] := arg[i]; INC(i) END
+  ELSE
+    i := 0; WHILE (arg[i] # 0X) & (arg[i] # '/') DO INC(i) END;
+    (* IF there is at least one / in arg *)
+    IF arg[i] # 0X THEN
+      i := 0; (* Copy s to pwd, make i := Length(s) *)
+      WHILE (i < LEN(s) - 2) & (pwd[i] # 0X) DO s[i] := pwd[i]; INC(i) END;
+      s[i] := '/'; INC(i); (* Append / to s *)
+      j := 0; (* Append arg to s *)
+      WHILE (i < LEN(s) - 1) & (arg[j] # 0X) DO
+        s[i] := arg[j]; INC(i); INC(j)
+      END;
+      s[i] := 0X
+    ELSIF ~SearchPath(arg, path, s) THEN s[0] := 0X (* Error *)
     END
+  END;
+
+  IF s[0] # 0X THEN
+    RemoveBaseName(s);
+    RemoveDoubleSlashes(s);
+    RemoveDotDirs(s);
+    RemoveBacktracking(s);
+    ResolveSymLinks(s);
+  END
+END GetAppDirUnix;
+
+PROCEDURE GetAppDir*(VAR s: ARRAY OF CHAR);
+VAR z: ARRAY 1024 OF SHORTCHAR;
+BEGIN
+  IF Platform.Windows THEN Platform.GetAppDir(z); Utf8.Decode(z, s)
+  ELSE GetAppDirUnix(s)
   END
 END GetAppDir;