Initial comit - Clone

bin/update_nldb/dune.in

@@ -0,0 +1,6 @@
+(executables
+  (names update_nldb)
+  (public_names geneweb.update_nldb)
+  (modules update_nldb)
+  (libraries unix str %%%GWDB_PKG%%% %%%SOSA_PKG%%% geneweb)
+)

bin/update_nldb/update_nldb.ml

@@ -0,0 +1,196 @@
+(* Copyright (c) 1998-2007 INRIA *)
+
+open Geneweb
+open Def
+open Gwdb
+
+let fname = ref ""
+let errmsg = "usage: " ^ Sys.argv.(0) ^ " [options] <file_name>"
+let speclist = []
+
+let anonfun s =
+  if !fname = "" then fname := s
+  else raise (Arg.Bad "Cannot treat several databases")
+
+let notes_links s =
+  let slen = String.length s in
+  let rec loop list_nt list_ind pos i =
+    if i = slen then (list_nt, list_ind)
+    else if i + 1 < slen && s.[i] = '%' then loop list_nt list_ind pos (i + 2)
+    else
+      match NotesLinks.misc_notes_link s i with
+      | NotesLinks.WLpage (j, _, lfname, _, _) ->
+          let list_nt =
+            if List.mem lfname list_nt then list_nt else lfname :: list_nt
+          in
+          loop list_nt list_ind pos j
+      | NotesLinks.WLperson (j, key, _, text) ->
+          let list_ind =
+            let link = { NLDB.lnTxt = text; lnPos = pos } in
+            (key, link) :: list_ind
+          in
+          loop list_nt list_ind (pos + 1) j
+      | NotesLinks.WLwizard (j, _, _) -> loop list_nt list_ind (pos + 1) j
+      | NotesLinks.WLnone -> loop list_nt list_ind pos (i + 1)
+  in
+  loop [] [] 1 0
+
+let read_file_contents fname =
+  match try Some (open_in fname) with Sys_error _ -> None with
+  | Some ic -> (
+      let len = ref 0 in
+      try
+        let rec loop () =
+          len := Buff.store !len (input_char ic);
+          loop ()
+        in
+        loop ()
+      with End_of_file -> Buff.get !len)
+  | None -> ""
+
+let compute base bdir =
+  let bdir =
+    if Filename.check_suffix bdir ".gwb" then bdir else bdir ^ ".gwb"
+  in
+  let nb_ind = nb_of_persons base in
+  let nb_fam = nb_of_families base in
+  let db = ref [] in
+  Printf.eprintf "--- database notes\n";
+  flush stderr;
+  let list = notes_links (base_notes_read base "") in
+  (if list = ([], []) then ()
+  else
+    let pg = NLDB.PgNotes in
+    db := NotesLinks.add_in_db !db pg list);
+  Printf.eprintf "--- wizard notes\n";
+  flush stderr;
+  (try
+     let files = Sys.readdir (Filename.concat bdir (base_wiznotes_dir base)) in
+     for i = 0 to Array.length files - 1 do
+       let file = files.(i) in
+       if Filename.check_suffix file ".txt" then
+         let wizid = Filename.chop_suffix file ".txt" in
+         let wfile =
+           List.fold_left Filename.concat bdir [ base_wiznotes_dir base; file ]
+         in
+         let list = notes_links (read_file_contents wfile) in
+         if list = ([], []) then ()
+         else (
+           Printf.eprintf "%s... " wizid;
+           flush stderr;
+           let pg = NLDB.PgWizard wizid in
+           db := NotesLinks.add_in_db !db pg list)
+     done;
+     Printf.eprintf "\n";
+     flush stderr
+   with Sys_error _ -> ());
+  Printf.eprintf "--- misc notes\n";
+  flush stderr;
+  let ndir = Filename.concat bdir (base_notes_dir base) in
+  let rec loop dir name =
+    try
+      let cdir = Filename.concat ndir dir in
+      let files = Sys.readdir cdir in
+      for i = 0 to Array.length files - 1 do
+        let file = files.(i) in
+        if Filename.check_suffix file ".txt" then (
+          let fnotes = Filename.chop_suffix file ".txt" in
+          let file = Filename.concat dir fnotes in
+          let list = notes_links (base_notes_read base file) in
+          if list = ([], []) then ()
+          else
+            let fnotes =
+              if name = "" then fnotes
+              else Printf.sprintf "%s%c%s" name NotesLinks.char_dir_sep fnotes
+            in
+            Printf.eprintf "%s...\n" fnotes;
+            flush stderr;
+            let pg = NLDB.PgMisc fnotes in
+            db := NotesLinks.add_in_db !db pg list)
+        else
+          loop (Filename.concat dir file)
+            (if name = "" then file
+            else Printf.sprintf "%s%c%s" name NotesLinks.char_dir_sep file)
+      done;
+      flush stderr
+    with Sys_error _ -> ()
+  in
+  loop Filename.current_dir_name "";
+  let buffer = Buffer.create 1024 in
+  let add_string istr =
+    Buffer.add_string buffer @@ sou base istr;
+    Buffer.add_char buffer ' '
+  in
+  ProgrBar.full := '*';
+  Printf.eprintf "--- individual notes\n";
+  flush stderr;
+  ProgrBar.start ();
+  Gwdb.Collection.iteri
+    (fun i p ->
+      ProgrBar.run i nb_ind;
+      Buffer.reset buffer;
+      add_string @@ get_notes p;
+      add_string @@ get_occupation p;
+      add_string @@ get_birth_note p;
+      add_string @@ get_birth_src p;
+      add_string @@ get_baptism_note p;
+      add_string @@ get_baptism_src p;
+      add_string @@ get_death_note p;
+      add_string @@ get_death_src p;
+      add_string @@ get_burial_note p;
+      add_string @@ get_burial_src p;
+      add_string @@ get_psources p;
+      List.iter
+        (fun { epers_note; epers_src } ->
+          add_string epers_note;
+          add_string epers_src)
+        (get_pevents p);
+      match notes_links (Buffer.contents buffer) with
+      | [], [] -> ()
+      | list -> db := NotesLinks.add_in_db !db (NLDB.PgInd (get_iper p)) list)
+    (Gwdb.persons base);
+  ProgrBar.finish ();
+  Printf.eprintf "--- families notes\n";
+  flush stderr;
+  ProgrBar.start ();
+  Gwdb.Collection.iteri
+    (fun i fam ->
+      ProgrBar.run i nb_fam;
+      Buffer.reset buffer;
+      add_string @@ get_comment fam;
+      add_string @@ get_fsources fam;
+      add_string @@ get_marriage_note fam;
+      add_string @@ get_marriage_src fam;
+      List.iter
+        (fun { efam_note; efam_src; _ } ->
+          add_string @@ efam_note;
+          add_string @@ efam_src)
+        (get_fevents fam);
+      match notes_links (Buffer.contents buffer) with
+      | [], [] -> ()
+      | list ->
+          db := NotesLinks.add_in_db !db (NLDB.PgFam (get_ifam fam)) list;
+          ProgrBar.run i nb_fam)
+    (Gwdb.families base);
+  ProgrBar.finish ();
+  write_nldb base !db
+
+let main () =
+  Arg.parse speclist anonfun errmsg;
+  if !fname = "" then (
+    Printf.eprintf "Missing database name\n";
+    Printf.eprintf "Use option -help for usage\n";
+    flush stderr;
+    exit 2);
+  Secure.set_base_dir (Filename.dirname !fname);
+  let base = Gwdb.open_base !fname in
+  Sys.catch_break true;
+  let () = load_strings_array base in
+  let () = load_unions_array base in
+  try compute base !fname
+  with Sys.Break ->
+    Printf.eprintf "\n";
+    flush stderr;
+    ()
+
+let _ = Printexc.print main ()