From 5cb2fa1e3e6f5d9d7a273b45c56a6c1196982c4a Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli Date: Mon, 25 Oct 2004 22:14:13 +0000 Subject: [PATCH] implemented pagination --- helm/searchEngine/html/moogle.html | 5 + helm/searchEngine/mooglePp.ml | 61 ++++++---- helm/searchEngine/mooglePp.mli | 2 +- .../searchEngine/searchEngine.conf.xml.sample | 1 + helm/searchEngine/searchEngine.ml | 115 +++++++++++------- 5 files changed, 118 insertions(+), 66 deletions(-) diff --git a/helm/searchEngine/html/moogle.html b/helm/searchEngine/html/moogle.html index 862e425b6..3c76f8b85 100644 --- a/helm/searchEngine/html/moogle.html +++ b/helm/searchEngine/html/moogle.html @@ -71,6 +71,11 @@ @RESULTS@ + +
+ Page: @PREV_LINK@ @PAGE@/@PAGES@ @NEXT_LINK@ +
+ diff --git a/helm/searchEngine/mooglePp.ml b/helm/searchEngine/mooglePp.ml index 807fcc219..998274e08 100644 --- a/helm/searchEngine/mooglePp.ml +++ b/helm/searchEngine/mooglePp.ml @@ -12,34 +12,47 @@ let pp_request (req: Http_types.request) = let pp_error title msg = sprintf "
%s: %s
" title msg +let paginate ~size ~page l = + let min = 1 + (page-1) * size in + let max = page * size in + let rec aux i l = + match (i, l) with + | _, [] -> [] + | i, hd :: tl when i < min -> aux (i+1) tl + | i, hd :: tl when i >= min && i <= max -> hd :: aux (i+1) tl + | i, hd :: tl -> [] + in + assert (size > 0 && page > 0); + aux 1 l + (** pretty print a list of URIs to an HELM theory file *) -let theory_of_result req result = - let max_results_no = - Helm_registry.get_opt_default Helm_registry.get_int 10 - "search_engine.max_results_no" +let theory_of_result (req: Http_types.request) page result = + let results_per_page = + Helm_registry.get_int "search_engine.results_per_page" + in + let results_no = List.length result in + let result = paginate ~size:results_per_page ~page result in + let query_kind = pp_request req in + let template query_kind summary results = + sprintf + "
+ + + + + +
%s%s
+
+
+
+ %s +
" + query_kind summary results in - let results_no = List.length result in - let query_kind = pp_request req in - let template query_kind summary results = - sprintf - "
- - - - - -
%s%s
-
-
-
- %s -
" - query_kind summary results - in if results_no > 0 then - let mode = if results_no > max_results_no then "linkonly" else "typeonly" in + let mode = "typeonly" in let results = - let idx = ref (results_no + 1) in + let idx = ref ((page - 1) * results_per_page + List.length result + 1) in List.fold_right (fun uri i -> decr idx ; diff --git a/helm/searchEngine/mooglePp.mli b/helm/searchEngine/mooglePp.mli index 1cea1074f..18a169d0b 100644 --- a/helm/searchEngine/mooglePp.mli +++ b/helm/searchEngine/mooglePp.mli @@ -1,3 +1,3 @@ val pp_error : string -> string -> string -val theory_of_result : Http_types.request -> string list -> string +val theory_of_result : Http_types.request -> int -> string list -> string val html_of_interpretations: (string * string) list list -> string diff --git a/helm/searchEngine/searchEngine.conf.xml.sample b/helm/searchEngine/searchEngine.conf.xml.sample index 728b7c632..99b87d259 100644 --- a/helm/searchEngine/searchEngine.conf.xml.sample +++ b/helm/searchEngine/searchEngine.conf.xml.sample @@ -12,5 +12,6 @@
html 58085 + 10
diff --git a/helm/searchEngine/searchEngine.ml b/helm/searchEngine/searchEngine.ml index 758d57e0a..8bcd141b0 100644 --- a/helm/searchEngine/searchEngine.ml +++ b/helm/searchEngine/searchEngine.ml @@ -38,24 +38,19 @@ exception Invalid_action of string (* invalid action for "/search" method *) let daemon_name = "Moogle" let configuration_file = "/projects/helm/etc/moogle.conf.xml" -let expression_tag_RE = Pcre.regexp "@EXPRESSION@" -let action_tag_RE = Pcre.regexp "@ACTION@" -let advanced_tag_RE = Pcre.regexp "@ADVANCED@" -let advanced_checked_RE = Pcre.regexp "@ADVANCED_CHECKED@" -let simple_checked_RE = Pcre.regexp "@SIMPLE_CHECKED@" -let title_tag_RE = Pcre.regexp "@TITLE@" -let no_choices_tag_RE = Pcre.regexp "@NO_CHOICES@" -let current_choices_tag_RE = Pcre.regexp "@CURRENT_CHOICES@" -let choices_tag_RE = Pcre.regexp "@CHOICES@" -let msg_tag_RE = Pcre.regexp "@MSG@" -let id_to_uris_RE = Pcre.regexp "@ID_TO_URIS@" -let id_RE = Pcre.regexp "@ID@" -let iden_tag_RE = Pcre.regexp "@IDEN@" -let interpretations_RE = Pcre.regexp "@INTERPRETATIONS@" -let interpretations_labels_RE = Pcre.regexp "@INTERPRETATIONS_LABELS@" -let results_RE = Pcre.regexp "@RESULTS@" -let new_aliases_RE = Pcre.regexp "@NEW_ALIASES@" -let search_engine_url_RE = Pcre.regexp "@SEARCH_ENGINE_URL@" +let placeholders = [ + "EXPRESSION"; "ACTION"; "ADVANCED"; "ADVANCED_CHECKED"; "SIMPLE_CHECKED"; + "TITLE"; "NO_CHOICES"; "CURRENT_CHOICES"; "CHOICES"; "MSG"; "ID_TO_URIS"; + "ID"; "IDEN"; "INTERPRETATIONS"; "INTERPRETATIONS_LABELS"; "RESULTS"; + "NEW_ALIASES"; "SEARCH_ENGINE_URL"; "PREV_LINK"; "PAGE"; "PAGES"; "NEXT_LINK" +] + +let tag = + let regexps = Hashtbl.create 25 in + List.iter + (fun tag -> Hashtbl.add regexps tag (Pcre.regexp (sprintf "@%s@" tag))) + placeholders; + Hashtbl.find regexps (* First of all we load the configuration *) let _ = Helm_registry.load_from configuration_file @@ -70,6 +65,7 @@ let my_own_url = let hostname = input_line ic in ignore (Unix.close_process_in ic); sprintf "http://%s:%d" hostname port +let _ = Helm_registry.set "search_engine.my_own_url" my_own_url let bad_request body outchan = Http_daemon.respond_error ~code:(`Status (`Client_error `Bad_request)) ~body @@ -112,30 +108,67 @@ let add_param_substs params = (fun ((key,_) as p) -> Pcre.pmatch ~pat:"^param\\." key) params) +let page_RE = Pcre.regexp "¶m\\.page=\\d+" + let send_results results ?(id_to_uris = CicTextualParser2.EnvironmentP3.of_string "") (req: Http_types.request) outchan = + let page_link anchor page = + try + let this = req#param "this" in + let target = + if Pcre.pmatch ~rex:page_RE this then + Pcre.replace ~rex:page_RE ~templ:(sprintf "¶m.page=%d" page) + this + else + sprintf "%s¶m.page=%d" this page + in + let target = Pcre.replace ~pat:"&" ~templ:"&" target in + sprintf "%s" target anchor + with Http_types.Param_not_found _ -> "" + in Http_daemon.send_basic_headers ~code:(`Code 200) outchan ; Http_daemon.send_header "Content-Type" "text/xml" outchan; Http_daemon.send_CRLF outchan ; - let results_string = + let subst, results_string = match results with - | `Results r -> MooglePp.theory_of_result req r - | `Error msg -> msg + | `Results results -> + let page = try int_of_string (req#param "page") with _ -> 1 in + let results_no = List.length results in + let results_per_page = + Helm_registry.get_int "search_engine.results_per_page" + in + let pages = + if results_no mod results_per_page = 0 then + results_no / results_per_page + else + results_no / results_per_page + 1 + in + ([ tag "PAGE", string_of_int page; tag "PAGES", string_of_int pages ] @ + [ tag "PREV_LINK", + if page > 1 then page_link "Prev" (page-1) else "" ] @ + [ tag "NEXT_LINK", + if page < pages then page_link "Next" (page+1) else "" ]), + MooglePp.theory_of_result req page results + | `Error msg -> + [ tag "PAGE", ""; tag "PAGES", ""; + tag "PREV_LINK", ""; tag "NEXT_LINK", "" ], + msg in let subst = - (search_engine_url_RE, my_own_url) :: - (results_RE, results_string) :: - (advanced_tag_RE, req#param "advanced") :: - (expression_tag_RE, req#param "expression") :: + (tag "SEARCH_ENGINE_URL", my_own_url) :: + (tag "RESULTS", results_string) :: + (tag "ADVANCED", req#param "advanced") :: + (tag "EXPRESSION", req#param "expression") :: add_param_substs req#params @ (if req#param "advanced" = "no" then - [ simple_checked_RE, "checked='true'"; - advanced_checked_RE, "" ] + [ tag "SIMPLE_CHECKED", "checked='true'"; + tag "ADVANCED_CHECKED", "" ] else - [ simple_checked_RE, ""; - advanced_checked_RE, "checked='true'" ]) + [ tag "SIMPLE_CHECKED", ""; + tag "ADVANCED_CHECKED", "checked='true'" ]) @ + subst in iter_file (fun line -> @@ -145,7 +178,8 @@ let send_results results let processed_line = apply_substs (* CSC: Bug here: this is a string, not an array! *) - ((new_aliases_RE, "'" ^ javascript_quote new_aliases ^ "'")::subst) + ((tag "NEW_ALIASES", "'" ^ javascript_quote new_aliases ^ "'") :: + subst) line in output_string outchan (processed_line ^ "\n")) @@ -212,11 +246,11 @@ let exec_action dbh (req: Http_types.request) outchan = (fun line -> let processed_line = apply_substs - [advanced_tag_RE, req#param "advanced"; - interpretations_RE, html_interpretations; - current_choices_tag_RE, req#param "choices"; - expression_tag_RE, req#param "expression"; - action_tag_RE, string_tail req#path ] + [tag "ADVANCED", req#param "advanced"; + tag "INTERPRETATIONS", html_interpretations; + tag "CURRENT_CHOICES", req#param "choices"; + tag "EXPRESSION", req#param "expression"; + tag "ACTION", string_tail req#path ] line in output_string outchan (processed_line ^ "\n")) @@ -269,8 +303,7 @@ let callback dbh (req: Http_types.request) outchan = | "/getpage" -> (* TODO implement "is_permitted" *) (let is_permitted _ = true in - let remove_fragment uri = Pcre.replace ~pat:"#.*" uri in - let page = remove_fragment (req#param "url") in + let page = req#param "url" in let preprocess = (try bool_of_string (req#param "preprocess") @@ -278,7 +311,7 @@ let callback dbh (req: Http_types.request) outchan = in (match page with | page when is_permitted page -> - (let fname = sprintf "%s/%s" pages_dir (remove_fragment page) in + (let fname = sprintf "%s/%s" pages_dir page in Http_daemon.send_basic_headers ~code:(`Code 200) outchan; Http_daemon.send_header "Content-Type" "text/html" outchan; Http_daemon.send_CRLF outchan; @@ -287,9 +320,9 @@ let callback dbh (req: Http_types.request) outchan = (fun line -> output_string outchan ((apply_substs - ((search_engine_url_RE, my_own_url) :: - (advanced_tag_RE, "no") :: - (results_RE, "") :: + ((tag "SEARCH_ENGINE_URL", my_own_url) :: + (tag "ADVANCED", "no") :: + (tag "RESULTS", "") :: add_param_substs req#params) line) ^ "\n")) -- 2.39.2