103 lines
2.7 KiB
OCaml
103 lines
2.7 KiB
OCaml
(* Generate <package>.install from setup.log *)
|
|
|
|
#use "install_tags.ml"
|
|
|
|
module String_map = Map.Make(String)
|
|
let string_map_of_list =
|
|
List.fold_left
|
|
(fun acc (k, v) ->
|
|
assert (not (String_map.mem k acc));
|
|
String_map.add k v acc)
|
|
String_map.empty
|
|
|
|
let lines_of_file fn =
|
|
let ic = open_in fn in
|
|
let rec loop acc =
|
|
match input_line ic with
|
|
| exception End_of_file ->
|
|
close_in ic;
|
|
List.rev acc
|
|
| line ->
|
|
loop (line :: acc)
|
|
in
|
|
loop []
|
|
|
|
let read_setup_log () =
|
|
lines_of_file "setup.log"
|
|
|> List.map (fun line -> Scanf.sscanf line "%S %S" (fun tag arg -> (tag, arg)))
|
|
|
|
let read_setup_data () =
|
|
lines_of_file "setup.data"
|
|
|> List.map (fun line -> Scanf.sscanf line "%[^=]=%S" (fun k v -> (k, v)))
|
|
|
|
let remove_cwd =
|
|
let prefix = Sys.getcwd () ^ "/" in
|
|
let len_prefix = String.length prefix in
|
|
fun fn ->
|
|
let len = String.length fn in
|
|
if len >= len_prefix && String.sub fn 0 len_prefix = prefix then
|
|
String.sub fn len_prefix (len - len_prefix)
|
|
else
|
|
fn
|
|
|
|
let gen_section oc name files =
|
|
let pr fmt = Printf.fprintf oc (fmt ^^ "\n") in
|
|
pr "%s: [" name;
|
|
List.iter
|
|
(fun (src, dst) ->
|
|
let src = remove_cwd src in
|
|
let dst =
|
|
match dst with
|
|
| None -> Filename.basename src
|
|
| Some fn -> fn
|
|
in
|
|
if src = dst then
|
|
pr " %S" src
|
|
else
|
|
pr " %S {%S}" src dst)
|
|
files;
|
|
pr "]"
|
|
|
|
let rec filter_log tags log acc =
|
|
match log with
|
|
| [] -> acc
|
|
| (tag, fname) :: rest ->
|
|
match String_map.find tag tags with
|
|
| exception Not_found -> filter_log tags rest acc
|
|
| dst -> filter_log tags rest ((fname, dst) :: acc)
|
|
|
|
let () =
|
|
let log = read_setup_log () in
|
|
let setup_data = read_setup_data () in
|
|
let ext_dll =
|
|
match List.assoc "ext_dll" setup_data with
|
|
| ext -> ext
|
|
| exception Not_found -> ".so"
|
|
in
|
|
let merge name files map =
|
|
match String_map.find name map with
|
|
| files' -> String_map.add name (files @ files') map
|
|
| exception Not_found -> String_map.add name files map
|
|
in
|
|
let sections =
|
|
List.fold_left
|
|
(fun acc (name, tags, extra_files) ->
|
|
let tags = string_map_of_list tags in
|
|
let files = filter_log tags log [] @ extra_files in
|
|
if name = "lib" then
|
|
let stubs, others =
|
|
List.partition
|
|
(fun (fn, _) -> Filename.check_suffix fn ext_dll)
|
|
files
|
|
in
|
|
merge "lib" others (merge "stublibs" stubs acc)
|
|
else
|
|
merge name files acc)
|
|
String_map.empty sections
|
|
|> String_map.bindings
|
|
|> List.filter (fun (_, l) -> l <> [])
|
|
in
|
|
let oc = open_out (package_name ^ ".install") in
|
|
List.iter (fun (name, files) -> gen_section oc name files) sections;
|
|
close_out oc
|