(* 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/. *) (* AUTOR: Ferruccio Guidi *) 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 close c = HMysql.disconnect c let quote s = let rec quote_aux s = try let l = String.length s in let i = String.index s '\'' in String.sub s 0 i ^ "\\'" ^ quote_aux (String.sub s (succ i) (l - (succ i))) 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")