diff --git a/src/api_saisie_write.ml b/src/api_saisie_write.ml index d94e563..b0b0504 100644 --- a/src/api_saisie_write.ml +++ b/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 diff --git a/src/api_saisie_write.mli b/src/api_saisie_write.mli index 27ee0b0..a66f4e8 100644 --- a/src/api_saisie_write.mli +++ b/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 diff --git a/src/api_search.ml b/src/api_search.ml index 37664ed..2263880 100644 --- a/src/api_search.ml +++ b/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) -> [] diff --git a/src/api_search.mli b/src/api_search.mli index 363deba..a69f9dd 100644 --- a/src/api_search.mli +++ b/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 diff --git a/src/plugin_api.ml b/src/plugin_api.ml index da9e0d5..9bc3b8b 100644 --- a/src/plugin_api.ml +++ b/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"