Commits

camlspotter committed 8b994b6

Unix.Find

Comments (0)

Files changed (3)

 - Added (*>)
 - Unix.{file, mkdtemp, with_dtemp} added
 - Unix.mkdir is overridden
+- Added Unix.Find with poly record interface
 
 2.1.2
 ------------
     in
     loop init)
     ~finally:(fun _ -> closedir dh)
-;;
+
 
 module Inodes = Set.Make(struct
   type t = int * int
   let compare : t -> t -> int = compare
 end)
-;;
+
 
 type path = 
     { dir : string;
     depth = depth; 
     stat = try `Ok (stat path) with e -> `Error e;
   }
-;;
+
 
 let kind path =
   match path.stat with
   | `Error _exn -> None
   | `Ok stat -> Some stat.st_kind
-;;
+
 
 let is_dir path = kind path = Some S_DIR
+let is_reg path = kind path = Some S_REG
 
 let dev_inode path =
   match path.stat with
     in
     if is_dir path then find_dir path
     else find_non_dir path) fnames
-;;
+
+
+module Find = struct
+
+  class type path = object
+    method base : string
+    method depth : int
+    method dev_inode : (int * int, exn) Result.t
+    method dir : string
+    method is_dir : bool
+    method is_reg : bool
+    method kind : (Unix.file_kind, exn) Result.t
+    method path : string
+    method stat : (Unix.stats, exn) Result.t
+  end
+
+  class path_ ~dir ~base ~depth = 
+    let path = match Filename.concat dir base with
+      | "./." -> "."
+      | s -> s
+    in
+    object (self)
+      method dir = dir
+      method base = base
+      method path = path
+      method depth : int = depth
+      method stat : (_,_) Result.t = try `Ok (stat path) with e -> `Error e
+      method kind : (_,_) Result.t = match self#stat with
+        | `Error _exn -> `Error _exn
+        | `Ok stat -> `Ok stat.st_kind
+      method is_dir = self#kind = `Ok S_DIR
+      method is_reg = self#kind = `Ok S_REG
+      method dev_inode : (_,_) Result.t = match self#stat with
+      | `Ok stat -> `Ok (stat.st_dev, stat.st_ino)
+      | `Error e -> `Error e
+    end
+
+  let prune () = raise Prune
+  
+  let find ~f fnames =
+  
+    (* visited cache *)
+    let visited = ref Inodes.empty in
+    let if_not_visited_then path ~f = match path#dev_inode with
+      | `Error _ -> ()
+      | `Ok inode ->
+          if Inodes.mem inode !visited then ()
+          else begin
+            visited := Inodes.add inode !visited;
+            f path
+          end
+    in
+  
+    let rec find_dir pth =
+      try 
+        f pth;
+        let subdirs =
+          folddir pth#path ~init:[] ~f:(fun dirs -> function
+            | "." | ".." -> dirs
+            | name -> 
+        	let pth = new path_ ~depth:(pth#depth + 1) ~dir:pth#path ~base:name in
+        	if try pth#is_dir with _ -> false then pth::dirs
+        	else begin find_non_dir pth; dirs end)
+        in
+        List.iter (if_not_visited_then ~f:find_dir) subdirs
+      with
+      | Prune -> ()
+  
+    and find_non_dir path = try f path with Prune -> ()
+      (* Even if path is a dangling symlink, f path is called *)
+    in
+  
+    List.iter (fun fname ->
+      let path = 
+        new path_ ~depth: 0 ~dir:(Filename.dirname fname) ~base:(Filename.basename fname)
+      in
+      if path#is_dir then find_dir path
+      else find_non_dir path) fnames
+  
+end
 
 let try_set_close_on_exec fd =
   try set_close_on_exec fd; true with Invalid_argument _ -> false
-;;
+
     
 module Process_status = struct
 
       begin try execvp cmd cmdargs with _ -> exit 127
       end (* never return *)
   | id -> id
-;;
+
 
 let open_process_full cmdargs =
   let (in_read, in_write) = pipe() in
   close in_write;
   close err_write;
   pid, (in_read, out_write, err_read)
-;;
+
     
 let open_shell_process_full cmd = open_process_full [ "/bin/sh"; "-c"; cmd ]
-;;
+
 
 let buf_flush_limit = 100000
-;;
+
     
 let command_aux readers stat =
   let read_buflen = 4096 in
     end
   in
   loop readers stat
-;;
+
 
 let rec waitpid_non_intr pid =
   try 
     waitpid [] pid 
   with Unix_error (EINTR, _, _) -> waitpid_non_intr pid
-;;
+
     
 let command_wrapper (pid, (out, in_, err)) f ~init:stat =
   try
       kill pid 9;
       ignore (waitpid_non_intr pid);
       raise e
-;;
+
 
 let print_all = function
   | `Err, `Read s -> prerr_endline & Xstring.chop_newline s
   | `TRUE st -> `Already_exists st (* CR jfuruse: perm check ? *)
   | `FALSE st -> `Not_a_directory st
   | `Error e -> `Error e
-;;
+
 
 let mkdtemp template =
   match Xstring.is_postfix' "XXXXXX" template with
       stat : [ `Ok of stats | `Error of exn ];
       depth : int;
     }
+(** for [find]. Deprecated. *)
+
+val find : f:(path -> unit) -> string list -> unit
+(** Deprecated. Use [Find.find]. *)
 
 val prune : unit -> 'exn
-(** for [find] *)
+(** for [find]. Deprecated. *)
 
-val find : f:(path -> unit) -> string list -> unit
+val is_dir : path -> bool
+(** for [find]. Deprecated. *)
+val is_reg : path -> bool
+(** for [find]. Deprecated. *)
+
+module Find : sig
+
+  class type path = object
+    method base : string
+    method depth : int
+    method dev_inode : (int * int, exn) Result.t
+    method dir : string
+    method is_dir : bool
+    method is_reg : bool
+    method kind : (Unix.file_kind, exn) Result.t
+    method path : string
+    method stat : (Unix.stats, exn) Result.t
+  end
+
+  val prune : unit -> 'a
+  val find : f:(path -> unit) -> string list -> unit
+
+end
 
 module Process_status : sig