init_cache_info: Avoid code duplication.

geneweb · Apr 5, 2019 · c6e95f6 · c6e95f6
1 parent 32f233a
commit c6e95f6
Show file tree

Hide file tree

Showing 5 changed files with 44 additions and 92 deletions.
diff --git a/bin/contrib/gwFix/gwFixBase.ml b/bin/contrib/gwFix/gwFixBase.ml
@@ -286,36 +286,6 @@ let check_fevents_witnesses ~verbosity1 ~verbosity2 base nb_fam fix =
   done;
   if verbosity1 then ProgrBar.finish ()
 
-
-(* FIXME: copy/paste depuis mk_consang *)
-let init_cache_info bname base =
-  (* Reset le nombre réel de personnes d'une base. *)
-  let nb_real_persons = ref 0 in
-  let nb_ind = Gwdb.nb_of_persons base in
-  let is_empty_name p =
-    (Gwdb.is_empty_string (Gwdb.get_surname p) ||
-     Gwdb.is_quest_string (Gwdb.get_surname p)) &&
-    (Gwdb.is_empty_string (Gwdb.get_first_name p) ||
-     Gwdb.is_quest_string (Gwdb.get_first_name p))
-  in
-  for i = 0 to nb_ind - 1 do
-    let ip = Adef.iper_of_int i in
-    let p = Gwdb.poi base ip in
-    if not @@ is_empty_name p then incr nb_real_persons
-  done;
-  (* Il faudrait que cache_nb_base_persons ne soit pas dans util.ml *)
-  let ht = Hashtbl.create 1 in
-  let () =
-    Hashtbl.add ht "cache_nb_persons" (string_of_int !nb_real_persons)
-  in
-  let bdir =
-    if Filename.check_suffix bname ".gwb" then bname else bname ^ ".gwb"
-  in
-  let fname = Filename.concat bdir "cache_info" in
-  match try Some (Secure.open_out_bin fname) with Sys_error _ -> None with
-    Some oc -> output_value oc ht; close_out oc
-  | None -> ()
-
 let check
     ~verbosity
     ~fast
@@ -358,11 +328,14 @@ let check
     flush stdout
   end ;
   if verbosity1 then (Printf.printf "Rebuilding the indexes..\n" ; flush stdout) ;
-  (* FIXME: this one only works with base1 *)
-  Gwdb.apply_base1 base
-    (fun base -> Outbase.gen_output false base.Dbdisk.data.Dbdisk.bdir base) ;
+  begin match Gwdb.ascends_array base with
+  | (_, _, _, None) ->
+    Gwdb.apply_base1 base
+      (fun base -> Outbase.gen_output false base.Dbdisk.data.Dbdisk.bdir base) 
+  | _ -> ()
+  end ;
   (* On recalcul le nombre reel de personnes. *)
-  init_cache_info bname base ;
+  Util.init_cache_info bname base ;
   if verbosity1 then (Printf.printf "Done" ; flush stdout)
 
 (**/**)

diff --git a/bin/distrib/mk_consang/mk_consang.ml b/bin/distrib/mk_consang/mk_consang.ml
@@ -24,34 +24,6 @@ let anonfun s =
   if !fname = "" then fname := s
   else raise (Arg.Bad "Cannot treat several databases")
 
-let init_cache_info bname base =
-  (* Reset le nombre réel de personnes d'une base. *)
-  let nb_real_persons = ref 0 in
-  let nb_ind = Gwdb.nb_of_persons base in
-  let is_empty_name p =
-    (Gwdb.is_empty_string (Gwdb.get_surname p) ||
-     Gwdb.is_quest_string (Gwdb.get_surname p)) &&
-    (Gwdb.is_empty_string (Gwdb.get_first_name p) ||
-     Gwdb.is_quest_string (Gwdb.get_first_name p))
-  in
-  for i = 0 to nb_ind - 1 do
-    let ip = Adef.iper_of_int i in
-    let p = Gwdb.poi base ip in
-    if not @@ is_empty_name p then incr nb_real_persons
-  done;
-  (* Il faudrait que cache_nb_base_persons ne soit pas dans util.ml *)
-  let ht = Hashtbl.create 1 in
-  let () =
-    Hashtbl.add ht "cache_nb_persons" (string_of_int !nb_real_persons)
-  in
-  let bdir =
-    if Filename.check_suffix bname ".gwb" then bname else bname ^ ".gwb"
-  in
-  let fname = Filename.concat bdir "cache_info" in
-  match try Some (Secure.open_out_bin fname) with Sys_error _ -> None with
-    Some oc -> output_value oc ht; close_out oc
-  | None -> ()
-
 let rebuild_field_array len pad bdir compress f =
   if !(Mutil.verbose) then
     begin
@@ -453,7 +425,7 @@ let simple_output bname base carray =
            in
            Outbase.gen_output (no_patches && not !indexes) bname base);
       (* On recalcul le nombre reel de personnes. *)
-      init_cache_info bname base
+      Util.init_cache_info bname base
 
 let main () =
   Argl.parse speclist anonfun errmsg;

diff --git a/lib/db1link.ml b/lib/db1link.ml
@@ -1290,34 +1290,6 @@ let output_command_line bdir =
   Printf.fprintf oc "\n";
   close_out oc
 
-let init_cache_info bname base =
-  (* Reset le nombre réel de personnes d'une base. *)
-  let nb_real_persons = ref 0 in
-  let nb_ind = Gwdb.nb_of_persons base in
-  let is_empty_name p =
-    (Gwdb.is_empty_string (Gwdb.get_surname p) ||
-     Gwdb.is_quest_string (Gwdb.get_surname p)) &&
-    (Gwdb.is_empty_string (Gwdb.get_first_name p) ||
-     Gwdb.is_quest_string (Gwdb.get_first_name p))
-  in
-  for i = 0 to nb_ind - 1 do
-    let ip = Adef.iper_of_int i in
-    let p = Gwdb.poi base ip in
-    if is_empty_name p then () else incr nb_real_persons
-  done;
-  (* Il faudrait que cache_nb_base_persons ne soit pas dans util.ml *)
-  let ht = Hashtbl.create 1 in
-  let () =
-    Hashtbl.add ht "cache_nb_persons" (string_of_int !nb_real_persons)
-  in
-  let bdir =
-    if Filename.check_suffix bname ".gwb" then bname else bname ^ ".gwb"
-  in
-  let fname = Filename.concat bdir "cache_info" in
-  match try Some (Secure.open_out_bin fname) with Sys_error _ -> None with
-    Some oc -> output_value oc ht; close_out oc
-  | None -> ()
-
 let link next_family_fun bdir =
   let tmp_dir = Filename.concat "gw_tmp" bdir in
   (try Mutil.mkdir_p tmp_dir with _ -> ());
@@ -1399,7 +1371,7 @@ let link next_family_fun bdir =
       (try Mutil.remove_dir tmp_dir with _ -> ());
       (try Unix.rmdir "gw_tmp" with _ -> ());
       output_command_line bdir;
-      init_cache_info bdir base;
+      Util.init_cache_info bdir base;
       true
     end
   else false
diff --git a/lib/util.ml b/lib/util.ml
@@ -3725,3 +3725,35 @@ let rm_rf dir =
   let (directories, files) = ls_r [dir] |> List.partition Sys.is_directory in
   List.iter Unix.unlink files ;
   List.iter Unix.rmdir directories
+
+let init_cache_info bname base =
+  match Gwdb.ascends_array base with
+  | (_, _, _, None) ->
+    begin
+      (* Reset le nombre réel de personnes d'une base. *)
+      let nb_real_persons = ref 0 in
+      let nb_ind = Gwdb.nb_of_persons base in
+      let is_empty_name p =
+        (Gwdb.is_empty_string (Gwdb.get_surname p) ||
+         Gwdb.is_quest_string (Gwdb.get_surname p)) &&
+        (Gwdb.is_empty_string (Gwdb.get_first_name p) ||
+         Gwdb.is_quest_string (Gwdb.get_first_name p))
+      in
+      for i = 0 to nb_ind - 1 do
+        let ip = Adef.iper_of_int i in
+        let p = Gwdb.poi base ip in
+        if is_empty_name p then () else incr nb_real_persons
+      done;
+      let ht = Hashtbl.create 1 in
+      let () =
+        Hashtbl.add ht cache_nb_base_persons (string_of_int !nb_real_persons)
+      in
+      let bdir =
+        if Filename.check_suffix bname ".gwb" then bname else bname ^ ".gwb"
+      in
+      let fname = Filename.concat bdir "cache_info" in
+      match try Some (Secure.open_out_bin fname) with Sys_error _ -> None with
+        Some oc -> output_value oc ht; close_out oc
+      | None -> ()
+    end
+  | _ -> ()
diff --git a/lib/util.mli b/lib/util.mli
@@ -389,3 +389,6 @@ val escape_html : string -> string
    Text is escaped using [escape_html].
  *)
 val safe_html : string -> string
+
+(**/**)
+val init_cache_info : string -> Gwdb.base -> unit