223 lines
7.1 KiB
OCaml
223 lines
7.1 KiB
OCaml
(* Yoann Padioleau
|
|
*
|
|
* Copyright (C) 2011 Facebook
|
|
*
|
|
* This library is free software; you can redistribute it and/or
|
|
* modify it under the terms of the GNU Lesser General Public License
|
|
* version 2.1 as published by the Free Software Foundation, with the
|
|
* special exception on linking described in file license.txt.
|
|
*
|
|
* This library is distributed in the hope that it will be useful, but
|
|
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file
|
|
* license.txt for more details.
|
|
*)
|
|
open Common
|
|
|
|
(*****************************************************************************)
|
|
(* Prelude *)
|
|
(*****************************************************************************)
|
|
(*
|
|
* Some code organizations are really bad. But because it's harder
|
|
* to convince people to change it, sometimes it's simpler to create
|
|
* a parallel organization, an "overlay" using simple symlinks
|
|
* that represent a better organization. One can then show
|
|
* statistics on those overlayed code organization, adapt layers,
|
|
* etc
|
|
*
|
|
* related: LFS on code.
|
|
*)
|
|
|
|
(*****************************************************************************)
|
|
(* Types *)
|
|
(*****************************************************************************)
|
|
type overlay = {
|
|
(* the filenames are in a readable path format *)
|
|
orig_to_overlay: (Common.filename, Common.filename) Hashtbl.t;
|
|
overlay_to_orig: (Common.filename, Common.filename) Hashtbl.t;
|
|
data: (Common.filename (* overlay *) * Common.filename) list;
|
|
|
|
(* in realpath format. This information is then specific
|
|
* to one user ... but infering back the root_orig/root_overlay
|
|
* from an arbitrary directory can be tedious.
|
|
*)
|
|
root_orig: Common.dirname;
|
|
root_overlay: Common.dirname;
|
|
}
|
|
|
|
(*****************************************************************************)
|
|
(* IO *)
|
|
(*****************************************************************************)
|
|
|
|
let load_overlay file =
|
|
Common2.get_value file
|
|
|
|
let save_overlay overlay file =
|
|
Common2.write_value overlay file
|
|
|
|
(*****************************************************************************)
|
|
(* Check consistency *)
|
|
(*****************************************************************************)
|
|
|
|
let check_overlay ~dir_orig ~dir_overlay =
|
|
let dir_orig = Common.fullpath dir_orig in
|
|
let files =
|
|
Common.files_of_dir_or_files_no_vcs_nofilter [dir_orig]
|
|
+> Common.exclude (fun file -> file =~ ".*/OVERLAY/.*")
|
|
in
|
|
|
|
let dir_overlay = Common.fullpath dir_overlay in
|
|
let links =
|
|
Common.cmd_to_list (spf "find %s -type l" dir_overlay) in
|
|
|
|
let links = links +> Common.map_filter (fun file ->
|
|
try Some (Common.fullpath file)
|
|
with Failure s ->
|
|
pr2 s;
|
|
None
|
|
)
|
|
in
|
|
let files2 =
|
|
links +> List.map (fun file_or_dir ->
|
|
Common.files_of_dir_or_files_no_vcs_nofilter [file_or_dir]
|
|
) +> List.flatten
|
|
in
|
|
pr2 (spf "#files orig = %d, #links overlay = %d, #files overlay = %d"
|
|
(List.length files) (List.length links) (List.length files2)
|
|
);
|
|
let h = Hashtbl.create 101 in
|
|
files2 +> List.iter (fun file ->
|
|
if Hashtbl.mem h file
|
|
then pr2 (spf "this one is a dupe: %s" file);
|
|
Hashtbl.add h file true;
|
|
);
|
|
|
|
let (_common, only_in_orig, only_in_overlay) =
|
|
Common2.diff_set_eff files files2 in
|
|
|
|
|
|
only_in_orig +> List.iter (fun l ->
|
|
pr2 (spf "this one is missing: %s" l);
|
|
);
|
|
only_in_overlay +> List.iter (fun l ->
|
|
pr2 (spf "this one is gone now: %s" l);
|
|
);
|
|
if not (null only_in_orig && null only_in_overlay)
|
|
then failwith "Overlay is not OK"
|
|
else pr2 "Overlay is OK"
|
|
|
|
(*****************************************************************************)
|
|
(* Generate equivalences *)
|
|
(*****************************************************************************)
|
|
|
|
let overlay_equivalences ~dir_orig ~dir_overlay =
|
|
let dir_overlay = Common.fullpath dir_overlay in
|
|
let dir_orig = Common.fullpath dir_orig in
|
|
|
|
let links =
|
|
Common.cmd_to_list (spf "find %s -type l" dir_overlay) in
|
|
|
|
let equiv =
|
|
links +> List.map (fun link ->
|
|
let stat = Common2.unix_stat_eff link in
|
|
match stat.Unix.st_kind with
|
|
| Unix.S_DIR ->
|
|
let (children, _) =
|
|
Common2.cmd_to_list_and_status (spf
|
|
"cd %s; find * -type f" (link)) in
|
|
let dir = Common.fullpath link in
|
|
|
|
children +> List.map (fun child ->
|
|
let overlay = Filename.concat link child in
|
|
let orig = Filename.concat dir child in
|
|
overlay, orig
|
|
)
|
|
| Unix.S_REG ->
|
|
[(link, Common.fullpath link)]
|
|
| _ ->
|
|
[]
|
|
) +> List.flatten
|
|
in
|
|
let data =
|
|
equiv +> Common.map_filter (fun (overlay, orig) ->
|
|
try
|
|
Some (
|
|
Common.readable ~root:dir_overlay overlay,
|
|
Common.readable ~root:dir_orig orig
|
|
)
|
|
with exn ->
|
|
pr2 (spf "PB with %s, exn = %s" orig (Common.exn_to_s exn));
|
|
None
|
|
)
|
|
in
|
|
{
|
|
data = data;
|
|
overlay_to_orig = Common.hash_of_list data;
|
|
orig_to_overlay = Common.hash_of_list (data +> List.map Common2.swap);
|
|
root_overlay = dir_overlay;
|
|
root_orig = dir_orig;
|
|
}
|
|
|
|
let gen_overlay ~dir_orig ~dir_overlay ~output =
|
|
let equiv = overlay_equivalences ~dir_orig ~dir_overlay in
|
|
equiv.data +> List.iter pr2_gen;
|
|
save_overlay equiv output
|
|
|
|
(*****************************************************************************)
|
|
(* Adapt layer *)
|
|
(*****************************************************************************)
|
|
|
|
let adapt_layer layer overlay =
|
|
{ layer with Layer_code.
|
|
files = layer.Layer_code.files +> Common.map_filter (fun (file, info) ->
|
|
try
|
|
Some (Hashtbl.find overlay.orig_to_overlay file, info)
|
|
with Not_found ->
|
|
pr2 (spf "PB could not find %s in overlay" file);
|
|
None
|
|
);
|
|
}
|
|
|
|
(* copy paste of the one in main_codemap.ml *)
|
|
let layers_in_dir dir =
|
|
Common2.readdir_to_file_list dir +> Common.map_filter (fun file ->
|
|
if file =~ "layer.*marshall"
|
|
then Some (Filename.concat dir file)
|
|
else None
|
|
)
|
|
|
|
let adapt_layers ~overlay ~dir_layers_orig ~dir_layers_overlay =
|
|
let layers = layers_in_dir dir_layers_orig in
|
|
|
|
layers +> List.iter (fun layer_filename ->
|
|
pr2 (spf "processing %s" layer_filename);
|
|
let layer = Layer_code.load_layer layer_filename in
|
|
let layer' = adapt_layer layer overlay in
|
|
Layer_code.save_layer layer'
|
|
(Filename.concat dir_layers_overlay (Common2.basename layer_filename))
|
|
)
|
|
|
|
|
|
(*****************************************************************************)
|
|
(* Adapt database code *)
|
|
(*****************************************************************************)
|
|
|
|
let adapt_database db overlay =
|
|
{ db with Database_code.
|
|
files = db.Database_code.files +> Common.map_filter (fun (file, info) ->
|
|
try
|
|
Some (Hashtbl.find overlay.orig_to_overlay file, info)
|
|
with Not_found ->
|
|
pr2 (spf "PB could not find %s in overlay" file);
|
|
None
|
|
);
|
|
entities = db.Database_code.entities +> Array.map (fun e ->
|
|
{ e with Database_code.
|
|
e_file =
|
|
try
|
|
(Hashtbl.find overlay.orig_to_overlay e.Database_code.e_file)
|
|
with Not_found ->
|
|
"not_found_file_overlay";
|
|
}
|
|
);
|
|
}
|