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