X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fmathql_interpreter%2FmQIMySql.ml;h=46f350e210dc25169ccb5c7f49e018d9ef520c70;hb=4167cea65ca58897d1a3dbb81ff95de5074700cc;hp=f5d30d1ed47128c8836de0c419a4f75862f70c7a;hpb=b5503c72c5560e8da3337e99bf058f0caab350e8;p=helm.git diff --git a/helm/ocaml/mathql_interpreter/mQIMySql.ml b/helm/ocaml/mathql_interpreter/mQIMySql.ml index f5d30d1ed..46f350e21 100644 --- a/helm/ocaml/mathql_interpreter/mQIMySql.ml +++ b/helm/ocaml/mathql_interpreter/mQIMySql.ml @@ -26,31 +26,23 @@ (* AUTOR: Ferruccio Guidi *) -type connection = Mysql.dbd +let init () = + let module HR = Helm_registry in + let host = + HR.get_opt HR.get_string "mathql_interpreter.mysql_connection.host" in + let database = + HR.get_opt HR.get_string "mathql_interpreter.mysql_connection.database" in + let user = + HR.get_opt HR.get_string "mathql_interpreter.mysql_connection.user" in + let port = + HR.get_opt HR.get_int "mathql_interpreter.mysql_connection.port" in + let password = + HR.get_opt HR.get_string "mathql_interpreter.mysql_connection.password" in + try HMysql.quick_connect ?host ?database ?user ?port ?password () + with _ -> raise (Failure "mqi_connecion") -let init connection_string = - try - Some - (Mysql.quick_connect - ~host:"mowgli.cs.unibo.it" ~database:"mowgli" ~user:"helm" ()) - with _ -> raise (Failure ("MQIPostgres.init: " ^ connection_string)) +let close c = HMysql.disconnect c -let close = function - | None -> () - | Some c -> Mysql.disconnect c - -let exec c q = match c with - | None -> [] - | Some c -> - Mysql.map - ~f:(function a -> - List.map - (function - None -> raise (Failure ("NULL found in a table")) - | Some v -> v - ) (Array.to_list a) - ) (Mysql.exec c q) - let quote s = let rec quote_aux s = try @@ -60,3 +52,43 @@ let quote s = with Not_found -> s in "'" ^ quote_aux s ^ "'" + +let exec (c, out) q = + let g = function None -> "" | Some v -> v in + let f a = List.map g (Array.to_list a) in + out q; HMysql.map ~f:f (Mysql.exec c q) + +let exec c table cols ct cfl = + let rec iter f last sep = function + | [] -> last + | [head] -> f head + | head :: tail -> f head ^ sep ^ iter f last sep tail + in + let pg_cols = iter (fun x -> x) "" ", " cols in + let pg_msval v = iter quote "" ", " v in + let pg_con (pat, col, v) = + if col <> "" then + let f s = col ^ " regexp " ^ quote ("^" ^ s ^ "$") in + if pat then "(" ^ iter f "0" " or " v ^ ")" + else match v with + | [s] -> col ^ " = " ^ (quote s) + | v -> col ^ " in (" ^ pg_msval v ^ ")" + else "1" + in + let pg_cons l = iter pg_con "1" " and " l in + let pg_cons_not l = "not (" ^ pg_cons l ^ ")" in + let pg_cons_not_l ll = iter pg_cons_not "1" " and " ll in + let pg_where = match ct, cfl with + | [], [] -> "" + | lt, [] -> " where " ^ pg_cons lt + | [], llf -> " where " ^ pg_cons_not_l llf + | lt, llf -> " where " ^ pg_cons lt ^ " and " ^ pg_cons_not_l llf + in + if cols = [] then + let r = exec c ("select count(source) from " ^ table ^ pg_where) in + match r with + | [[s]] when int_of_string s > 0 -> [[]] + | _ -> [] + else + exec c ("select " ^ pg_cols ^ " from " ^ table ^ pg_where ^ + " order by " ^ List.hd cols ^ " asc")