utils/conf.ml

   1 #load "unix.cma";;
   2
   3 module Conf =
   4   struct
   5     open Format
   6
   7
   8
   9     let o_fmt = ref std_formatter
  10     let o_chan = ref stdout
  11
  12     let start () =
  13       ignore (Sys.command "cp myocamlbuild_config.ml.in myocamlbuild_config.ml");
  14       o_chan := open_out_gen [ Open_append ] 0  "myocamlbuild_config.ml";
  15       o_fmt := formatter_of_out_channel !o_chan
  16
  17     ;;
  18
  19     let finish () =
  20       pp_print_flush !o_fmt ();
  21       close_out !o_chan
  22     ;;
  23
  24     let getc b c =
  25       try Buffer.add_channel b c 1; true with End_of_file -> false
  26     ;;
  27     let contents b =
  28       let last = Buffer.length b - 1 in
  29       if last < 0 || Buffer.nth b last <> '\n' then Buffer.contents b
  30       else Buffer.sub b 0 last
  31     ;;
  32
  33     let explode ?(sep=[ ' '; '\t'; '\n']) s =
  34       let b = Buffer.create 512 in
  35       let seq = ref [] in
  36       for i = 0 to String.length s - 1 do
  37         let c = s.[i] in
  38         if List.mem c sep then
  39           let e = Buffer.contents b in
  40           Buffer.clear b;
  41           if String.length e > 0 then seq := e :: ! seq;
  42         else
  43           Buffer.add_char b c
  44       done;
  45       List.rev !seq
  46     ;;
  47     let version s =
  48       match explode ~sep:[ '.' ; '+' ] s with
  49         | [major; minor] -> int_of_string major, int_of_string minor, 0
  50         | [major; minor; patch]
  51         | [major; minor; patch; _ ] ->
  52           int_of_string major, int_of_string minor, int_of_string patch
  53         | _ -> eprintf "Invalid version string \"%s\"\n%!" Sys.ocaml_version; exit 1
  54     ;;
  55     let pr_str fmt s = fprintf fmt "%S" s
  56     ;;
  57     let pr_list fmt l =
  58       fprintf fmt "[ ";
  59       begin
  60         match l with
  61             [] -> ()
  62           | [s] -> fprintf fmt "%S" s
  63           | s :: ll -> fprintf fmt "%S" s; List.iter (fun s -> fprintf fmt "; %S" s) ll
  64       end;
  65       fprintf fmt " ]"
  66
  67     let exec cmd =
  68       let (sout, _, serr) as chans =
  69         Unix.open_process_full cmd (Unix.environment ())
  70       in
  71       let bout = Buffer.create 512
  72       and berr = Buffer.create 512 in
  73       while (getc bout sout) || (getc berr serr) do () done;
  74       match Unix.close_process_full chans with
  75         | Unix.WEXITED c -> (c, contents bout, contents berr)
  76         | _ -> eprintf "Interrupted\n%!"; exit 1
  77     ;;
  78
  79     let check_cond ?(required=true) ~display ~fmt_msg ~ok ~fail run cmd cond =
  80       printf fmt_msg display;
  81       let res  = run cmd in
  82       if cond res then printf " %s\n%!" ok
  83       else begin
  84         printf " %s\n%!" fail;
  85         if required then
  86           (printf "%s is required to buid the project\n%!" display; exit 1);
  87       end;
  88       res
  89     ;;
  90
  91     let run_prog ?(required=true) ~display ~fmt_msg ~ok ~fail cmd =
  92       check_cond
  93         ~required:required
  94         ~display:display
  95         ~fmt_msg:fmt_msg ~ok:ok ~fail:fail
  96         exec cmd (fun (c, _, _) -> c == 0)
  97     ;;
  98
  99     let cfmt = format_of_string ("Checking for %- 25s ");;
 100     let cok = "ok";;
 101     let cfail = "failed"
 102     ;;
 103     let prog ?(required=true) display cmd =
 104      run_prog ~required:required ~display:display ~fmt_msg:cfmt ~ok:cok ~fail:cfail cmd
 105     ;;
 106     let check_prog ?(required=true) display cmd =
 107       ignore (prog ~required:required display cmd)
 108     ;;
 109     let check ?(required=true) display run cmd cond =
 110       check_cond
 111         ~required:required
 112         ~display:display
 113         ~fmt_msg:cfmt ~ok:cok ~fail:cfail
 114         run cmd cond
 115     ;;
 116
 117     let def v p d = fprintf !o_fmt "let %s = %a;;\n%!" v p d
 118     ;;
 119     let def_str v d = def v pr_str d;;
 120     let def_list v l = def v pr_list l;;
 121
 122     let exec_def v cmd =
 123       let c,o, _ = exec cmd in
 124       if c = 0 then def v pr_str o
 125     ;;
 126
 127     let exec_def_list v cmd =
 128       let c,o, _ = exec cmd in
 129       if c = 0 then def v pr_list (explode o)
 130     ;;
 131
 132     let absolute fmt =
 133       Printf.sprintf fmt (Sys.getcwd())
 134
 135   end
 136 ;;