X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FsearchEngine%2FsearchEngine.ml;h=9bc3ef2c95eafc12ac2de858bf0a807040ece0ba;hb=9543a355016ed3c2abc5e75e4e5d24e8f4d9bb3a;hp=109baa45c225644db9f5e4ac68239ca22ab6b9bc;hpb=524d98c48e119440423b449127ae05415ee48753;p=helm.git diff --git a/helm/searchEngine/searchEngine.ml b/helm/searchEngine/searchEngine.ml index 109baa45c..9bc3ef2c9 100644 --- a/helm/searchEngine/searchEngine.ml +++ b/helm/searchEngine/searchEngine.ml @@ -25,8 +25,12 @@ let debug = true;; let debug_print s = if debug then prerr_endline s;; +Http_common.debug := true;; (* Http_common.debug := true;; *) + (** accepted HTTP servers for ask_uwobo method forwarding *) +let valid_servers = [ "mowgli.cs.unibo.it:58080" ] ;; + open Printf;; let postgresConnectionString = @@ -51,12 +55,26 @@ let final_results_TPL = pages_dir ^ "/templateambigpdq3.html";; exception Chat_unfinished - (** pretty print a MathQL query result to a string *) -let text_of_result result sep = - let res_string = ref "" in - let app = function s -> res_string := !res_string ^ s in - MQueryUtil.text_of_result app result sep ; - !res_string + (** pretty print a MathQL query result to an HELM theory file *) +let theory_of_result result = + let results_no = List.length result in + if results_no > 0 then + let mode = if results_no > 10 then "linkonly" else "typeonly" in + let results = + let idx = ref (results_no + 1) in + List.fold_right + (fun (uri,attrs) i -> + decr idx ; + "" ^ string_of_int !idx ^ "." ^ i + ) result "" + in + "

Query Results:

" ^ results ^ "
" + else + "

Query Results:

No results found!

" +;; + +let pp_result result = + "\nQuery Results\n" ^ theory_of_result result ^ "" ;; (** chain application of Pcre substitutions *) @@ -85,6 +103,7 @@ let (title_tag_RE, choices_tag_RE, msg_tag_RE, id_to_uris_RE, id_RE, Pcre.regexp "@ID_TO_URIS@", Pcre.regexp "@ID@", Pcre.regexp "@INTERPRETATIONS@", Pcre.regexp "@INTERPRETATIONS_LABELS@", Pcre.regexp "@RESULTS@", Pcre.regexp "@NEW_ALIASES@") +let server_and_port_url_RE = Pcre.regexp "^http://([^/]+)/.*$" let port = try @@ -95,11 +114,6 @@ let port = prerr_endline "Warning: invalid port, reverting to default"; default_port in -let pp_result result = - let res_string = text_of_result result "\n" in - (sprintf "\n\n\n\n
%s
\n\n" - res_string) -in let pp_error = sprintf "

Error: %s

" in let bad_request body outchan = Http_daemon.respond_error ~status:(`Client_error `Bad_request) ~body outchan @@ -123,11 +137,8 @@ let callback (req: Http_types.request) outchan = let lexbuf = Lexing.from_string query_string in let query = MQueryUtil.query_of_text lexbuf in let result = MQueryGenerator.execute_query query in - let result_string = text_of_result result "\n" in - Http_daemon.respond - ~body: - (sprintf "
%s
" result_string) - ~headers:[contype] outchan + let result_string = pp_result result in + Http_daemon.respond ~body:result_string ~headers:[contype] outchan | "/locate" -> let id = req#param "id" in let result = MQueryGenerator.locate id in @@ -142,6 +153,19 @@ let callback (req: Http_types.request) outchan = Http_daemon.respond_file ~fname:(sprintf "%s/%s" pages_dir (remove_fragment page)) outchan | page -> Http_daemon.respond_forbidden ~url:page outchan) + | "/ask_uwobo" -> + let url = req#param "url" in + let server_and_port = + (Pcre.extract ~rex:server_and_port_url_RE url).(1) + in + if List.mem server_and_port valid_servers then + Http_daemon.respond + ~body:(Http_client.Convenience.http_get url) + outchan + else + Http_daemon.respond + ~body:(pp_error ("Invalid UWOBO server: " ^ server_and_port)) + outchan | "/searchPattern" -> let term_string = req#param "term" in let lexbuf = Lexing.from_string term_string in @@ -174,6 +198,8 @@ let callback (req: Http_types.request) outchan = | ""::id::tail | id::tail when id<>"" -> (fun id' -> +prerr_endline ("#### " ^ id ^ " :="); +List.iter (fun u -> prerr_endline ("<" ^ Netencoding.Url.decode u ^ ">")) tail; if id = id' then Some (List.map (fun u -> Netencoding.Url.decode u) tail) else @@ -213,6 +239,8 @@ let callback (req: Http_types.request) outchan = (match selection_mode with | `SINGLE -> assert false | `EXTENDED -> + Http_daemon.send_basic_headers ~code:200 outchan ; + Http_daemon.send_CRLF outchan ; iter_file (fun line -> let formatted_choices = @@ -228,7 +256,7 @@ let callback (req: Http_types.request) outchan = id_RE, id] line in - output_string outchan processed_line) + output_string outchan (processed_line ^ "\n")) interactive_user_uri_choice_TPL; raise Chat_unfinished)) @@ -262,6 +290,8 @@ let callback (req: Http_types.request) outchan = "\"") interpretations) in + Http_daemon.send_basic_headers ~code:200 outchan ; + Http_daemon.send_CRLF outchan ; iter_file (fun line -> let processed_line = @@ -270,7 +300,7 @@ let callback (req: Http_types.request) outchan = interpretations_labels_RE, html_interpretations_labels] line in - output_string outchan processed_line) + output_string outchan (processed_line ^ "\n")) interactive_interpretation_choice_TPL; raise Chat_unfinished @@ -289,6 +319,8 @@ let callback (req: Http_types.request) outchan = let must = MQueryLevels2.get_constraints term' in let must',only = refine_constraints must in let results = MQueryGenerator.searchPattern must' only in + Http_daemon.send_basic_headers ~code:200 outchan ; + Http_daemon.send_CRLF outchan ; iter_file (fun line -> let new_aliases = @@ -311,11 +343,11 @@ let callback (req: Http_types.request) outchan = in let processed_line = apply_substs - [results_RE, text_of_result results "\n"; + [results_RE, theory_of_result results ; new_aliases_RE, new_aliases] line in - output_string outchan processed_line) + output_string outchan (processed_line ^ "\n")) final_results_TPL | _ -> (* unable to instantiate some implicit variable *) Http_daemon.respond