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 ()
| 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
| 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
(* 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";
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 ;
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
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 *)
;;
+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
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
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)
* 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
-;;
+
* 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
*
*)
-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))
;;
* http://cs.unibo.it/helm/.
*)
-val fun_ex: string -> MathQL.value -> MathQL.value
+val fun_ex: MQIConn.handle -> string -> MathQL.value -> MathQL.value
--- /dev/null
+(* 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
+
--- /dev/null
+(* 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
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 *)
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
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
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
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)
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
(* 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
* http://cs.unibo.it/helm/.
*)
-(******************************************************************************)
-(* *)
-(* PROJECT HELM *)
-(* *)
-(* Ferruccio Guidi <fguidi@cs.unibo.it> *)
-(* 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
* http://www.cs.unibo.it/helm/.
*)
-open Dbconn;;
open Utility;;
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
done*)
in
- cat result (pattern_ex tl)
+ cat result (pattern_ex handle tl)
;;
*)
val pattern_ex :
- MathQL.value -> MathQL.resource_set
+ MQIConn.handle -> MathQL.value -> MathQL.resource_set
(*
* 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;
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
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!!!!*)
| "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))
;;
* 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
*)
-
-
open Union;;
open Dbconn;;
open Utility;;
;;
-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
(* 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
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
| "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
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
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
| "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
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
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
(* 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 = []
(*
* 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
*
* 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
*
* 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))
;;
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
-*.cm[aiox] *.cmxa *.opt mqtop mqitop examples
+*.cm[aiox] *.cmxa *.opt mqtop mqitop examples*
-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)
projects / helm.git / commitdiff