From 39b9497090ee5cc501de1e3d9044d71fdc5cf1fb Mon Sep 17 00:00:00 2001 From: Ferruccio Guidi Date: Wed, 30 Apr 2003 13:56:57 +0000 Subject: [PATCH] MQueryInterpreter: interface updated --- .../tutors/search_pattern_apply_tutor.ml | 28 +++--- helm/ocaml/mathql_interpreter/.depend | 36 ++++--- helm/ocaml/mathql_interpreter/Makefile | 4 +- helm/ocaml/mathql_interpreter/dbconn.ml | 51 +--------- helm/ocaml/mathql_interpreter/dbconn.mli | 5 +- helm/ocaml/mathql_interpreter/func.ml | 7 +- helm/ocaml/mathql_interpreter/func.mli | 2 +- helm/ocaml/mathql_interpreter/mQIConn.ml | 93 +++++++++++++++++++ helm/ocaml/mathql_interpreter/mQIConn.mli | 47 ++++++++++ .../mathql_interpreter/mQueryInterpreter.ml | 89 ++++++------------ .../mathql_interpreter/mQueryInterpreter.mli | 29 +----- helm/ocaml/mathql_interpreter/pattern.ml | 7 +- helm/ocaml/mathql_interpreter/pattern.mli | 2 +- helm/ocaml/mathql_interpreter/property.ml | 22 ++--- helm/ocaml/mathql_interpreter/property.mli | 2 +- helm/ocaml/mathql_interpreter/relation.ml | 22 ++--- helm/ocaml/mathql_interpreter/relation.mli | 4 +- helm/ocaml/mathql_interpreter/utility.ml | 8 +- helm/ocaml/mathql_interpreter/utility.mli | 4 +- helm/ocaml/mathql_test/.cvsignore | 2 +- helm/ocaml/mathql_test/mqitop.ml | 25 +++-- 21 files changed, 261 insertions(+), 228 deletions(-) create mode 100644 helm/ocaml/mathql_interpreter/mQIConn.ml create mode 100644 helm/ocaml/mathql_interpreter/mQIConn.mli diff --git a/helm/hbugs/tutors/search_pattern_apply_tutor.ml b/helm/hbugs/tutors/search_pattern_apply_tutor.ml index 4790ab88a..d7b2da2ba 100644 --- a/helm/hbugs/tutors/search_pattern_apply_tutor.ml +++ b/helm/hbugs/tutors/search_pattern_apply_tutor.ml @@ -4,12 +4,8 @@ open Printf;; exception Empty_must;; -module MQICallbacks = - struct - let log s = prerr_string s - end - -module MQI = MQueryInterpreter.Make(MQICallbacks) +module MQI = MQueryInterpreter +module MQIC = MQIConn let broker_id = ref None let my_own_id = Hbugs_tutors_common.init_tutor () @@ -22,7 +18,7 @@ let is_authenticated id = | Some broker_id -> id = broker_id (* thread who do the dirty work *) -let slave (state, musing_id) = +let slave mqi_handle (state, musing_id) = try prerr_endline (sprintf "Hi, I'm the slave for musing %s" musing_id); let (proof, goal) = Hbugs_tutors_common.load_state state in @@ -36,7 +32,7 @@ let slave (state, musing_id) = | hd::tl -> hd in let uris = - TacticChaser.searchPattern + TacticChaser.searchPattern mqi_handle ~output_html:prerr_endline ~choose_must () ~status:(proof, goal) in if uris = [] then @@ -62,7 +58,7 @@ let slave (state, musing_id) = (* exception ==> no additional arm *) raise (unbox_exception e) -let hbugs_callback = +let hbugs_callback mqi_handle = let ids = Hashtbl.create 17 in let forbidden () = prerr_endline "ignoring request from unauthorized broker"; @@ -73,7 +69,7 @@ let hbugs_callback = if is_authenticated broker_id then begin prerr_endline "received Start_musing"; let new_musing_id = Hbugs_id_generator.new_musing_id () in - let id = Hbugs_deity.create slave (state, new_musing_id) in + let id = Hbugs_deity.create (slave mqi_handle) (state, new_musing_id) in prerr_endline (sprintf "starting a new musing (tid = %d, id = %s)" id new_musing_id); Hashtbl.add ids new_musing_id id ; @@ -99,10 +95,10 @@ let hbugs_callback = Exception ("unexpected_msg", Hbugs_messages.string_of_msg unexpected_msg) -let callback (req: Http_types.request) outchan = +let callback mqi_handle (req: Http_types.request) outchan = try let req_msg = Hbugs_messages.msg_of_string req#body in - let answer = hbugs_callback req_msg in + let answer = hbugs_callback mqi_handle req_msg in Http_daemon.respond ~body:(Hbugs_messages.string_of_msg answer) outchan with Hbugs_messages.Parse_error (subj, reason) -> Http_daemon.respond @@ -111,17 +107,17 @@ let callback (req: Http_types.request) outchan = outchan let main () = - let mqi_options = "" in (* default MathQL interpreter options *) + let mqi_flags = [] in (* default MathQL interpreter options *) try Sys.catch_break true; at_exit (fun () -> Hbugs_tutors_common.unregister_from_broker my_own_id); broker_id := Some (Hbugs_tutors_common.register_to_broker my_own_id my_own_url "FOO" "Search_pattern_apply tutor"); - ignore (MQI.init mqi_options) ; + let mqi_handle = MQIC.init mqi_flags prerr_string in Http_daemon.start' - ~addr:my_own_addr ~port:my_own_port ~mode:`Thread callback; - MQI.close mqi_options + ~addr:my_own_addr ~port:my_own_port ~mode:`Thread (callback mqi_handle); + MQIC.close mqi_handle with Sys.Break -> () (* exit nicely, invoking at_exit functions *) ;; diff --git a/helm/ocaml/mathql_interpreter/.depend b/helm/ocaml/mathql_interpreter/.depend index 42a0b04df..313e8f055 100644 --- a/helm/ocaml/mathql_interpreter/.depend +++ b/helm/ocaml/mathql_interpreter/.depend @@ -1,11 +1,19 @@ +utility.cmi: mQIConn.cmi +relation.cmi: mQIConn.cmi +func.cmi: mQIConn.cmi +property.cmi: mQIConn.cmi +pattern.cmi: mQIConn.cmi +mQueryInterpreter.cmi: mQIConn.cmi dbconn.cmo: dbconn.cmi dbconn.cmx: dbconn.cmi -utility.cmo: dbconn.cmi utility.cmi -utility.cmx: dbconn.cmx utility.cmi +mQIConn.cmo: dbconn.cmi mQIConn.cmi +mQIConn.cmx: dbconn.cmx mQIConn.cmi +utility.cmo: dbconn.cmi mQIConn.cmi utility.cmi +utility.cmx: dbconn.cmx mQIConn.cmx utility.cmi union.cmo: union.cmi union.cmx: union.cmi -relation.cmo: dbconn.cmi union.cmi utility.cmi relation.cmi -relation.cmx: dbconn.cmx union.cmx utility.cmx relation.cmi +relation.cmo: dbconn.cmi mQIConn.cmi union.cmi utility.cmi relation.cmi +relation.cmx: dbconn.cmx mQIConn.cmx union.cmx utility.cmx relation.cmi diff.cmo: diff.cmi diff.cmx: diff.cmi meet.cmo: meet.cmi @@ -14,15 +22,15 @@ sub.cmo: sub.cmi sub.cmx: sub.cmi intersect.cmo: intersect.cmi intersect.cmx: intersect.cmi -func.cmo: dbconn.cmi intersect.cmi utility.cmi func.cmi -func.cmx: dbconn.cmx intersect.cmx utility.cmx func.cmi -property.cmo: dbconn.cmi intersect.cmi utility.cmi property.cmi -property.cmx: dbconn.cmx intersect.cmx utility.cmx property.cmi -pattern.cmo: dbconn.cmi utility.cmi pattern.cmi -pattern.cmx: dbconn.cmx utility.cmx pattern.cmi +func.cmo: intersect.cmi mQIConn.cmi utility.cmi func.cmi +func.cmx: intersect.cmx mQIConn.cmx utility.cmx func.cmi +property.cmo: dbconn.cmi intersect.cmi mQIConn.cmi utility.cmi property.cmi +property.cmx: dbconn.cmx intersect.cmx mQIConn.cmx utility.cmx property.cmi +pattern.cmo: mQIConn.cmi utility.cmi pattern.cmi +pattern.cmx: mQIConn.cmx utility.cmx pattern.cmi mQueryInterpreter.cmo: context.cmo dbconn.cmi diff.cmi func.cmi intersect.cmi \ - meet.cmi pattern.cmi property.cmi relation.cmi sub.cmi union.cmi \ - mQueryInterpreter.cmi + mQIConn.cmi meet.cmi pattern.cmi property.cmi relation.cmi sub.cmi \ + union.cmi mQueryInterpreter.cmi mQueryInterpreter.cmx: context.cmx dbconn.cmx diff.cmx func.cmx intersect.cmx \ - meet.cmx pattern.cmx property.cmx relation.cmx sub.cmx union.cmx \ - mQueryInterpreter.cmi + mQIConn.cmx meet.cmx pattern.cmx property.cmx relation.cmx sub.cmx \ + union.cmx mQueryInterpreter.cmi diff --git a/helm/ocaml/mathql_interpreter/Makefile b/helm/ocaml/mathql_interpreter/Makefile index 8efbe582f..7b6ffd28a 100644 --- a/helm/ocaml/mathql_interpreter/Makefile +++ b/helm/ocaml/mathql_interpreter/Makefile @@ -2,9 +2,9 @@ PACKAGE = mathql_interpreter REQUIRES = helm-urimanager postgres natile-galax helm-mathql PREDICATES = -INTERFACE_FILES = dbconn.mli utility.mli union.mli relation.mli diff.mli meet.mli sub.mli intersect.mli func.mli property.mli pattern.mli mQueryInterpreter.mli +INTERFACE_FILES = dbconn.mli mQIConn.mli utility.mli union.mli relation.mli diff.mli meet.mli sub.mli intersect.mli func.mli property.mli pattern.mli mQueryInterpreter.mli -IMPLEMENTATION_FILES = dbconn.ml utility.ml union.ml relation.ml diff.ml meet.ml sub.ml intersect.ml context.ml func.ml property.ml pattern.ml mQueryInterpreter.ml +IMPLEMENTATION_FILES = dbconn.ml mQIConn.ml utility.ml union.ml relation.ml diff.ml meet.ml sub.ml intersect.ml context.ml func.ml property.ml pattern.ml mQueryInterpreter.ml # $(INTERFACE_FILES:%.mli=%.ml) diff --git a/helm/ocaml/mathql_interpreter/dbconn.ml b/helm/ocaml/mathql_interpreter/dbconn.ml index b38eabe87..95dc15cc3 100644 --- a/helm/ocaml/mathql_interpreter/dbconn.ml +++ b/helm/ocaml/mathql_interpreter/dbconn.ml @@ -23,52 +23,11 @@ * http://www.cs.unibo.it/helm/. *) -(* - * gestione della connessione al database - *) - -(* - * le eccezioni lanciate dalle funzioni init e pgc sono - * definite nel modulo Mathql - *) -open MathQL;; - -exception InvalidURI of string -exception ConnectionFailed of string -exception InvalidConnection - -(* - * connessione al db - *) -let conn = ref None - -(* - * controllo sulla connessione - *) -let pgc () = - match !conn with - None -> raise InvalidConnection - | Some c -> c -;; - -(* - * inizializzazione della connessione - * - * TODO - * passare i parametri della connessione come argomento di init - *) let init connection_param = - try ( - conn := Some (new Postgres.connection connection_param); - ) with - _ -> raise (ConnectionFailed ("init: " ^ connection_param)) -;; + try Some (new Postgres.connection connection_param) + with _ -> None -(* - * chiusura della connessione - *) -let close () = - match !conn with - None -> () +let close = function + | None -> () | Some c -> c#close -;; + diff --git a/helm/ocaml/mathql_interpreter/dbconn.mli b/helm/ocaml/mathql_interpreter/dbconn.mli index ecfbcd66a..5c9ef79cb 100644 --- a/helm/ocaml/mathql_interpreter/dbconn.mli +++ b/helm/ocaml/mathql_interpreter/dbconn.mli @@ -23,6 +23,5 @@ * http://cs.unibo.it/helm/. *) -val pgc : unit -> Postgres.connection -val init : string -> unit -val close : unit -> unit +val init : string -> Postgres.connection option +val close : Postgres.connection option -> unit diff --git a/helm/ocaml/mathql_interpreter/func.ml b/helm/ocaml/mathql_interpreter/func.ml index 8bc0c8d10..7e1f22367 100644 --- a/helm/ocaml/mathql_interpreter/func.ml +++ b/helm/ocaml/mathql_interpreter/func.ml @@ -27,20 +27,19 @@ * *) -open Dbconn;; open Utility;; open Intersect;; (* * implementazione delle funzioni dublin core *) -let rec fun_ex tab = function +let rec fun_ex handle tab = function [] -> [] | s::tl -> let res = - let c = pgc () in + let c = MQIConn.pgc handle in let q = ("select " ^ tab ^ ".uri from " ^ tab ^ " where " ^ tab ^ ".value = '" ^ s ^ "'") in pgresult_to_string_list (c#exec q) in - append (res,(fun_ex tab tl)) + append (res,(fun_ex handle tab tl)) ;; diff --git a/helm/ocaml/mathql_interpreter/func.mli b/helm/ocaml/mathql_interpreter/func.mli index 2858ce0da..cdf3f1f00 100644 --- a/helm/ocaml/mathql_interpreter/func.mli +++ b/helm/ocaml/mathql_interpreter/func.mli @@ -23,4 +23,4 @@ * http://cs.unibo.it/helm/. *) -val fun_ex: string -> MathQL.value -> MathQL.value +val fun_ex: MQIConn.handle -> string -> MathQL.value -> MathQL.value diff --git a/helm/ocaml/mathql_interpreter/mQIConn.ml b/helm/ocaml/mathql_interpreter/mQIConn.ml new file mode 100644 index 000000000..f38964f06 --- /dev/null +++ b/helm/ocaml/mathql_interpreter/mQIConn.ml @@ -0,0 +1,93 @@ +(* Copyright (C) 2000, HELM Team. + * + * This file is part of HELM, an Hypertextual, Electronic + * Library of Mathematics, developed at the Computer Science + * Department, University of Bologna, Italy. + * + * HELM is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * HELM is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with HELM; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, + * MA 02111-1307, USA. + * + * For details, see the HELM World-Wide-Web page, + * http://cs.unibo.it/helm/. + *) + +exception InvalidConnection + +type flag = Postgres | Galax | Stat | Quiet | Warn + +type handle = {log : string -> unit; (* logging function *) + set : flag list; (* options *) + pgc : Postgres.connection option (* Postgres connection *) + } + +let log handle = handle.log + +let set handle flag = List.mem flag handle.set + +let pgc handle = + match handle.pgc with + | None -> raise InvalidConnection + | Some c -> c + +let string_of_flag = function + | Postgres -> "P" + | Galax -> "G" + | Stat -> "S" + | Quiet -> "Q" + | Warn -> "W" + +let flag_of_char = function + | 'P' -> [Postgres] + | 'G' -> [Galax] + | 'S' -> [Stat] + | 'Q' -> [Quiet] + | 'W' -> [Warn] + | _ -> [] + +let string_fold_left f a s = + let l = String.length s in + let rec aux b i = if i = l then b else aux (f b s.[i]) (succ i) in + aux a 0 + +let string_of_flags flags = + List.fold_left (fun s flag -> s ^ string_of_flag flag) "" flags + +let flags_of_string s = + string_fold_left (fun l c -> l @ flag_of_char c) [] s + +let init myflags mylog = + let default_connection_string = + "host=mowgli.cs.unibo.it dbname=helm_mowgli_new_schema user=helm" + in + let connection_string = + try Sys.getenv "POSTGRESQL_CONNECTION_STRING" + with Not_found -> default_connection_string + in + {log = mylog; set = myflags; + pgc = if List.mem Galax myflags + then None else Dbconn.init connection_string + } + +let close handle = + if set handle Galax then () else Dbconn.close handle.pgc + +let connected handle = + if set handle Galax then false else + try ignore (pgc handle); true with InvalidConnection -> false + +let init_if_connected myflags mylog = + let handle = init myflags mylog in + ignore (pgc handle); handle + diff --git a/helm/ocaml/mathql_interpreter/mQIConn.mli b/helm/ocaml/mathql_interpreter/mQIConn.mli new file mode 100644 index 000000000..26cb291f9 --- /dev/null +++ b/helm/ocaml/mathql_interpreter/mQIConn.mli @@ -0,0 +1,47 @@ +(* Copyright (C) 2000, HELM Team. + * + * This file is part of HELM, an Hypertextual, Electronic + * Library of Mathematics, developed at the Computer Science + * Department, University of Bologna, Italy. + * + * HELM is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * HELM is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with HELM; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, + * MA 02111-1307, USA. + * + * For details, see the HELM World-Wide-Web page, + * http://cs.unibo.it/helm/. + *) + +type flag = Postgres | Galax | Stat | Quiet | Warn + +val string_of_flags : flag list -> string +val flags_of_string : string -> flag list + +exception InvalidConnection + +type handle + +val init : flag list -> (string -> unit) -> handle +val close : handle -> unit +val connected : handle -> bool + +val init_if_connected : flag list -> (string -> unit) -> handle + +(* The following functions allow to read the handle internal fields. + * For exclusive use of the interpreter. + *) + +val log : handle -> string -> unit +val set : handle -> flag -> bool +val pgc : handle -> Postgres.connection diff --git a/helm/ocaml/mathql_interpreter/mQueryInterpreter.ml b/helm/ocaml/mathql_interpreter/mQueryInterpreter.ml index f320ebba6..c1422b8ae 100644 --- a/helm/ocaml/mathql_interpreter/mQueryInterpreter.ml +++ b/helm/ocaml/mathql_interpreter/mQueryInterpreter.ml @@ -40,9 +40,6 @@ exception RVarUnbound of string;; exception VVarUnbound of string;; exception PathUnbound of (string * string list);; -exception InvalidConnection -exception ConnectionFailed of string - exception BooleExpTrue (* valuta una MathQL.set_exp e ritorna un MathQL.resource_set *) @@ -50,7 +47,7 @@ exception BooleExpTrue let galax_char = 'G' let stat_char = 'S' -let execute_aux log m x = +let execute_aux handle x = let module M = MathQL in let module X = MQueryMisc in let rec exec_set_exp c = function @@ -65,7 +62,7 @@ let rec exec_set_exp c = function with Not_found -> raise (RVarUnbound rvar)) | M.Ref vexp -> List.map (fun s -> (s,[])) (exec_val_exp c vexp) - | M.Pattern vexp -> pattern_ex (exec_val_exp c vexp) + | M.Pattern vexp -> pattern_ex handle (exec_val_exp c vexp) | M.Intersect (sexp1, sexp2) -> let before = X.start_time() in let rs1 = exec_set_exp c sexp1 in @@ -74,48 +71,48 @@ let rec exec_set_exp c = function let diff = X.stop_time before in let ll1 = string_of_int (List.length rs1) in let ll2 = string_of_int (List.length rs2) in - if String.contains m stat_char then - log ("INTERSECT(" ^ ll1 ^ "," ^ ll2 ^ ") = " ^ string_of_int (List.length res) ^ + if MQIConn.set handle MQIConn.Stat then + MQIConn.log handle ("INTERSECT(" ^ ll1 ^ "," ^ ll2 ^ ") = " ^ string_of_int (List.length res) ^ ": " ^ diff ^ "\n"); res | M.Union (sexp1, sexp2) -> let before = X.start_time () in let res = union_ex (exec_set_exp c sexp1) (exec_set_exp c sexp2) in let diff = X.stop_time before in - if String.contains m stat_char then log ("UNION: " ^ diff ^ "\n"); + if MQIConn.set handle MQIConn.Stat then MQIConn.log handle ("UNION: " ^ diff ^ "\n"); res | M.LetSVar (svar, sexp1, sexp2) -> let before = X.start_time() in let c1 = upd_svars c ((svar, exec_set_exp c sexp1) :: c.svars) in let res = exec_set_exp c1 sexp2 in - if String.contains m stat_char then begin - log ("LETIN " ^ svar ^ " = " ^ string_of_int (List.length res) ^ ": "); - log (X.stop_time before ^ "\n"); + if MQIConn.set handle MQIConn.Stat then begin + MQIConn.log handle ("LETIN " ^ svar ^ " = " ^ string_of_int (List.length res) ^ ": "); + MQIConn.log handle (X.stop_time before ^ "\n"); end; res | M.LetVVar (vvar, vexp, sexp) -> let before = X.start_time() in let c1 = upd_vvars c ((vvar, exec_val_exp c vexp) :: c.vvars) in let res = exec_set_exp c1 sexp in - if String.contains m stat_char then begin - log ("LETIN " ^ vvar ^ " = " ^ string_of_int (List.length res) ^ ": "); - log (X.stop_time before ^ "\n"); + if MQIConn.set handle MQIConn.Stat then begin + MQIConn.log handle ("LETIN " ^ vvar ^ " = " ^ string_of_int (List.length res) ^ ": "); + MQIConn.log handle (X.stop_time before ^ "\n"); end; res | M.Relation (inv, rop, path, sexp, assl) -> let before = X.start_time() in - if String.contains m galax_char then begin - let res = relation_galax_ex inv rop path (exec_set_exp c sexp) assl in - if String.contains m stat_char then begin - log ("RELATION-GALAX " ^ (fst path) ^ " = " ^ string_of_int(List.length res) ^ ": "); - log (X.stop_time before ^ "\n") + if MQIConn.set handle MQIConn.Galax then begin + let res = relation_galax_ex handle inv rop path (exec_set_exp c sexp) assl in + if MQIConn.set handle MQIConn.Stat then begin + MQIConn.log handle ("RELATION-GALAX " ^ (fst path) ^ " = " ^ string_of_int(List.length res) ^ ": "); + MQIConn.log handle (X.stop_time before ^ "\n") end; res end else begin - let res = relation_ex inv rop path (exec_set_exp c sexp) assl in - if String.contains m stat_char then begin - log ("RELATION " ^ (fst path) ^ " = " ^ string_of_int(List.length res) ^ ": "); - log (X.stop_time before ^ "\n") + let res = relation_ex handle inv rop path (exec_set_exp c sexp) assl in + if MQIConn.set handle MQIConn.Stat then begin + MQIConn.log handle ("RELATION " ^ (fst path) ^ " = " ^ string_of_int(List.length res) ^ ": "); + MQIConn.log handle (X.stop_time before ^ "\n") end; res end @@ -133,9 +130,9 @@ let rec exec_set_exp c = function select_ex tl in let res = select_ex rset in - if String.contains m stat_char then begin - log ("SELECT " ^ rvar ^ " = " ^ string_of_int (List.length res) ^ ": "); - log (X.stop_time before ^ "\n"); + if MQIConn.set handle MQIConn.Stat then begin + MQIConn.log handle ("SELECT " ^ rvar ^ " = " ^ string_of_int (List.length res) ^ ": "); + MQIConn.log handle (X.stop_time before ^ "\n"); end; res | M.Diff (sexp1, sexp2) -> diff_ex (exec_set_exp c sexp1) (exec_set_exp c sexp2) @@ -217,8 +214,8 @@ and exec_val_exp c = function with Not_found -> raise (VVarUnbound s)) | M.RefOf sexp -> List.map (fun (s,_) -> s) (exec_set_exp c sexp) - | M.Fun (s, vexp) -> fun_ex s (exec_val_exp c vexp) - | M.Property (inv, rop, path, vexp) -> property_ex rop path inv (exec_val_exp c vexp) + | M.Fun (s, vexp) -> fun_ex handle s (exec_val_exp c vexp) + | M.Property (inv, rop, path, vexp) -> property_ex handle rop path inv (exec_val_exp c vexp) (* valuta una MathQL.set_exp nel contesto vuoto e ritorna un MathQL.resource_set *) in @@ -226,39 +223,5 @@ in (* new interface ***********************************************************) -module type Callbacks = - sig - val log : string -> unit (* logging function *) - end - -module Make (C: Callbacks) = - struct - - let postgres = "P" - let galax = "G" - let stat = "S" - let quiet = "Q" - let warn = "W" - - let execute m x = execute_aux C.log m x +let execute handle x = execute_aux handle x - let init m = - let default_connection_string = - "host=mowgli.cs.unibo.it dbname=helm_mowgli_new_schema user=helm" - in - let connection_string = - try Sys.getenv "POSTGRESQL_CONNECTION_STRING" - with Not_found -> default_connection_string - in - if String.contains m galax_char then true else - try Dbconn.init connection_string; true - with ConnectionFailed s -> false - - let close m = - if String.contains m galax_char then () else Dbconn.close () - - let check m = - if String.contains m galax_char then false else - try ignore (Dbconn.pgc ()); true with InvalidConnection -> false - - end diff --git a/helm/ocaml/mathql_interpreter/mQueryInterpreter.mli b/helm/ocaml/mathql_interpreter/mQueryInterpreter.mli index 4400c45dd..481c5c315 100644 --- a/helm/ocaml/mathql_interpreter/mQueryInterpreter.mli +++ b/helm/ocaml/mathql_interpreter/mQueryInterpreter.mli @@ -23,31 +23,4 @@ * http://cs.unibo.it/helm/. *) -(******************************************************************************) -(* *) -(* PROJECT HELM *) -(* *) -(* Ferruccio Guidi *) -(* 06/01/2003 *) -(* *) -(* *) -(******************************************************************************) - -module type Callbacks = - sig - val log : string -> unit (* logging function *) - end - -module Make (C: Callbacks) : - sig - val postgres : string - val galax : string - val stat : string - val quiet : string - val warn : string - - val execute : string -> MathQL.query -> MathQL.result - val init : string -> bool - val close : string -> unit - val check : string -> bool - end +val execute : MQIConn.handle -> MathQL.query -> MathQL.result diff --git a/helm/ocaml/mathql_interpreter/pattern.ml b/helm/ocaml/mathql_interpreter/pattern.ml index 9809552a0..5dcb8a585 100644 --- a/helm/ocaml/mathql_interpreter/pattern.ml +++ b/helm/ocaml/mathql_interpreter/pattern.ml @@ -23,7 +23,6 @@ * http://www.cs.unibo.it/helm/. *) -open Dbconn;; open Utility;; let cat l1 l2 = @@ -33,11 +32,11 @@ let cat l1 l2 = l1 @ l2 ;; -let rec pattern_ex l = +let rec pattern_ex handle l = match l with [] -> [] | s::tl -> let result = - let c = pgc () in + let c = MQIConn.pgc handle in let quoted_s = Str.global_substitute (Str.regexp "'") (function _ -> "\\'") s in @@ -49,6 +48,6 @@ let rec pattern_ex l = done*) in - cat result (pattern_ex tl) + cat result (pattern_ex handle tl) ;; diff --git a/helm/ocaml/mathql_interpreter/pattern.mli b/helm/ocaml/mathql_interpreter/pattern.mli index 82deb1747..c5bf0bb82 100644 --- a/helm/ocaml/mathql_interpreter/pattern.mli +++ b/helm/ocaml/mathql_interpreter/pattern.mli @@ -24,4 +24,4 @@ *) val pattern_ex : - MathQL.value -> MathQL.resource_set + MQIConn.handle -> MathQL.value -> MathQL.resource_set diff --git a/helm/ocaml/mathql_interpreter/property.ml b/helm/ocaml/mathql_interpreter/property.ml index 84382fc74..34a75aa9a 100644 --- a/helm/ocaml/mathql_interpreter/property.ml +++ b/helm/ocaml/mathql_interpreter/property.ml @@ -40,7 +40,7 @@ let getpid p = (* * implementazione delle funzioni dublin core *) -let rec property_ex rop path inv = function +let rec property_ex handle rop path inv = function [] -> [] | s::tl -> let mprop = fst path in prerr_endline mprop; @@ -56,7 +56,7 @@ let rec property_ex rop path inv = function prerr_endline mprop; let mpid = getpid mprop in let res = - let c = pgc () in + let c = MQIConn.pgc handle in let quoted_s = Str.global_substitute (Str.regexp "'") (function _ -> "\\'") s in @@ -65,7 +65,7 @@ let rec property_ex rop path inv = function prerr_endline q; pgresult_to_string_list (c#exec q) in - append (res,(property_ex rop path inv tl)) + append (res,(property_ex handle rop path inv tl)) (*Rimane da capire cosa restituire nelle inverse!!!!*) @@ -74,45 +74,45 @@ let rec property_ex rop path inv = function | "refSort" -> if inv then (* restituisco gli uri che il valore della prop richiesta uguale a s *) let res = - let c = pgc () in + let c = MQIConn.pgc handle in let q = ("select distinct h" ^ mprop ^ ".uri from h" ^ mprop ^ " where h" ^ mprop ^ "." ^ prop ^ "= '" ^ s ^ "' order by h" ^ mprop ^ ".uri") in prerr_endline q; pgresult_to_string_list (c#exec q) in - append (res,(property_ex rop path inv tl)) + append (res,(property_ex handle rop path inv tl)) else let res = (* restituisco il valore della prop relativo all'uri rappresentato da s*) - let c = pgc () in + let c = MQIConn.pgc handle in let quoted_s = Str.global_substitute (Str.regexp "'") (function _ -> "\\'") s in let q = ("select distinct h" ^ mprop ^ "." ^ prop ^" from h" ^ mprop ^ " where h" ^ mprop ^ ".uri = '" ^ quoted_s ^ "' order by h" ^ mprop ^ "." ^ prop) in pgresult_to_string_list (c#exec q) in - append (res,(property_ex rop path inv tl)) + append (res,(property_ex handle rop path inv tl)) | _ -> (* metadati DC !!!! Controllare se i nomi delle tabelle cominciano con h !!!!*) prerr_endline "DC"; if inv then let res = - let c = pgc () in + let c = MQIConn.pgc handle in let q = ("select " ^ mprop ^ ".uri from " ^ mprop ^ " where " ^ mprop ^ ".value = '" ^ s ^ "'") in prerr_endline q; pgresult_to_string_list (c#exec q) in - append (res,(property_ex rop path inv tl)) + append (res,(property_ex handle rop path inv tl)) else let res = - let c = pgc () in + let c = MQIConn.pgc handle in let quoted_s = Str.global_substitute (Str.regexp "'") (function _ -> "\\'") s in let q = ("select " ^ mprop ^ ".value from " ^ mprop ^ " where " ^ mprop ^ ".uri = '" ^ quoted_s ^ "'") in pgresult_to_string_list (c#exec q) in - append (res,(property_ex rop path inv tl)) + append (res,(property_ex handle rop path inv tl)) ;; diff --git a/helm/ocaml/mathql_interpreter/property.mli b/helm/ocaml/mathql_interpreter/property.mli index cd02493bf..832fc5eca 100644 --- a/helm/ocaml/mathql_interpreter/property.mli +++ b/helm/ocaml/mathql_interpreter/property.mli @@ -23,5 +23,5 @@ * http://cs.unibo.it/helm/. *) -val property_ex: MathQL.refine -> MathQL.path -> bool -> MathQL.value -> MathQL.value +val property_ex: MQIConn.handle -> MathQL.refine -> MathQL.path -> bool -> MathQL.value -> MathQL.value diff --git a/helm/ocaml/mathql_interpreter/relation.ml b/helm/ocaml/mathql_interpreter/relation.ml index f2402688d..044bb82d3 100644 --- a/helm/ocaml/mathql_interpreter/relation.ml +++ b/helm/ocaml/mathql_interpreter/relation.ml @@ -30,8 +30,6 @@ *) - - open Union;; open Dbconn;; open Utility;; @@ -55,7 +53,7 @@ let get_prop_id prop = ;; -let relation_ex inv rop path rset assl = +let relation_ex handle inv rop path rset assl = let relk = fst path in match relk with @@ -69,7 +67,7 @@ let relation_ex inv rop path rset assl = (* print_endline "IN BACKPOINTER"; *) let prop = get_prop_id relk in if assl = [] then (* se non ci sono assegnamenti *) - let c = pgc () in + let c = MQIConn.pgc handle in let rset_list = (* lista di singoletti:resource_set di un elemento *) (List.fold_left (fun acc (uri,l) -> let tv = pgresult_to_string (c#exec ("select id from registry where uri='" ^ quoted uri ^ "'")) in @@ -96,7 +94,7 @@ let relation_ex inv rop path rset assl = else (* con assegnamenti *) - let c = pgc () in + let c = MQIConn.pgc handle in let rset_list = (* lista di singoletti:resource_set di un elemento *) (List.fold_left (fun acc (uri,l) -> let tv = pgresult_to_string (c#exec ("select id from registry where uri='" ^ quoted uri ^ "'")) in @@ -139,7 +137,7 @@ let relation_ex inv rop path rset assl = | "refRel" -> (* proprietà refRel *) if assl = [] then [] (* se non ci sono assegnamenti *) -(* let c = pgc () in +(* let c = MQIConn.pgc handle in let rset_list = (* lista di singoletti:resource_set di un elemento *) (List.fold_left (fun acc (uri,l) -> let qq = "select uri from hrefRel order by uri asc" in @@ -162,7 +160,7 @@ let relation_ex inv rop path rset assl = else (* con assegnamenti *) if inv then (* INVERSA *) - let c = pgc () in + let c = MQIConn.pgc handle in let rset_list = (* lista di singoletti:resource_set di un elemento *) (List.fold_left (fun acc (uri,l) -> let qq = "select uri, position, depth from hrefRel order by uri asc" in @@ -199,7 +197,7 @@ let relation_ex inv rop path rset assl = in edup rset_list else (* DIRETTA, con risorsa nulla *) - let c = pgc () in + let c = MQIConn.pgc handle in let rset_list = (* lista di singoletti:resource_set di un elemento *) (List.fold_left (fun acc (uri,l) -> let qq = "select position, depth from hrefRel order by uri asc" in @@ -247,7 +245,7 @@ let relation_ex inv rop path rset assl = | "refSort" -> (* proprietà refSort *) if assl = [] then [] (* se non ci sono assegnamenti *) -(* let c = pgc () in +(* let c = MQIConn.pgc handle in let rset_list = (* lista di singoletti:resource_set di un elemento *) (List.fold_left (fun acc (uri,l) -> let qq = "select uri from hrefSort order by uri asc" in @@ -272,7 +270,7 @@ let relation_ex inv rop path rset assl = else (* con assegnamenti *) if inv then (*INVERSA ----> SISTEMARE: vedi refRel!!!!*) - let c = pgc () in + let c = MQIConn.pgc handle in let rset_list = (* lista di singoletti:resource_set di un elemento *) (List.fold_left (fun acc (uri,l) -> let qq = "select uri, position, depth, sort from hrefSort order by uri asc" in @@ -348,7 +346,7 @@ let relation_ex inv rop path rset assl = edup rset_list else (* DIRETTA con risorsa vuota ----> SISTEMARE: vedi refRel!!!!*) - let c = pgc () in + let c = MQIConn.pgc handle in let rset_list = (* lista di singoletti:resource_set di un elemento *) (List.fold_left (fun acc (uri,l) -> let qq = "select position, depth, sort from hrefSort order by uri asc" in @@ -499,7 +497,7 @@ let muse path assl r = (* prende un resource_set, una vvar (primo el. di assl) a cui associare la posizione, e la relazione (refObj o backPointer) e per ogni resource chiama la muse NOTA: "rop" per ora non viene usato perche' vale sempre "ExactOp" *) -let relation_galax_ex inv rop path rset assl = [] +let relation_galax_ex handle inv rop path rset assl = [] (* diff --git a/helm/ocaml/mathql_interpreter/relation.mli b/helm/ocaml/mathql_interpreter/relation.mli index 71c939970..b32f36f3b 100644 --- a/helm/ocaml/mathql_interpreter/relation.mli +++ b/helm/ocaml/mathql_interpreter/relation.mli @@ -23,10 +23,10 @@ * http://cs.unibo.it/helm/. *) -val relation_ex : +val relation_ex : MQIConn.handle -> bool -> MathQL.refine -> MathQL.path -> MathQL.resource_set -> MathQL.assign list-> MathQL.resource_set -val relation_galax_ex : +val relation_galax_ex : MQIConn.handle -> bool -> MathQL.refine -> MathQL.path -> MathQL.resource_set -> MathQL.assign list -> MathQL.resource_set diff --git a/helm/ocaml/mathql_interpreter/utility.ml b/helm/ocaml/mathql_interpreter/utility.ml index c749f951b..af99d72fe 100644 --- a/helm/ocaml/mathql_interpreter/utility.ml +++ b/helm/ocaml/mathql_interpreter/utility.ml @@ -95,8 +95,8 @@ let set_assoc x v l = * * output: string; id interno associato alla proprieta' *) -let helm_property_id p = - let c = pgc () in +let helm_property_id handle p = + let c = MQIConn.pgc handle in let q1 = "select att0 from namespace where att1='http://www.cs.unibo.it/helm/schemas/mattone.rdf#'" in let ns = pgresult_to_string (c#exec q1) in let q2 = ("select att0 from property where att2='" ^ p ^ "' and att1=" ^ ns) in @@ -111,8 +111,8 @@ let helm_property_id p = * * output: string; id interno associato alla classe *) -let helm_class_id cl = - let c = pgc () in +let helm_class_id handle cl = + let c = MQIConn.pgc handle in let ns = pgresult_to_string (c#exec ("select att0 from namespace where att1='http://www.cs.unibo.it/helm/schemas/mattone.rdf#'")) in pgresult_to_string (c#exec ("select att0 from class where att2='" ^ cl ^ "' and att1=" ^ ns)) ;; diff --git a/helm/ocaml/mathql_interpreter/utility.mli b/helm/ocaml/mathql_interpreter/utility.mli index 9e9e8290d..2ee3db007 100644 --- a/helm/ocaml/mathql_interpreter/utility.mli +++ b/helm/ocaml/mathql_interpreter/utility.mli @@ -26,5 +26,5 @@ val pgresult_to_string_list : < get_list : string list list; .. > -> string list val pgresult_to_string : < get_list : string list list; .. > -> string val set_assoc : 'a -> 'b -> ('a * 'b) list -> ('a * 'b) list -val helm_property_id: string -> string -val helm_class_id: string -> string +val helm_property_id: MQIConn.handle -> string -> string +val helm_class_id: MQIConn.handle -> string -> string diff --git a/helm/ocaml/mathql_test/.cvsignore b/helm/ocaml/mathql_test/.cvsignore index bf48dbb5b..6e9e9c2c2 100644 --- a/helm/ocaml/mathql_test/.cvsignore +++ b/helm/ocaml/mathql_test/.cvsignore @@ -1 +1 @@ -*.cm[aiox] *.cmxa *.opt mqtop mqitop examples +*.cm[aiox] *.cmxa *.opt mqtop mqitop examples* diff --git a/helm/ocaml/mathql_test/mqitop.ml b/helm/ocaml/mathql_test/mqitop.ml index 6031fedf2..a9673205f 100644 --- a/helm/ocaml/mathql_test/mqitop.ml +++ b/helm/ocaml/mathql_test/mqitop.ml @@ -1,26 +1,25 @@ -module MQICallbacks = - struct - let log s = print_string s; flush stdout - end +module U = MQueryUtil +module X = MQueryMisc +module I = MQueryInterpreter +module C = MQIConn let _ = - let module U = MQueryUtil in - let module X = MQueryMisc in - let module I = MQueryInterpreter.Make(MQICallbacks) in let t = X.start_time () in let ich = Lexing.from_channel stdin in - let flags = if Array.length Sys.argv >= 2 then Sys.argv.(1) else "" in + let flags = if Array.length Sys.argv >= 2 then Sys.argv.(1) else "" in + let log s = print_string s; flush stdout in + let handle = C.init (C.flags_of_string flags) log in + if not (C.connected handle) then begin + print_endline "mqitop: no connection"; flush stdout + end; let rec aux () = let t = X.start_time () in - let r = I.execute flags (U.query_of_text ich) in + let r = I.execute handle (U.query_of_text ich) in U.text_of_result print_string r "\n"; Printf.printf "mqitop: query: %s,%i\n" (X.stop_time t) (List.length r); flush stdout; aux() in - if not (I.init flags) then begin - print_endline "mqitop: no connection"; flush stdout - end; begin try aux() with End_of_file -> () end; - I.close flags; + C.close handle; Printf.printf "mqitop: done: %s\n" (X.stop_time t) -- 2.39.2