use new persons_starting_with to generate person search list

src/api_saisie_write.ml

@@ -23,55 +23,40 @@ let print_auto_complete assets conf base =
   let data = Api_saisie_write_piqi_ext.gen_auto_complete_result result in
   Api_util.print_result conf data
 
-
 let print_person_search_list conf base =
   let params = Api_util.get_params conf Api_saisie_write_piqi_ext.parse_person_search_list_params in
   let surname = params.Api_saisie_write_piqi.Person_search_list_params.lastname in
+  let surname = Option.value surname ~default:"" in
   let first_name = params.Api_saisie_write_piqi.Person_search_list_params.firstname in
-  let max_res = Int32.to_int params.Api_saisie_write_piqi.Person_search_list_params.limit in
-  let list =
-    Api_search.search_person_list base surname first_name
-  in
-  let list =
-    List.sort
-      (fun ip1 ip2 ->
-        let p1 = Gwdb.poi base ip1 in
-        let p2 = Gwdb.poi base ip2 in
-        let fn1 = Gwdb.sou base (Gwdb.get_first_name p1) in
-        let sn1 = Gwdb.sou base (Gwdb.get_surname p1) in
-        let fn2 = Gwdb.sou base (Gwdb.get_first_name p2) in
-        let sn2 = Gwdb.sou base (Gwdb.get_surname p2) in
-        let cmp_sn = Gutil.alphabetic_order sn1 sn2 in
-        if cmp_sn = 0 then
-          let cmp_fn = Gutil.alphabetic_order fn1 fn2 in
-          if cmp_fn = 0 then
-            (match
-              (Date.od_of_cdate (Gwdb.get_birth p1),
-               Date.od_of_cdate (Gwdb.get_birth p2))
-             with
-             | (Some d1, Some d2) -> Date.compare_date d1 d2
-             | (Some _, _) -> -1
-             | (_, Some _) -> 1
-             | (_, _) -> 0)
-          else cmp_fn
-        else cmp_sn)
-      list
-  in
-  (* On préfère limiter la liste ici, même si on perd un peu en performance. *)
-  let list = Geneweb.Util.reduce_list max_res list in
-  let () = Geneweb.SosaCache.build_sosa_ht conf base in
-  let list =
-    List.map
-      (fun ip ->
-        let p = Gwdb.poi base ip in
-        Api_update_util.pers_to_piqi_person_search conf base p)
-      list
-  in
+  let first_name = Option.value first_name ~default:"" in
+
+  let limit = Int32.to_int params.Api_saisie_write_piqi.Person_search_list_params.limit in
+  let conf = {conf with Geneweb.Config.env =
+                          ("first_name", Adef.encoded first_name)
+                          :: ("surname", Adef.encoded surname)
+                          :: ("exact_first_name", Adef.encoded "pfx")
+                          :: ("exact_surname", Adef.encoded "pfx")
+                          :: conf.env} in
+  let persons = fst @@ Geneweb.AdvSearchOk.advanced_search conf base limit in
+  let cmp_per p1 p2 =
+    let c1 = String.compare
+        (Gwdb.sou base (Gwdb.get_surname p1))
+        (Gwdb.sou base (Gwdb.get_surname p2))
+    in
+    if c1 = 0 then
+      String.compare
+        (Gwdb.sou base (Gwdb.get_first_name p1))
+        (Gwdb.sou base (Gwdb.get_first_name p2))
+    else c1
+  in
+  let persons = List.sort cmp_per persons in
+  let list = List.map (fun p ->
+      Api_update_util.pers_to_piqi_person_search conf base p
+    ) persons in
   let result = Api_saisie_write_piqi.Person_search_list.({ persons = list; }) in
   let data = Api_saisie_write_piqi_ext.gen_person_search_list result in
   Api_util.print_result conf data
 
-
 let print_person_search_info conf base =
   let params = Api_util.get_params conf Api_saisie_write_piqi_ext.parse_index_person in
   let ip = Gwdb.iper_of_string @@ Int32.to_string params.Api_saisie_write_piqi.Index_person.index in

src/api_saisie_write.mli

@@ -14,8 +14,7 @@ val print_person_search_list : Geneweb.Config.config -> Gwdb.base -> unit
       - conf : configuration de la base
       - base : base de donnée
     [Retour] :
-      - result : la liste de la recherche.
-                                                                           *)
+    - result : la liste de la recherche.                                   *)
 
 val print_person_search_info : Geneweb.Config.config -> Gwdb.base -> unit
 (** [Description] : Affiche les informations telles que sur le panneau

src/api_search.ml

@@ -364,11 +364,12 @@ let string_incl_start_with x y =
   in
   loop 0
 
-let select_both_start_with_person base ini_n ini_p =
+let select_both_start_with_person conf base ini_n ini_p max =
   let find n x = string_start_with x n in
   let ini_n = aux_ini (Name.lower ini_n) in
   let ini_p = aux_ini (Name.lower ini_p) in
-  Gwdb.Collection.fold begin fun list p ->
+  let continue (n, _acc) = n < max in
+  Gwdb.Collection.fold_until continue begin fun (n, list) p ->
       let surnames = aux_ini (Name.lower (Gwdb.sou base (Gwdb.get_surname p))) in
       let first_names = aux_ini (Name.lower (Gwdb.sou base (Gwdb.get_first_name p))) in
       let start_surname =
@@ -381,23 +382,24 @@ let select_both_start_with_person base ini_n ini_p =
           (fun ini -> List.exists (fun name -> find name ini) first_names)
           ini_p
       in
-      if start_surname && start_firstname then (Gwdb.get_iper p :: list)
-      else list
-  end [] (Gwdb.persons base)
+      if start_surname && start_firstname && Geneweb.Util.authorized_age conf base p then (n + 1, Gwdb.get_iper p :: list)
+      else (n, list)
+  end (0, []) (Gwdb.persons base)
 
-let select_start_with_person base get_field ini =
+let select_start_with_person conf base get_field ini max =
   let find n x = string_start_with x n in
   let ini = aux_ini (Name.lower ini) in
-  Gwdb.Collection.fold begin fun list p ->
+  let continue (n, _acc) = n < max in
+  Gwdb.Collection.fold_until continue begin fun (n, list) p ->
       let names = aux_ini (Name.lower (Gwdb.sou base (get_field p))) in
       let start_name =
         List.for_all
           (fun ini -> List.exists (fun name -> find name ini) names)
           ini
       in
-      if start_name then (Gwdb.get_iper p :: list)
-      else list
-  end [] (Gwdb.persons base)
+      if start_name && Geneweb.Util.authorized_age conf base p then (n + 1, Gwdb.get_iper p :: list)
+      else n, list
+  end (0, []) (Gwdb.persons base)
 
 let matching_nameset base stop max_res istr name_f name first_letter =
   let rec aux n istr set =
@@ -661,8 +663,9 @@ let search_auto_complete assets conf base mode place_mode max term =
     complete_with_dico
       assets conf nb max (Some `profession) term suggestions_from_db
 
-let search_person_list base surname first_name =
+let search_person_list conf base surname first_name max_o =
   let _ = Gwdb.load_strings_array base in
+  let max = Option.value ~default:max_int max_o in
   let (surname, first_name) =
     match (surname, first_name) with
     | (Some n, Some fn) ->
@@ -674,9 +677,9 @@ let search_person_list base surname first_name =
   in
   match (surname, first_name) with
   | (Some n, Some fn) ->
-      select_both_start_with_person base n fn
+    snd @@ select_both_start_with_person conf base n fn max
   | (Some n, None) ->
-      select_start_with_person base Gwdb.get_surname n
+    snd @@ select_start_with_person conf base Gwdb.get_surname n max
   | (None, Some fn) ->
-      select_start_with_person base Gwdb.get_first_name fn
+    snd @@ select_start_with_person conf base Gwdb.get_first_name fn max
   | (None, None) -> []

src/api_search.mli

@@ -35,4 +35,4 @@ val search_auto_complete :
   string list
 
 val search_person_list :
-  Gwdb.base -> string option -> string option -> Gwdb.iper list
+  Geneweb.Config.config -> Gwdb.base -> string option -> string option -> int option -> Gwdb.iper list

src/plugin_api.ml

@@ -127,7 +127,7 @@ let () =
     ; ( "API_GET_CONFIG"
       , aux @@ fun conf _ -> wiz' Plugin_api_lib.Api_saisie_write.print_config conf)
     ; ( "API_PERSON_SEARCH_LIST"
-      , aux @@ wiz @@ w_base @@ Plugin_api_lib.Api_saisie_write.print_person_search_list)
+      , aux @@ w_base @@ Plugin_api_lib.Api_saisie_write.print_person_search_list)
     ; ( "API_GET_PERSON_SEARCH_INFO"
       , aux @@ wiz @@ w_base @@ Plugin_api_lib.Api_saisie_write.print_person_search_info)
     ; ( "API_ADD_CHILD"