CUnix: enriched (get_extension, sys_command, waitpid_non_intr) + cleaned

1 files changed, 57 insertions, 28 deletions

diff --git a/lib/cUnix.ml b/lib/cUnix.ml
index cecfcfb38b..a4d6903c02 100644
--- a/lib/cUnix.ml
+++ b/lib/cUnix.ml
@@ -18,30 +18,36 @@ let path_to_list p =
   let sep = Str.regexp (if Sys.os_type = "Win32" then ";" else ":") in
     Str.split sep p
 
-(* Hints to partially detects if two paths refer to the same repertory *)
+(* Some static definitions concerning filenames *)
+
+let dirsep = Filename.dir_sep (* Unix: "/" *)
+let dirsep_len = String.length dirsep
+let curdir = Filename.concat Filename.current_dir_name "" (* Unix: "./" *)
+let curdir_len = String.length curdir
+
+(* Hints to partially detects if two paths refer to the same directory *)
+
+(** cut path [p] after all the [/] that come at position [pos]. *)
+let rec cut_after_dirsep p pos =
+  if CString.is_sub dirsep p pos then
+    cut_after_dirsep p (pos + dirsep_len)
+  else
+    String.sub p pos (String.length p - pos)
+
+(** remove all initial "./" in a path *)
 let rec remove_path_dot p =
-  let curdir = Filename.concat Filename.current_dir_name "" in (* Unix: "./" *)
-  let n = String.length curdir in
-  let l = String.length p in
-  if l > n && String.sub p 0 n = curdir then
-    let n' =
-      let sl = String.length Filename.dir_sep in
-      let i = ref n in
-	while !i <= l - sl && String.sub p !i sl = Filename.dir_sep do i := !i + sl done; !i in
-    remove_path_dot (String.sub p n' (l - n'))
+  if CString.is_sub curdir p 0 then
+    remove_path_dot (cut_after_dirsep p curdir_len)
   else
     p
 
+(** If a path [p] starts with the current directory $PWD then
+    [strip_path p] returns the sub-path relative to $PWD.
+    Any leading "./" are also removed from the result. *)
 let strip_path p =
   let cwd = Filename.concat (Sys.getcwd ()) "" in (* Unix: "`pwd`/" *)
-  let n = String.length cwd in
-  let l = String.length p in
-  if l > n && String.sub p 0 n = cwd then
-    let n' =
-      let sl = String.length Filename.dir_sep in
-      let i = ref n in
-	while !i <= l - sl && String.sub p !i sl = Filename.dir_sep do i := !i + sl done; !i in
-    remove_path_dot (String.sub p n' (l - n'))
+  if CString.is_sub cwd p 0 then
+    remove_path_dot (cut_after_dirsep p (String.length cwd))
   else
     remove_path_dot p
 
@@ -59,31 +65,54 @@ let canonical_path_name p =
 let make_suffix name suffix =
   if Filename.check_suffix name suffix then name else (name ^ suffix)
 
-let correct_path f dir = if Filename.is_relative f then Filename.concat dir f else f
+let get_extension f =
+  let pos = try String.rindex f '.' with Not_found -> String.length f in
+  String.sub f pos (String.length f - pos)
+
+let correct_path f dir =
+  if Filename.is_relative f then Filename.concat dir f else f
 
 let file_readable_p name =
-  try Unix.access name [Unix.R_OK];true with Unix.Unix_error (_, _, _) -> false
+  try Unix.access name [Unix.R_OK];true
+  with Unix.Unix_error (_, _, _) -> false
 
-let run_command converter f c =
+(* As for [Unix.close_process], a [Unix.waipid] that ignores all [EINTR] *)
+
+let rec waitpid_non_intr pid =
+  try snd (Unix.waitpid [] pid)
+  with Unix.Unix_error (Unix.EINTR, _, _) -> waitpid_non_intr pid
+
+(** [run_command com] launches command [com] (via /bin/sh),
+    and returns the contents of stdout and stderr. If given, [~hook]
+    is called on each elements read on stdout or stderr. *)
+
+let run_command ?(hook=(fun _ ->())) c =
   let result = Buffer.create 127 in
   let cin,cout,cerr = Unix.open_process_full c (Unix.environment ()) in
   let buff = String.make 127 ' ' in
   let buffe = String.make 127 ' ' in
   let n = ref 0 in
   let ne = ref 0 in
-
   while n:= input cin buff 0 127 ; ne := input cerr buffe 0 127 ;
     !n+ !ne <> 0
   do
-    let r = converter (String.sub buff 0 !n) in
-    f r;
-    Buffer.add_string result r;
-    let r = converter (String.sub buffe 0 !ne) in
-    f r;
-    Buffer.add_string result r
+    let r = String.sub buff 0 !n in (hook r; Buffer.add_string result r);
+    let r = String.sub buffe 0 !ne in (hook r; Buffer.add_string result r);
   done;
   (Unix.close_process_full (cin,cout,cerr),  Buffer.contents result)
 
+(** [sys_command] launches program [prog] with arguments [args].
+    It behaves like [Sys.command], except that we rely on
+    [Unix.create_process], it's hardly more complex and avoids dealing
+    with shells. In particular, no need to quote arguments
+    (against whitespace or other funny chars in paths), hence no need
+    to care about the different quoting conventions of /bin/sh and cmd.exe. *)
+
+let sys_command prog args =
+  let argv = Array.of_list (prog::args) in
+  let pid = Unix.create_process prog argv Unix.stdin Unix.stdout Unix.stderr in
+  waitpid_non_intr pid
+
 (*
   checks if two file names refer to the same (existing) file by
   comparing their device and inode.