Commits

camlspotter committed c0d7208

copied some functions from orakuda

Comments (0)

Files changed (8)

    xlazy
    xformat
    xfilename
+   xunix
    phantom
    weaktbl
    spot
   let res = f v in
   let end_ = Unix.gettimeofday () in
   res, end_ -. start
-
   include Filename
   include Xfilename
 end
+include Xfilename.Open
+
+module Unix = struct
+  include Unix
+  include Xunix
+end

lib/xfilename.mli

 val split_extension : string -> string * string
+(** [split_extension path] split the body and extension of [path].
+    [split_extension "hello.world.txt" = "hello.world", "text"]
+    [split_extension "hello_world" = "hello_world", ""]
+*)
+
 module Open : sig
   val (^/) : string -> string -> string
+  (** Same as Filename.concat *)
 end
 
 
 
 let is_postfix ~postfix:sub str =
   is_prefix ~from:(String.length str - String.length sub) ~prefix: sub str
+
+let rec index_rec s lim i c =
+  if i >= lim then None else
+    if String.unsafe_get s i = c then Some i else index_rec s lim (i +
+  1) c
+;;
+  
+let index_from_to s from to_ c =
+  let l = String.length s in
+  if from < 0 || from > to_ || to_ >= l then 
+    invalid_arg "Xstring.index_from_to" 
+  else
+    index_rec s (to_+1) from c
+;;
+
+let chop_newline s =
+  let len = String.length s in
+  if len > 1 && s.[len-1] = '\n' then
+    if len > 2 && s.[len-2] = '\r' then String.sub s 0 (len-2)
+    else String.sub s 0 (len-1)
+  else s
 val is_prefix : ?from:int -> prefix:string -> string -> bool
 val is_postfix : postfix:string -> string -> bool
+val index_from_to : string -> int -> int -> char -> int option
 val index_string_from : string -> int -> string -> int (* may raise Not_found *)
+
+val chop_newline : string -> string
+(** [chop_newline s] returns the string [s] w/o the newline chars at the end.
+    [chop_newline "hello\r\n" = "hello"]
+    [chop_newline "hello\n" = "hello"]
+    [chop_newline "hello" = "hello"]
+*)
+
+open Base
+open Unix
+
 (* run [f] on files in [path] *)
 let folddir ~f ~init path =
   let dh = opendir path in
-  protect ~f:(fun () ->
+  protect (fun () ->
     let rec loop st =
       try
         let st' = f st (readdir dh) in
     if is_dir path then find_dir path
     else find_non_dir path) fnames
 ;;
+
+let try_set_close_on_exec fd =
+  try set_close_on_exec fd; true with Invalid_argument _ -> false
+;;
+    
+let open_proc_full cmd input output error toclose =
+  let cloexec = List.for_all try_set_close_on_exec toclose in
+  match fork() with
+    0 ->
+      dup2 input stdin; close input;
+      dup2 output stdout; close output;
+      dup2 error stderr; close error;
+      if not cloexec then List.iter close toclose;
+      begin try execv "/bin/sh" [| "/bin/sh"; "-c"; cmd |]
+        with _ -> exit 127
+      end (* never return *)
+  | id -> id
+;;
+
+let open_process_full cmd =
+  let (in_read, in_write) = pipe() in
+  let (out_read, out_write) = pipe() in
+  let (err_read, err_write) = pipe() in
+  let pid = open_proc_full cmd 
+    out_read in_write err_write [in_read; out_write; err_read]
+  in
+  close out_read;
+  close in_write;
+  close err_write;
+  pid, (in_read, out_write, err_read)
+;;
+    
+let buf_flush_limit = 100000
+;;
+    
+let command_aux readers =
+  let read_buflen = 4096 in
+  let read_buf = String.create read_buflen in
+  let try_read_lines fd buf =
+    let read_bytes = 
+      try Some (read fd read_buf 0 read_buflen) with
+      | Unix_error ((EAGAIN | EWOULDBLOCK), _, _) -> None
+    in
+    match read_bytes with
+    | None -> [], false
+    | Some 0 -> (* eof *)
+        let s = Buffer.contents buf in
+        (if s = "" then [] else [s]), true
+    | Some len ->
+        let buffer_old_len = Buffer.length buf in
+        Buffer.add_substring buf read_buf 0 len;
+
+        let pos_in_buffer pos = buffer_old_len + pos in
+        
+        let rec get_lines st from_in_buffer pos =  
+          match
+            if pos >= len then None
+            else Xstring.index_from_to read_buf pos (len-1) '\n'
+          with
+          | None ->
+              let rem =
+                Buffer.sub buf
+                  from_in_buffer
+                  (Buffer.length buf - from_in_buffer)
+              in
+              Buffer.clear buf;
+              if String.length rem > buf_flush_limit then rem :: st
+              else begin
+                Buffer.add_string buf rem; st
+              end
+          | Some pos ->
+              let next_from_in_buffer = pos_in_buffer pos + 1 in
+              let line =
+                Buffer.sub buf
+                  from_in_buffer
+                  (next_from_in_buffer - from_in_buffer)
+              in
+              get_lines (line :: st) next_from_in_buffer (pos + 1)
+        in
+        List.rev (get_lines [] 0 0), false
+  in
+
+  let rec loop readers =
+    if readers = [] then () (* no more reader and no need to loop *)
+    else begin
+      let fds = List.map (fun (fd, _, _) -> fd) readers in 
+      let readables, _, _ = select fds [] [](*?*) (-1.0)(*?*) in
+      let readers' = 
+        List.fold_right (fun (fd, buf, fs as reader) st ->
+          if not (List.mem fd readables) then
+            reader :: st
+          else begin
+            let rec loop () =
+              let lines, is_eof = try_read_lines fd buf in
+              if lines <> [] then begin
+                List.iter (fun line ->
+                  List.iter (fun f -> f (`Read line)) fs) lines;
+                if not is_eof then loop () else is_eof
+              end else is_eof 
+            in
+            if loop () then begin
+	      (* reached eof. remove the reader *)
+	      List.iter (fun f -> f `EOF) fs;
+              close fd; 
+	      st
+            end else reader :: st
+          end) readers []
+
+      in
+      loop readers'
+    end
+  in
+  loop readers
+;;
+
+let rec waitpid_non_intr pid =
+  try waitpid [] pid 
+  with Unix_error (EINTR, _, _) -> waitpid_non_intr pid
+;;
+    
+let command cmd ~f =
+  let pid, (out, in_, err) = open_process_full cmd in
+  try
+    close in_;
+    set_nonblock out;
+    set_nonblock err;
+    
+    let buf_out = Buffer.create buf_flush_limit in
+    let buf_err = Buffer.create buf_flush_limit in
+
+    command_aux
+      [out, buf_out, [fun s -> f (`Out, s)];
+       err, buf_err, [fun s -> f (`Err, s)]];
+    snd (waitpid_non_intr pid)
+  with
+  | e ->
+      (* kill really ? *)
+      kill pid 9;
+      ignore (waitpid_non_intr pid);
+      raise e
+;;
+open Unix
+
 type path = 
     { dir : string;
       base : string;
 (** for [find] *)
 
 val find : f:(path -> unit) -> string list -> unit
+
+val command :
+  string 
+  -> f: ([> `Out | `Err] * [ `Read of string | `EOF ] -> unit) 
+  -> Unix.process_status
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.