1(* $Id: gwdiff.ml,v 5.0 2005-12-13 11:51:26 ddr Exp $ *)
2(* Copyright (c) 2001 Ludovic LEDIEU *)
3
4open Def;
5open Gutil;
6
7(*= TODO =====================================================================
8  - Improve the way not to check several time the same persons.
9=========================================================================== *)
10
11value in_file1 = ref "";
12value in_file2 = ref "";
13value html = ref False;
14value root = ref "";
15value cr = ref "";
16
17type messages =
18  [ MsgBadChild of iper
19  | MsgBirthDate
20  | MsgBirthPlace
21  | MsgChildMissing of iper
22  | MsgChildren of iper
23  | MsgDeathDate
24  | MsgDeathPlace
25  | MsgDivorce
26  | MsgFirstName
27  | MsgOccupation
28  | MsgParentsMissing
29  | MsgMarriageDate
30  | MsgMarriagePlace
31  | MsgSex
32  | MsgSpouseMissing of iper
33  | MsgSpouses of iper
34  | MsgSurname ]
35;
36
37value person_string base iper =
38  let p = poi base iper in
39  let fn = sou base p.first_name in
40  let sn = sou base p.surname in
41  if sn = "?" || fn = "?" then
42    fn ^ " " ^ sn ^ " (#" ^ string_of_int (Adef.int_of_iper iper) ^ ")"
43  else fn ^ "." ^ (string_of_int p.occ) ^ " " ^ sn
44;
45
46value person_link bname base iper target =
47  if html.val then
48    Printf.sprintf "<A HREF=\"%s%s_w?i=%d\" TARGET=\"%s\">%s</A>"
49      root.val bname (Adef.int_of_iper iper) target (person_string base iper)
50  else
51    person_string base iper
52;
53
54value print_message base1 base2 msg =
55  do {
56    Printf.printf " ";
57    match msg with
58    [ MsgBadChild iper1 ->
59        Printf.printf "can not isolate one child match: %s"
60          (person_link in_file1.val base1 iper1 "base1")
61    | MsgBirthDate ->
62        Printf.printf "birth date"
63    | MsgBirthPlace ->
64        Printf.printf "birth place"
65    | MsgChildMissing iper1 ->
66        Printf.printf "child missing: %s"
67          (person_link in_file1.val base1 iper1 "base1")
68    | MsgChildren iper1 ->
69        Printf.printf "more than one child match: %s"
70          (person_link in_file1.val base1 iper1 "base1")
71    | MsgDeathDate ->
72        Printf.printf "death (status or date)"
73    | MsgDeathPlace ->
74        Printf.printf "death place"
75    | MsgDivorce ->
76        Printf.printf "divorce"
77    | MsgFirstName ->
78        Printf.printf "first name"
79    | MsgOccupation ->
80        Printf.printf "occupation"
81    | MsgParentsMissing ->
82        Printf.printf "parents missing"
83    | MsgMarriageDate ->
84        Printf.printf "marriage date"
85    | MsgMarriagePlace ->
86        Printf.printf "marriage place"
87    | MsgSex ->
88        Printf.printf "sex"
89    | MsgSpouseMissing iper1 ->
90        Printf.printf "spouse missing: %s"
91          (person_link in_file1.val base1 iper1 "base1")
92    | MsgSpouses iper1 ->
93        Printf.printf "more than one spouse match: %s"
94          (person_link in_file1.val base1 iper1 "base1")
95    | MsgSurname ->
96        Printf.printf "surname" ];
97    Printf.printf "%s" cr.val
98  }
99;
100
101value print_f_messages base1 base2 ifam1 ifam2 res =
102  let c1 = coi base1 ifam1 in
103  let c2 = coi base2 ifam2 in
104  do {
105    Printf.printf "%s x %s%s/ %s x %s%s"
106      (person_link in_file1.val base1 c1.father "base1")
107      (person_link in_file1.val base1 c1.mother "base1")
108      cr.val
109      (person_link in_file2.val base2 c2.father "base2")
110      (person_link in_file2.val base2 c2.mother "base2")
111      cr.val;
112    List.iter (print_message base1 base2) res
113  }
114;
115
116value print_p_messages base1 base2 iper1 iper2 res =
117  do {
118    Printf.printf "%s / %s%s"
119      (person_link in_file1.val base1 iper1 "base1")
120      (person_link in_file2.val base2 iper2 "base2")
121      cr.val;
122    List.iter (print_message base1 base2) res
123  }
124;
125
126value compatible_names src_name dest_name_list =
127  let src_name = Name.lower src_name in
128  let dest_name_list = List.map Name.lower dest_name_list in
129  List.mem src_name dest_name_list
130;
131
132value compatible_str_field istr1 istr2 =
133  (Adef.int_of_istr istr1 = 0) || (Adef.int_of_istr istr2 != 0)
134;
135
136value dmy_to_sdn_range_l dmy =
137  let sdn_of_dmy dmy =
138    let sdn = Calendar.sdn_of_gregorian dmy in
139    let sdn =
140      if dmy.month = 0 || dmy.day = 0 then sdn + 1
141      else sdn
142    in
143    let sdn2 =
144      if dmy.delta != 0 then sdn + dmy.delta
145      else
146        let dmy2 =
147          { year = if dmy.month = 0 ||
148                      (dmy.month = 12 && dmy.day = 0) then (dmy.year +1)
149                   else dmy.year;
150            month = if dmy.month = 0 then 1
151                    else if dmy.day = 0 then
152                      if dmy.month = 12 then 1
153                      else dmy.month + 1
154                    else dmy.month;
155            day =  if dmy.day = 0 then 1 else dmy.day;
156            prec = if dmy.month = 0 || dmy.day = 0 then Before else Sure;
157            delta = dmy.delta }
158        in
159    let sdn2 = Calendar.sdn_of_gregorian dmy2 in
160    if dmy2.prec = Before then sdn2 - 1 else sdn2
161    in
162  (sdn, sdn2)
163  in
164  match dmy.prec with
165  [ Sure ->
166      let (sdn1, sdn2) = sdn_of_dmy dmy in
167      [ (Some sdn1, Some sdn2) ]
168  | Maybe ->
169      let (sdn1, sdn2) = sdn_of_dmy dmy in
170      [ (Some sdn1, Some sdn2) ; (None, None) ]
171  | About ->
172      let (sdn1, sdn2) = sdn_of_dmy dmy in
173      let delta = (sdn2 - sdn1 + 1) * 5 in
174      [ (Some (sdn1 - delta), Some (sdn2 + delta)) ]
175  | Before ->
176      let (sdn1, sdn2) = sdn_of_dmy dmy in
177      [ (None, Some sdn2) ]
178  | After ->
179      let (sdn1, sdn2) = sdn_of_dmy dmy in
180      [ (Some sdn1, None) ]
181  | OrYear y ->
182      let dmy2 =
183        { year = y + 1;
184          month = 0;
185          day = 0;
186          prec = Sure;
187          delta = 0 }
188      in
189      let (sdn11, sdn12) = sdn_of_dmy dmy in
190      let (sdn21, sdn22) = sdn_of_dmy dmy2 in
191      [ (Some sdn11, Some sdn12) ; (Some sdn21, Some sdn22) ]
192  | YearInt y ->
193      let dmy2 =
194        { year = y + 1;
195          month = 0;
196          day = 0;
197          prec = Sure;
198          delta = 0 }
199      in
200      let (sdn11, sdn12) = sdn_of_dmy dmy in
201      let (sdn21, sdn22) = sdn_of_dmy dmy2 in
202      [ (Some sdn11, Some sdn22) ] ]
203;
204
205value compatible_sdn (sdn11, sdn12) (sdn21, sdn22) =
206  if (sdn21, sdn22) = (None, None) then True
207  else
208    let bool1 =
209      match (sdn11, sdn21) with
210      [ (Some sdn1, Some sdn2) -> sdn1 <= sdn2
211      | (None, _) -> True
212      | (Some _, None) -> False ]
213    in
214    let bool2 =
215      match (sdn12, sdn22) with
216      [ (Some sdn1, Some sdn2) -> sdn1 >= sdn2
217      | (None, _) -> True
218      | (Some _, None) -> False ]
219    in
220    bool1 && bool2
221;
222
223value compatible_sdn_l sdn1_l sdn2 =
224  List.fold_left (fun r sdn1 -> r || (compatible_sdn sdn1 sdn2))
225    False sdn1_l
226;
227
228value compatible_sdn_ll sdn1_l sdn2_l =
229  List.fold_left (fun r sdn2 -> r && (compatible_sdn_l sdn1_l sdn2))
230    True sdn2_l
231;
232
233value compatible_dmys dmy1 dmy2 =
234  compatible_sdn_ll (dmy_to_sdn_range_l dmy1) (dmy_to_sdn_range_l dmy2)
235;
236
237value compatible_dates date1 date2 =
238  let compatible_cals cal1 cal2 =
239    match (cal1, cal2) with
240    [ (Dgregorian, Djulian)
241    | (Dgregorian, Dfrench) -> True
242    | _ -> cal1 = cal2 ]
243  in
244  if date1 = date2 then True
245  else
246    match (date1, date2) with
247    [ (Dgreg dmy1 cal1, Dgreg dmy2 cal2) ->
248        compatible_dmys dmy1 dmy2
249        && compatible_cals cal1 cal2
250    | (Dgreg _ _, Dtext _) -> False
251    | (Dtext _, _) -> True ]
252;
253
254value compatible_codates codate1 codate2 =
255  let od1 = Adef.od_of_codate codate1 in
256  let od2 = Adef.od_of_codate codate2 in
257  match (od1, od2) with
258  [ (Some date1, Some date2) -> compatible_dates date1 date2
259  | (Some _, None) -> False
260  | (None, _) -> True ]
261;
262
263value compatible_birth base1 base2 p1 p2 =
264  let get_birth person =
265    if person.birth = Adef.codate_None then person.baptism
266    else person.birth
267  in
268  let birth1 = get_birth p1 in
269  let birth2 = get_birth p2 in
270  let res1 =
271    if compatible_codates birth1 birth2 then []
272    else [ MsgBirthDate ]
273  in
274  let res2 =
275    if compatible_str_field p1.birth_place p2.birth_place then []
276    else [ MsgBirthPlace ]
277  in
278  res1 @ res2
279;
280
281value compatible_death base1 base2 p1 p2 =
282  let bool1 =
283    p1.death = p2.death ||
284    match (p1.death, p2.death) with
285    [ (Death _ cdate1, Death _ cdate2) ->
286        let date1 = Adef.date_of_cdate cdate1 in
287        let date2 = Adef.date_of_cdate cdate2 in
288        compatible_dates date1 date2
289    | (NotDead, _)
290    | (DeadYoung, Death _ _)
291    | (DeadDontKnowWhen, Death _ _ | DeadYoung | DeadDontKnowWhen)
292    | (DontKnowIfDead, _) -> True
293    | _ -> False ]
294  in
295  let res1 =
296    if bool1 then []
297    else [ MsgDeathDate ]
298  in
299  let res2 =
300    if compatible_str_field p1.death_place p2.death_place then []
301    else [ MsgDeathPlace ]
302  in
303  res1 @ res2
304;
305
306value compatible_sexes base1 base2 p1 p2 =
307  if p1.sex = p2.sex then []
308  else [ MsgSex ]
309;
310
311value compatible_occupations base1 base2 p1 p2 =
312  if compatible_str_field p1.occupation p2.occupation then []
313  else [ MsgOccupation ]
314;
315
316value compatible_persons_ligth base1 base2 p1 p2 =
317  let fn1 = sou base1 p1.first_name in
318  let fn2 = sou base2 p2.first_name in
319  let afn2 = [fn2 :: List.map (sou base2) p2.first_names_aliases] in
320  let sn1 = sou base1 p1.surname in
321  let sn2 = sou base2 p2.surname in
322  let asn2 = [sn2 :: List.map (sou base2) p2.surnames_aliases] in
323  let res1 =
324    if compatible_names fn1 afn2 then []
325    else [ MsgFirstName ]
326  in
327  let res2 =
328    if compatible_names sn1 asn2 then []
329    else [ MsgSurname ]
330  in
331  res1 @ res2
332;
333
334value compatible_persons base1 base2 p1 p2 =
335  compatible_persons_ligth base1 base2 p1 p2
336  @ compatible_sexes base1 base2 p1 p2
337  @ compatible_birth base1 base2 p1 p2
338  @ compatible_death base1 base2 p1 p2
339  @ compatible_occupations base1 base2 p1 p2
340;
341
342value rec find_compatible_persons_ligth base1 base2 iper1 iper2_list =
343  match iper2_list with
344  [ [] -> []
345  | [ head :: rest ] ->
346       let p1 = poi base1 iper1 in
347       let p2 = poi base2 head in
348       let c_rest = find_compatible_persons_ligth base1 base2 iper1 rest in
349       if compatible_persons_ligth base1 base2 p1 p2 = [] then [ head :: c_rest ]
350       else c_rest ]
351;
352
353value rec find_compatible_persons base1 base2 iper1 iper2_list =
354  match iper2_list with
355  [ [] -> []
356  | [ head :: rest ] ->
357       let p1 = poi base1 iper1 in
358       let p2 = poi base2 head in
359       let c_rest = find_compatible_persons base1 base2 iper1 rest in
360       if compatible_persons base1 base2 p1 p2 = [] then [ head :: c_rest ]
361       else c_rest ]
362;
363
364value compatible_unions base1 base2 iper1 iper2 ifam1 ifam2 =
365  let get_spouse base iper ifam =
366    let c = coi base ifam in
367      if iper = c.father then poi base c.mother
368      else poi base c.father
369  in
370  let spouse1 = get_spouse base1 iper1 ifam1 in
371  let spouse2 = get_spouse base2 iper2 ifam2 in
372  compatible_persons_ligth base1 base2 spouse1 spouse2
373;
374
375value rec find_compatible_unions base1 base2 iper1 iper2 ifam1 ifam2_list =
376  match ifam2_list with
377  [ [] -> []
378  | [ head :: rest ] ->
379       let c_rest = find_compatible_unions base1 base2 iper1 iper2 ifam1 rest in
380       if compatible_unions base1 base2 iper1 iper2 ifam1 head = [] then
381         [ head :: c_rest ]
382       else c_rest ]
383;
384
385value compatible_divorces d1 d2 =
386  match (d1, d2) with
387  [ (Divorced codate1, Divorced codate2) ->
388      compatible_codates codate1 codate2
389  | (Divorced _, _) -> False
390  | _ -> True ]
391;
392
393value compatible_marriages base1 base2 ifam1 ifam2 =
394  let f1 = foi base1 ifam1 in
395  let f2 = foi base2 ifam2 in
396  let res1 =
397    if compatible_codates f1.marriage f2.marriage then []
398    else [ MsgMarriageDate ]
399  in
400  let res2 =
401    if compatible_divorces f1.divorce f2.divorce then []
402    else [ MsgDivorce ]
403  in
404  let res3 =
405    if compatible_str_field f1.marriage_place f2.marriage_place then []
406    else [ MsgMarriagePlace ]
407  in
408  let res = res1 @ res2 @ res3 in
409  if res = [] then ()
410  else print_f_messages base1 base2 ifam1 ifam2 res
411;
412
413value pdiff base1 base2 iper1 iper2 =
414  let p1 = poi base1 iper1 in
415  let p2 = poi base2 iper2 in
416  let res = compatible_persons base1 base2 p1 p2 in
417  if res = [] then ()
418  else print_p_messages base1 base2 iper1 iper2 res
419;
420
421value compatible_parents base1 base2 iper1 iper2 =
422  let a1 = (aoi base1 iper1).parents in
423  let a2 = (aoi base2 iper2).parents in
424  match (a1, a2) with
425  [ (Some ifam1, Some ifam2) ->
426       let c1 = coi base1 ifam1 in
427       let c2 = coi base2 ifam2 in
428       let _ = pdiff base1 base2 c1.father c2.father in
429       let _ = pdiff base1 base2 c1.mother c2.mother in
430       compatible_marriages base1 base2 ifam1 ifam2
431  | (None, _) -> ()
432  | (Some _, None) ->
433       print_p_messages base1 base2 iper1 iper2 [ MsgParentsMissing ] ]
434;
435
436value rec ddiff base1 base2 iper1 iper2 d_tab =
437  let d_check = d_tab.(Adef.int_of_iper iper1) in
438  if List.mem iper2 d_check then ()
439  else
440    let _ = d_tab.(Adef.int_of_iper iper1) := [iper2 :: d_check ] in
441  let spouse c iper =
442    if iper = c.father then c.mother
443    else c.father
444  in
445  let rec udiff base1 base2 iper1 iper2 r ifam1 ifam2 =
446    let fd b1 b2 ip2_list ip1 =
447      match find_compatible_persons_ligth b1 b2 ip1 ip2_list with
448      [ [ip2] -> ddiff base1 base2 ip1 ip2 d_tab
449      | [] ->
450          print_p_messages base1 base2 iper1 iper2 [ MsgChildMissing ip1 ]
451      | rest_list ->
452          match find_compatible_persons b1 b2 ip1 rest_list with
453          [ [best_ip2] -> ddiff base1 base2 ip1 best_ip2 d_tab
454          | [] ->
455              print_p_messages base1 base2 iper1 iper2 [ MsgBadChild ip1 ]
456          | _ ->
457              print_p_messages base1 base2 iper1 iper2 [ MsgChildren ip1 ] ] ]
458    in
459    let c1 = coi base1 ifam1 in
460    let c2 = coi base2 ifam2 in
461    let p1 = spouse c1 iper1 in
462    let p2 = spouse c2 iper2 in
463    let d1 = Array.to_list (doi base1 ifam1).children in
464    let d2 = Array.to_list (doi base2 ifam2).children in
465    do {
466      pdiff base1 base2 p1 p2;
467      List.iter (fd base1 base2 d2) d1
468    }
469  in
470  let fu b1 b2 ifam2_list ifam1 =
471    match find_compatible_unions b1 b2 iper1 iper2 ifam1 ifam2_list with
472    [ [ifam2] ->
473        do {
474          compatible_marriages b1 b2 ifam1 ifam2;
475          compatible_parents b1 b2 (spouse (coi base1 ifam1) iper1)
476            (spouse (coi base2 ifam2) iper2);
477          udiff b1 b2 iper1 iper2 True ifam1 ifam2
478        }
479    | [] ->
480        print_p_messages base1 base2 iper1 iper2
481          [ MsgSpouseMissing (spouse (coi base1 ifam1) iper1) ]
482    | _ ->
483        print_p_messages base1 base2 iper1 iper2
484          [ MsgSpouses (spouse (coi base1 ifam1) iper1) ]  ]
485  in
486  let u1 = Array.to_list (uoi base1 iper1).family in
487  let u2 = Array.to_list (uoi base2 iper2).family in
488  do {
489    pdiff base1 base2 iper1 iper2;
490    List.iter (fu base1 base2 u2) u1
491  }
492;
493
494value rec find_top base1 base2 iper1 iper2 =
495  let p1 = poi base1 iper1 in
496  let p2 = poi base2 iper2 in
497  if compatible_persons_ligth base1 base2 p1 p2 = [] then
498    let a1 = (aoi base1 iper1).parents in
499    let a2 = (aoi base2 iper2).parents in
500    match (a1, a2) with
501    [ (Some ifam1, Some ifam2) ->
502         let c1 = coi base1 ifam1 in
503         let c2 = coi base2 ifam2 in
504         let f_top_list = find_top base1 base2 c1.father c2.father in
505         let m_top_list = find_top base1 base2 c1.mother c2.mother in
506         f_top_list @ m_top_list
507    | _ -> [(iper1, iper2)] ]
508  else do {
509    Printf.printf " Warning: %s doesn't match %s%s"
510      (person_link in_file1.val base1 iper1 "base1")
511      (person_link in_file2.val base2 iper2 "base2")
512      cr.val;
513    []
514  }
515;
516
517value addiff base1 base2 iper1 iper2 d_tab =
518  let topdiff (iper1, iper2) =
519    do {
520      Printf.printf "==> %s / %s%s"
521        (person_link in_file1.val base1 iper1 "base1")
522        (person_link in_file2.val base2 iper2 "base2")
523        cr.val;
524      ddiff base1 base2 iper1 iper2 d_tab
525    }
526  in
527  do {
528    Printf.printf "Building top list...%s" cr.val;
529    let top_list = find_top base1 base2 iper1 iper2 in
530    Printf.printf "Top list built.%s" cr.val;
531    List.iter topdiff top_list
532  }
533;
534
535(* Main *)
536
537value gwdiff base1 base2 iper1 iper2 d_mode ad_mode =
538  let desc_tab = Array.make base1.data.persons.len [] in
539  match (d_mode, ad_mode) with
540  [ (True, _)
541  | (False, False) -> ddiff base1 base2 iper1 iper2 desc_tab
542  | (False, True) -> addiff base1 base2 iper1 iper2 desc_tab ]
543;
544
545value p1_fn = ref "";
546value p1_occ = ref 0;
547value p1_sn = ref "";
548value p2_fn = ref "";
549value p2_occ = ref 0;
550value p2_sn = ref "";
551
552type arg_state =
553  [ ASnone
554  | ASwaitP1occ
555  | ASwaitP1sn
556  | ASwaitP2occ
557  | ASwaitP2sn ]
558;
559value arg_state = ref ASnone;
560value mem = ref False;
561value d_mode = ref False;
562value ad_mode = ref False;
563
564value speclist =
565  [("-1", Arg.String (fun s -> do { p1_fn.val := s; arg_state.val := ASwaitP1occ }),
566    "<fn> <occ> <sn> : (mandatory) defines starting person in base1");
567   ("-2", Arg.String (fun s -> do { p2_fn.val := s; arg_state.val := ASwaitP2occ }),
568    "<fn> <occ> <sn> : (mandatory) defines starting person in base2");
569   ("-ad", Arg.Set ad_mode,
570    ": checks descendants of all ascendants ");
571   ("-d", Arg.Set d_mode,
572    ": checks descendants (default)");
573   ("-html", Arg.String (fun s -> do { html.val := True; root.val := s }),
574    "<root>: HTML format used for report");
575   ("-mem", Arg.Set mem, ": save memory space, but slower") ]
576;
577
578value anonfun s =
579  match arg_state.val with
580  [ ASnone ->
581      if in_file1.val = "" then in_file1.val := s
582      else if in_file2.val = "" then in_file2.val := s
583      else raise (Arg.Bad "Too much arguments")
584  | ASwaitP1occ ->
585      try
586        do {
587          p1_occ.val := int_of_string s;
588          arg_state.val := ASwaitP1sn
589        }
590      with
591      [ Failure _ -> raise (Arg.Bad "Numeric value for occ (-1)!") ]
592  | ASwaitP1sn -> do { p1_sn.val := s; arg_state.val := ASnone }
593  | ASwaitP2occ ->
594      try
595        do {
596          p2_occ.val := int_of_string s;
597          arg_state.val := ASwaitP2sn
598        }
599      with
600      [ Failure _ -> raise (Arg.Bad "Numeric value for occ (-2)!") ]
601  | ASwaitP2sn -> do { p2_sn.val := s; arg_state.val := ASnone }]
602;
603
604value errmsg =
605  "Usage: " ^ Sys.argv.(0) ^ " \
606[options] base1 base2
607Options are: "
608;
609
610value check_args () =
611  do {
612    Argl.parse speclist anonfun errmsg;
613    if in_file1.val = "" then
614      do {
615        Printf.printf "Missing reference data base\n";
616        Printf.printf "Use option -help for usage\n";
617        flush stdout;
618        exit 2
619      }
620    else ();
621    if in_file2.val = "" then
622      do {
623        Printf.printf "Missing destination data base\n";
624        Printf.printf "Use option -help for usage\n";
625        flush stdout;
626        exit 2
627      }
628    else ();
629    if p1_fn.val = "" then
630      do {
631        Printf.printf "-1 parameter is mandatory\n";
632        Printf.printf "Use option -help for usage\n";
633        flush stdout;
634        exit 2
635      }
636    else ();
637    if p1_sn.val = "" then
638      do {
639        Printf.printf "Incomplete -1 parameter\n";
640        Printf.printf "Use option -help for usage\n";
641        flush stdout;
642        exit 2
643      }
644    else ();
645    if p2_fn.val = "" then
646      do {
647        Printf.printf "-2 parameter is mandatory\n";
648        Printf.printf "Use option -help for usage\n";
649        flush stdout;
650        exit 2
651      }
652    else ();
653    if p2_sn.val = "" then
654      do {
655        Printf.printf "Incomplete -2 parameter\n";
656        Printf.printf "Use option -help for usage\n";
657        flush stdout;
658        exit 2
659      }
660    else ()
661  }
662;
663
664value main () =
665  let _ = check_args () in
666  let _ =
667    if not html.val then cr.val := "\n"
668    else cr.val := "<BR>\n"
669  in
670  (* Reference base *)
671  let base1 = Iobase.input in_file1.val in
672  let _ = base1.data.ascends.array () in
673  let _ = base1.data.strings.array () in
674  let _ =
675    if not mem.val then
676      let _ = base1.data.persons.array () in
677      let _ = base1.data.families.array () in
678      let _ = base1.data.couples.array () in
679      let _ = base1.data.unions.array () in
680      let _ = base1.data.descends.array () in
681      ()
682    else ()
683  in
684  (* Destination base *)
685  let base2 =
686     if in_file1.val != in_file2.val then
687       let base2 = Iobase.input in_file2.val in
688       let _ = base2.data.ascends.array () in
689       let _ = base2.data.strings.array () in
690       let _ =
691         if not mem.val then
692           let _ = base2.data.persons.array () in
693           let _ = base2.data.families.array () in
694           let _ = base2.data.couples.array () in
695           let _ = base2.data.unions.array () in
696           let _ = base2.data.descends.array () in
697           ()
698         else ()
699       in
700       base2
701     else
702       (* Reference = Destination *)
703       base1
704  in
705  let iper1 = person_ht_find_unique base1 p1_fn.val p1_sn.val p1_occ.val in
706  let iper2 = person_ht_find_unique base2 p2_fn.val p2_sn.val p2_occ.val in
707  do {
708    if html.val then
709      Printf.printf "<BODY>\n"
710    else ();
711    gwdiff base1 base2 iper1 iper2 d_mode.val ad_mode.val;
712    if html.val then
713      Printf.printf "</BODY>\n"
714    else ()
715  }
716;
717
718Printexc.catch main ();
719