Merge branch 'local-ocamlbuild' into local-trunk

[SXSI/xpathcomp.git] / utils / conf.ml

diff --git a/utils/conf.ml b/utils/conf.ml
new file mode 100644 (file)
index 0000000..b044c02
--- /dev/null
+++ b/utils/conf.ml
@@ -0,0 +1,135 @@
+#load "unix.cma";;
+
+module Conf =
+  struct
+    open Format
+
+
+
+    let o_fmt = ref std_formatter
+    let o_chan = ref stdout
+
+    let start () =
+      ignore (Sys.command "cp myocamlbuild_config.ml.in myocamlbuild_config.ml");
+      o_chan := open_out_gen [ Open_append ] 0  "myocamlbuild_config.ml";
+      o_fmt := formatter_of_out_channel !o_chan
+    ;;
+
+    let finish () =
+      pp_print_flush !o_fmt ();
+      close_out !o_chan
+    ;;
+
+    let getc b c =
+      try Buffer.add_channel b c 1; true with End_of_file -> false
+    ;;
+    let contents b =
+      let last = Buffer.length b - 1 in
+      if last < 0 || Buffer.nth b last <> '\n' then Buffer.contents b
+      else Buffer.sub b 0 last
+    ;;
+
+    let explode ?(sep=[ ' '; '\t'; '\n']) s =
+      let b = Buffer.create 512 in
+      let seq = ref [] in
+      for i = 0 to String.length s - 1 do
+       let c = s.[i] in
+       if List.mem c sep then
+         let e = Buffer.contents b in
+         Buffer.clear b;
+         if String.length e > 0 then seq := e :: ! seq;
+       else
+         Buffer.add_char b c
+      done;
+      List.rev !seq
+    ;;
+    let version s =
+      match explode ~sep:[ '.' ; '+' ] s with
+       | [major; minor] -> int_of_string major, int_of_string minor, 0
+       | [major; minor; patch]
+       | [major; minor; patch; _ ] ->
+         int_of_string major, int_of_string minor, int_of_string patch
+       | _ -> eprintf "Invalid version string \"%s\"\n%!" Sys.ocaml_version; exit 1
+    ;;
+    let pr_str fmt s = fprintf fmt "%S" s
+    ;;
+    let pr_list fmt l =
+      fprintf fmt "[ ";
+      begin
+       match l with
+           [] -> ()
+         | [s] -> fprintf fmt "%S" s
+         | s :: ll -> fprintf fmt "%S" s; List.iter (fun s -> fprintf fmt "; %S" s) ll
+      end;
+      fprintf fmt " ]"
+
+    let exec cmd =
+      let (sout, _, serr) as chans =
+       Unix.open_process_full cmd (Unix.environment ())
+      in
+      let bout = Buffer.create 512
+      and berr = Buffer.create 512 in
+      while (getc bout sout) || (getc berr serr) do () done;
+      match Unix.close_process_full chans with
+       | Unix.WEXITED c -> (c, contents bout, contents berr)
+       | _ -> eprintf "Interrupted\n%!"; exit 1
+    ;;
+
+    let check_cond ?(required=true) ~display ~fmt_msg ~ok ~fail run cmd cond =
+      printf fmt_msg display;
+      let res  = run cmd in
+      if cond res then printf " %s\n%!" ok
+      else begin
+       printf " %s\n%!" fail;
+       if required then
+         (printf "%s is required to buid the project\n%!" display; exit 1);
+      end;
+      res
+    ;;
+
+    let run_prog ?(required=true) ~display ~fmt_msg ~ok ~fail cmd =
+      check_cond
+       ~required:required
+       ~display:display
+       ~fmt_msg:fmt_msg ~ok:ok ~fail:fail
+       exec cmd (fun (c, _, _) -> c == 0)
+    ;;
+
+    let cfmt = format_of_string ("Checking for %- 25s ");;
+    let cok = "ok";;
+    let cfail = "failed"
+    ;;
+    let prog ?(required=true) display cmd =
+     run_prog ~required:required ~display:display ~fmt_msg:cfmt ~ok:cok ~fail:cfail cmd
+    ;;
+    let check_prog ?(required=true) display cmd =
+      ignore (prog ~required:required display cmd)
+    ;;
+    let check ?(required=true) display run cmd cond =
+      check_cond
+       ~required:required
+       ~display:display
+       ~fmt_msg:cfmt ~ok:cok ~fail:cfail
+       run cmd cond
+    ;;
+
+    let def v p d = fprintf !o_fmt "let %s = %a;;\n%!" v p d
+    ;;
+    let def_str v d = def v pr_str d;;
+    let def_list v l = def v pr_list l;;
+
+    let exec_def v cmd =
+      let c,o, _ = exec cmd in
+      if c = 0 then def v pr_str o
+    ;;
+
+    let exec_def_list v cmd =
+      let c,o, _ = exec cmd in
+      if c = 0 then def v pr_list (explode o)
+    ;;
+
+    let absolute fmt =
+      Printf.sprintf fmt (Sys.getcwd())
+
+  end
+;;