Refacto gwpublic scripts

geneweb · Sep 1, 2021 · 7c2ea62 · 7c2ea62
1 parent d3eac4d
commit 7c2ea62
Show file tree

Hide file tree

Showing 8 changed files with 115 additions and 291 deletions.
diff --git a/gwpublic/gwiftitles.ml b/gwpublic/gwiftitles.ml
diff --git a/gwpublic/gwprivate.ml b/gwpublic/gwprivate.ml
diff --git a/gwpublic/gwpublic.ml b/gwpublic/gwpublic.ml
diff --git a/gwpublic/gwpublic2.ml b/gwpublic/gwpublic2.ml
diff --git a/gwpublic/README.MD → privacy/README.MD b/gwpublic/README.MD → privacy/README.MD
diff --git a/gwpublic/gwaccess.ml → privacy/gwaccess.ml b/gwpublic/gwaccess.ml → privacy/gwaccess.ml
@@ -1,31 +1,31 @@
-open Geneweb
-open Gwdb
+let open Def in
+let open Gwdb in
 
 (** [oldest_year_of p]
     Find a year in [[ birth ; baptism ; death ]].
 *)
 let oldest_year_of p =
-  let open Def in
   match Adef.od_of_cdate (get_birth p) with
   | Some (Dgreg (d, _)) -> Some d.year
   | _ -> match Adef.od_of_cdate (get_baptism p) with
     | Some (Dgreg (d, _)) -> Some d.year
     | _ -> match Date.date_of_death (get_death p) with
       | Some (Dgreg (d, _)) -> Some d.year
       | _ -> None
+in
 
 (** [most_recent_year_of p]
     Find a year in [[ death ; baptism ; birth ]].
 *)
 let most_recent_year_of p =
-  let open Def in
   match Date.date_of_death (get_death p) with
   | Some (Dgreg (d, _)) -> Some d.year
   | _ -> match Adef.od_of_cdate (get_baptism p) with
     | Some (Dgreg (d, _)) -> Some d.year
     | _ -> match Adef.od_of_cdate (get_birth p) with
       | Some (Dgreg (d, _)) -> Some d.year
       | _ -> None
+in
 
 let find_dated_ancestor base p =
   let mark = Gwdb.iper_marker (Gwdb.ipers base) false in
@@ -65,58 +65,27 @@ let find_dated_ancestor base p =
       loop_ind anc_list
   in
   loop 1 [get_iper p]
+in
 
-let input_person file =
-  let pl = ref [] in
-  begin match (try Some (open_in file) with Sys_error _ -> None) with
-    Some ic ->
-      begin try
-        while true do let line = input_line ic in pl := line :: !pl done
-      with End_of_file -> ()
-      end;
-      close_in ic
-  | None -> Printf.eprintf "Error while opening file %s\n" file; flush stderr
-  end;
-  List.rev !pl
-
-let access_everybody access bname =
-  let base = Gwdb.open_base bname in
+let access_everybody access base =
   Gwdb.Collection.iter begin fun p ->
     if get_access p <> access then
       let p = {(gen_person_of_person p) with Def.access = access} in
       patch_person base p.Def.key_index p
-  end (Gwdb.persons base) ;
-  commit_patches base
-
-let access_some access bname key =
-  let base = Gwdb.open_base bname in
-  match Gutil.person_ht_find_all base key with
-    [ip] ->
-      let p = poi base ip in
-      if get_access p <> access then
-        begin let p = {(gen_person_of_person p) with Def.access = access} in
-          patch_person base p.Def.key_index p
-        end;
-      commit_patches base
-  | _ ->
-      match Gutil.person_of_string_dot_key base key with
-        Some ip ->
-          let p = poi base ip in
-          if get_access p <> access then
-            begin let p =
-              {(gen_person_of_person p) with Def.access = access}
-            in
-              patch_person base p.Def.key_index p
-            end;
-          commit_patches base
-      | None -> Printf.eprintf "Bad key %s\n" key; flush stderr
+  end (Gwdb.persons base)
+in
 
-let access_some_list access bname file =
-  if Sys.file_exists file then
-    let pl = input_person file in List.iter (access_some access bname) pl
-  else
-    begin
-      Printf.eprintf "File does not exist : %s\n" file;
-      flush stderr;
-      exit 2
+let access_some access base key =
+  match
+    match Gutil.person_ht_find_all base key with
+    | [ip] -> Some ip
+    | _ -> Gutil.person_of_string_dot_key base key
+  with
+  | Some ip ->
+    let p = poi base ip in
+    if get_access p <> access then begin
+      let p = { (gen_person_of_person p) with Def.access = access } in
+      patch_person base p.Def.key_index p
     end
+  | None -> Printf.eprintf "Bad key %s\n" key ; flush stderr
+in