Permalink
Browse files

api_saisie_write.ml: refactorization and fixed death type when adding…

… old parents/chidlren.

Merged codate and cdate type (codate was an alias of cdate).

Refacto Util.authorized_age.
  • Loading branch information...
sagotch committed Sep 21, 2018
1 parent 77360e1 commit 0da7b3a26e481bbb548eba4f6c083d15df630b05
Showing with 1,025 additions and 1,214 deletions.
  1. +1 −1 contrib/gwFix/gwFixBurial.ml
  2. +6 −6 contrib/gwFix/gwFixEvtSrc.ml
  3. +1 −1 contrib/gwFix/gwFixFromFile.ml
  4. +1 −1 contrib/gwFix/gwFixFromFileDomicile.ml
  5. +3 −3 contrib/gwbase/etc/geneanet.ml
  6. +3 −3 contrib/gwbase/etc/gwBaseLib.ml
  7. +1 −1 contrib/gwbase/etc/lune.ml
  8. +1 −1 contrib/gwbase/etc/nbdesc.ml
  9. +4 −4 contrib/gwbase/etc/popule.ml
  10. +2 −2 contrib/gwbase/etc/public.ml
  11. +1 −1 contrib/gwbase/etc/public2.ml
  12. +1 −1 contrib/gwbase/etc/selroySelect.ml
  13. +7 −7 contrib/gwdiff/gwdiff.ml
  14. +18 −18 contrib/gwpublic/gwpublic1.ml
  15. +1 −1 contrib/gwpublic/gwpublic2.ml
  16. +1 −1 contrib/gwpublic/gwpublic2priv.ml
  17. +3 −3 contrib/history/convert_hist.ml
  18. +3 −3 contrib/history/fix_hist.ml
  19. +1 −1 contrib/oneshot/gwFixAddEvent.ml
  20. +14 −14 contrib/oneshot/gwFixDateText.ml
  21. +29 −29 ged2gwb/ged2gwb.camlp5
  22. +22 −22 ged2gwb/ged2gwb2.camlp5
  23. +6 −6 gwb2ged/gwb2ged.ml
  24. +3 −5 internal/adef.ml
  25. +3 −4 internal/adef.mli
  26. +2 −2 internal/check.ml
  27. +28 −28 internal/checkItem.ml
  28. +2 −2 internal/checkItem.mli
  29. +3 −3 internal/database.ml
  30. +8 −8 internal/date.ml
  31. +0 −1 internal/date.mli
  32. +11 −11 internal/db2link.ml
  33. +10 −11 internal/def.mli
  34. +2 −2 internal/gutil.ml
  35. +22 −22 internal/gwcomp.ml
  36. +2 −2 internal/gwcomp.mli
  37. +6 −6 internal/gwdb.ml
  38. +3 −3 internal/gwdb.mli
  39. +18 −18 internal/gwuLib.ml
  40. +22 −22 internal/history_diff.ml
  41. +6 −0 internal/opt.ml
  42. +1 −1 internal/select.ml
  43. +89 −17 internal/update.camlp5
  44. +5 −1 internal/update.mli
  45. +45 −43 internal/util.ml
  46. +6 −6 lib/advSearchOk.ml
  47. +4 −4 lib/api.ml
  48. +5 −5 lib/api_link.ml
  49. +25 −25 lib/api_saisie_read.ml
  50. +285 −508 lib/api_saisie_write.ml
  51. +4 −4 lib/api_stats.ml
  52. +3 −3 lib/api_update_family.ml
  53. +26 −73 lib/api_update_person.ml
  54. +11 −11 lib/api_update_util.ml
  55. +25 −25 lib/api_util.ml
  56. +8 −8 lib/birthDeath.ml
  57. +6 −6 lib/birthday.ml
  58. +13 −13 lib/db1link.ml
  59. +4 −4 lib/descend.ml
  60. +4 −4 lib/mergeFam.ml
  61. +4 −4 lib/mergeFamOk.ml
  62. +16 −16 lib/mergeInd.ml
  63. +5 −5 lib/mergeIndOk.ml
  64. +66 −66 lib/perso.ml
  65. +1 −1 lib/perso.mli
  66. +9 −9 lib/perso_link.ml
  67. +3 −3 lib/some.ml
  68. +12 −12 lib/title.ml
  69. +6 −6 lib/updateFam.ml
  70. +15 −15 lib/updateFamOk.ml
  71. +11 −11 lib/updateInd.ml
  72. +21 −19 lib/updateIndOk.ml
  73. +4 −4 lib/updateIndOk.mli
  74. +2 −2 src/mk_consang.ml
@@ -25,7 +25,7 @@ let update_database_with_burial base =
flush stderr
end;
let evt =
{epers_name = Epers_Burial; epers_date = Adef.codate_None;
{epers_name = Epers_Burial; epers_date = Adef.cdate_None;
epers_place = get_burial_place p; epers_reason = empty_string;
epers_note = empty_string; epers_src = get_burial_src p;
epers_witnesses = [| |]}
@@ -12,29 +12,29 @@ let update_database_with_burial base =
for i = 0 to nb_of_persons base - 1 do
let p = poi base (Adef.iper_of_int i) in
let evt_birth =
match Adef.od_of_codate (get_birth p) with
match Adef.od_of_cdate (get_birth p) with
Some d -> None
| None ->
if sou base (get_birth_place p) <> "" then None
else if sou base (get_birth_src p) = "" then None
else
let evt =
{epers_name = Epers_Birth; epers_date = Adef.codate_None;
{epers_name = Epers_Birth; epers_date = Adef.cdate_None;
epers_place = empty_string; epers_reason = empty_string;
epers_note = empty_string; epers_src = get_birth_src p;
epers_witnesses = [| |]}
in
Some evt
in
let evt_bapt =
match Adef.od_of_codate (get_baptism p) with
match Adef.od_of_cdate (get_baptism p) with
Some d -> None
| None ->
if sou base (get_baptism_place p) <> "" then None
else if sou base (get_baptism_src p) = "" then None
else
let evt =
{epers_name = Epers_Baptism; epers_date = Adef.codate_None;
{epers_name = Epers_Baptism; epers_date = Adef.cdate_None;
epers_place = empty_string; epers_reason = empty_string;
epers_note = empty_string; epers_src = get_baptism_src p;
epers_witnesses = [| |]}
@@ -50,7 +50,7 @@ let update_database_with_burial base =
None
else
let evt =
{epers_name = Epers_Death; epers_date = Adef.codate_None;
{epers_name = Epers_Death; epers_date = Adef.cdate_None;
epers_place = get_death_place p; epers_reason = empty_string;
epers_note = empty_string; epers_src = get_death_src p;
epers_witnesses = [| |]}
@@ -67,7 +67,7 @@ let update_database_with_burial base =
None
else
let evt =
{epers_name = Epers_Burial; epers_date = Adef.codate_None;
{epers_name = Epers_Burial; epers_date = Adef.cdate_None;
epers_place = get_burial_place p; epers_reason = empty_string;
epers_note = empty_string; epers_src = get_burial_src p;
epers_witnesses = [| |]}
@@ -99,7 +99,7 @@ let update_database_with_domicile base fname =
flush stderr
end;
let evt =
{epers_name = Epers_Residence; epers_date = Adef.codate_None;
{epers_name = Epers_Residence; epers_date = Adef.cdate_None;
epers_place = Gwdb.insert_string base note;
epers_reason = empty; epers_note = empty; epers_src = empty;
epers_witnesses = [| |]}
@@ -99,7 +99,7 @@ let update_database_with_domicile base fname =
flush stderr
end;
let evt =
{epers_name = Epers_Residence; epers_date = Adef.codate_None;
{epers_name = Epers_Residence; epers_date = Adef.cdate_None;
epers_place = Gwdb.insert_string base note;
epers_reason = empty; epers_note = empty; epers_src = empty;
epers_witnesses = [| |]}
@@ -49,7 +49,7 @@ let main_title base =
let min_or_max_date f a base p =
let a =
match Adef.od_of_codate (get_birth p) with
match Adef.od_of_cdate (get_birth p) with
Some (Dgreg (d, _)) -> f d.year a
| _ -> a
in
@@ -62,13 +62,13 @@ let min_or_max_date f a base p =
(fun a ifam ->
let fam = foi base ifam in
let a =
match Adef.od_of_codate (get_marriage fam) with
match Adef.od_of_cdate (get_marriage fam) with
Some (Dgreg (d, _)) -> f d.year a
| _ -> a
in
match get_divorce fam with
Divorced cod ->
begin match Adef.od_of_codate cod with
begin match Adef.od_of_cdate cod with
Some (Dgreg (d, _)) -> f d.year a
| _ -> a
end
@@ -12,8 +12,8 @@ let add_indi base (fn, sn, nb) sex =
qualifiers = []; aliases = []; first_names_aliases = [];
surnames_aliases = []; titles = []; rparents = []; related = [];
occupation = empty_string; sex = sex; access = IfTitles;
birth = Adef.codate_None; birth_place = empty_string;
birth_src = empty_string; baptism = Adef.codate_None;
birth = Adef.cdate_None; birth_place = empty_string;
birth_src = empty_string; baptism = Adef.cdate_None;
baptism_place = empty_string; baptism_src = empty_string;
death = NotDead; death_place = empty_string; death_src = empty_string;
burial = UnknownBurial; burial_place = empty_string;
@@ -28,7 +28,7 @@ let add_fam base fath moth children =
let ifam = Adef.ifam_of_int (nb_of_families base) in
let empty_string = insert_string base "" in
let fam =
{marriage = Adef.codate_None; marriage_place = empty_string;
{marriage = Adef.cdate_None; marriage_place = empty_string;
marriage_src = empty_string; witnesses = [| |]; relation = Married;
divorce = NotDivorced; comment = empty_string;
origin_file = empty_string; fsources = empty_string; fam_index = ifam}
@@ -12,7 +12,7 @@ let lune bname =
let nbb = ref 0 in
for i = 0 to nb_of_persons base - 1 do
let p = poi base (Adef.iper_of_int i) in
match Adef.od_of_codate (get_birth p) with
match Adef.od_of_cdate (get_birth p) with
Some (Dgreg (dt, _)) ->
if dt.prec = Sure && dt.delta = 0 && dt.day > 0 then
begin
@@ -21,7 +21,7 @@ let apply base date nb_ind f =
for i = 0 to nb_ind - 1 do
let ip = Adef.iper_of_int i in
let p = poi base ip in
match Adef.od_of_codate (get_birth p) with
match Adef.od_of_cdate (get_birth p) with
Some (Dgreg (b_dmy, _)) ->
let alive_at_that_date =
if before_date date b_dmy then
@@ -143,7 +143,7 @@ let popule bname size ngen gyear =
let x = persons_get (Adef.int_of_iper ip) in
let d = Calendar.gregorian_of_sdn Sure (jd + Random.int 365) in
let x =
{x with birth = Adef.codate_of_od (Some (Dgreg (d, Dgregorian)))}
{x with birth = Adef.cdate_of_od (Some (Dgreg (d, Dgregorian)))}
in
persons_set (Adef.int_of_iper ip) x;
let surn = nameize i in
@@ -152,7 +152,7 @@ let popule bname size ngen gyear =
let x = persons_get (Adef.int_of_iper ip) in
let d = Calendar.gregorian_of_sdn Sure (jd + Random.int 365) in
let x =
{x with birth = Adef.codate_of_od (Some (Dgreg (d, Dgregorian)))}
{x with birth = Adef.cdate_of_od (Some (Dgreg (d, Dgregorian)))}
in
persons_set (Adef.int_of_iper ip) x
done;
@@ -186,7 +186,7 @@ let popule bname size ngen gyear =
in
let x =
{x with birth =
Adef.codate_of_od (Some (Dgreg (d, Dgregorian)))}
Adef.cdate_of_od (Some (Dgreg (d, Dgregorian)))}
in
persons_set (Adef.int_of_iper ip) x; [ip]
in
@@ -202,7 +202,7 @@ let popule bname size ngen gyear =
in
let x =
{x with birth =
Adef.codate_of_od (Some (Dgreg (d, Dgregorian)))}
Adef.cdate_of_od (Some (Dgreg (d, Dgregorian)))}
in
persons_set (Adef.int_of_iper ip) x;
if h_before_f then list @ [ip] else ip :: list
@@ -5,7 +5,7 @@ open Gwdb
let year_of p =
match
Adef.od_of_codate (get_birth p), Adef.od_of_codate (get_baptism p),
Adef.od_of_cdate (get_birth p), Adef.od_of_cdate (get_baptism p),
get_death p, CheckItem.date_of_death (get_death p)
with
_, _, NotDead, _ -> None
@@ -16,7 +16,7 @@ let year_of p =
let most_recent_year_of p =
match
Adef.od_of_codate (get_birth p), Adef.od_of_codate (get_baptism p),
Adef.od_of_cdate (get_birth p), Adef.od_of_cdate (get_baptism p),
get_death p, CheckItem.date_of_death (get_death p)
with
_, _, NotDead, _ -> None
@@ -6,7 +6,7 @@ open Gwdb
let year_of p =
match
Adef.od_of_codate (get_birth p), Adef.od_of_codate (get_baptism p),
Adef.od_of_cdate (get_birth p), Adef.od_of_cdate (get_baptism p),
get_death p, CheckItem.date_of_death (get_death p)
with
_, _, NotDead, _ -> None
@@ -53,7 +53,7 @@ let gen_good_dates base p birth_lim death_lim =
in
if death_ok then true
else
match Adef.od_of_codate (get_birth p) with
match Adef.od_of_cdate (get_birth p) with
Some (Dgreg (d, _)) -> d.year <= birth_lim
| _ -> false
View
@@ -189,22 +189,22 @@ let compatible_dates date1 date2 =
| Dgreg (_, _), Dtext _ -> false
| Dtext _, _ -> true
let compatible_codates codate1 codate2 =
let od1 = Adef.od_of_codate codate1 in
let od2 = Adef.od_of_codate codate2 in
let compatible_cdates cdate1 cdate2 =
let od1 = Adef.od_of_cdate cdate1 in
let od2 = Adef.od_of_cdate cdate2 in
match od1, od2 with
Some date1, Some date2 -> compatible_dates date1 date2
| Some _, None -> false
| None, _ -> true
let compatible_birth base1 base2 p1 p2 =
let get_birth person =
if person.birth = Adef.codate_None then person.baptism else person.birth
if person.birth = Adef.cdate_None then person.baptism else person.birth
in
let birth1 = get_birth p1 in
let birth2 = get_birth p2 in
let res1 =
if compatible_codates birth1 birth2 then [] else [MsgBirthDate]
if compatible_cdates birth1 birth2 then [] else [MsgBirthDate]
in
let res2 =
if compatible_str_field p1.birth_place p2.birth_place then []
@@ -299,15 +299,15 @@ let rec find_compatible_unions base1 base2 iper1 iper2 ifam1 ifam2_list =
let compatible_divorces d1 d2 =
match d1, d2 with
Divorced codate1, Divorced codate2 -> compatible_codates codate1 codate2
Divorced cdate1, Divorced cdate2 -> compatible_cdates cdate1 cdate2
| Divorced _, _ -> false
| _ -> true
let compatible_marriages base1 base2 ifam1 ifam2 =
let f1 = gen_family_of_family (foi base1 ifam1) in
let f2 = gen_family_of_family (foi base2 ifam2) in
let res1 =
if compatible_codates f1.marriage f2.marriage then []
if compatible_cdates f1.marriage f2.marriage then []
else [MsgMarriageDate]
in
let res2 =
@@ -4,26 +4,26 @@ open Def
open Gwdb
let year_of p =
match
Adef.od_of_codate (get_birth p), Adef.od_of_codate (get_baptism p),
get_death p, CheckItem.date_of_death (get_death p)
with
_, _, NotDead, _ -> None
| Some (Dgreg (d, _)), _, _, _ -> Some d.year
| _, Some (Dgreg (d, _)), _, _ -> Some d.year
| _, _, _, Some (Dgreg (d, _)) -> Some d.year
| _ -> None
match get_death p with
| NotDead -> None
| death -> match Adef.od_of_cdate (get_birth p) with
| Some (Dgreg (d, _)) -> Some d.year
| None -> match Adef.od_of_cdate (get_baptism p) with
| Some (Dgreg (d, _)) -> Some d.year
| None -> match CheckItem.date_of_death death with
| Some (Dgreg (d, _)) -> Some d.year
| None -> None
let most_recent_year_of p =
match
Adef.od_of_codate (get_birth p), Adef.od_of_codate (get_baptism p),
get_death p, CheckItem.date_of_death (get_death p)
with
_, _, NotDead, _ -> None
| _, _, _, Some (Dgreg (d, _)) -> Some d.year
| _, Some (Dgreg (d, _)), _, _ -> Some d.year
| Some (Dgreg (d, _)), _, _, _ -> Some d.year
| _ -> None
match get_death p with
| NotDead -> None
| death -> match CheckItem.date_of_death death with
| Some (Dgreg (d, _)) -> Some d.year
| None -> match Adef.od_of_cdate (get_baptism p) with
| Some (Dgreg (d, _)) -> Some d.year
| None -> match Adef.od_of_cdate (get_birth p) with
| Some (Dgreg (d, _)) -> Some d.year
| None -> None
let is_old lim_year p =
match year_of p with
@@ -6,7 +6,7 @@ open Gwdb
let year_of p =
match
Adef.od_of_codate (get_birth p), Adef.od_of_codate (get_baptism p),
Adef.od_of_cdate (get_birth p), Adef.od_of_cdate (get_baptism p),
get_death p, CheckItem.date_of_death (get_death p)
with
_, _, NotDead, _ -> None
@@ -5,7 +5,7 @@ open Gwdb
let year_of p =
match
Adef.od_of_codate (get_birth p), Adef.od_of_codate (get_baptism p),
Adef.od_of_cdate (get_birth p), Adef.od_of_cdate (get_baptism p),
get_death p, CheckItem.date_of_death (get_death p)
with
_, _, NotDead, _ -> None
@@ -21,10 +21,10 @@ type ('person, 'string) old_gen_person =
old_occupation : 'string;
old_sex : sex;
old_access : access;
old_birth : codate;
old_birth : cdate;
old_birth_place : 'string;
old_birth_src : 'string;
old_baptism : codate;
old_baptism : cdate;
old_baptism_place : 'string;
old_baptism_src : 'string;
old_death : death;
@@ -38,7 +38,7 @@ type ('person, 'string) old_gen_person =
old_key_index : iper }
type ('person, 'string) old_gen_family =
{ old_marriage : codate;
{ old_marriage : cdate;
old_marriage_place : 'string;
old_marriage_src : 'string;
old_witnesses : 'person array;
@@ -21,10 +21,10 @@ type ('person, 'string) old_gen_person =
old_occupation : 'string;
old_sex : sex;
old_access : access;
old_birth : codate;
old_birth : cdate;
old_birth_place : 'string;
old_birth_src : 'string;
old_baptism : codate;
old_baptism : cdate;
old_baptism_place : 'string;
old_baptism_src : 'string;
old_death : death;
@@ -38,7 +38,7 @@ type ('person, 'string) old_gen_person =
old_key_index : iper }
type ('person, 'string) old_gen_family =
{ old_marriage : codate;
{ old_marriage : cdate;
old_marriage_place : 'string;
old_marriage_src : 'string;
old_witnesses : 'person array;
@@ -88,7 +88,7 @@ let update_database_with_file base fname =
flush stderr
end;
let evt =
{epers_name = Epers_Residence; epers_date = Adef.codate_None;
{epers_name = Epers_Residence; epers_date = Adef.cdate_None;
epers_place = Gwdb.insert_string base note;
epers_reason = empty; epers_note = empty; epers_src = empty;
epers_witnesses = [| |]}
Oops, something went wrong.

0 comments on commit 0da7b3a

Please sign in to comment.