X-Git-Url: http://matita.cs.unibo.it/gitweb/?p=helm.git;a=blobdiff_plain;f=helm%2Focaml%2Fmathql_interpreter%2FmQIConn.ml;fp=helm%2Focaml%2Fmathql_interpreter%2FmQIConn.ml;h=270d1f9d0cd1eee283fc25bd6de052c656277835;hp=0000000000000000000000000000000000000000;hb=792b5d29ebae8f917043d9dd226692919b5d6ca1;hpb=a14a8c7637fd0b95e9d4deccb20c6abc98e8f953 diff --git a/helm/ocaml/mathql_interpreter/mQIConn.ml b/helm/ocaml/mathql_interpreter/mQIConn.ml new file mode 100644 index 000000000..270d1f9d0 --- /dev/null +++ b/helm/ocaml/mathql_interpreter/mQIConn.ml @@ -0,0 +1,130 @@ +(* 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 + *) + +(* $Id$ *) + +type connection = MySQL_C of HMysql.dbd + | Postgres_C of Postgres.connection + | No_C + +type flag = Galax | Postgres | Queries | Result | Source | Times | Warn + +type handle = { + log : string -> unit; (* logging function *) + set : flag list; (* options *) + pgc : connection; (* PG connection *) + pgm : MQIMap.pg_map; (* PG conversion function *) + pga : MQIMap.pg_alias (* PG table aliases *) +} + +let tables handle p = MQIMap.get_tables handle.pgm p + +let field handle p t = MQIMap.get_field handle.pgm p t + +let resolve handle a = MQIMap.resolve handle.pga a + +let log handle = handle.log + +let set handle flag = List.mem flag handle.set + +let pgc handle = handle.pgc + +let flags handle = handle.set + +let string_of_flag = function + | Galax -> "G" + | Postgres -> "P" + | Queries -> "Q" + | Result -> "R" + | Source -> "S" + | Times -> "T" + | Warn -> "W" + +let flag_of_char = function + | 'G' -> [Galax] + | 'P' -> [Postgres] + | 'Q' -> [Queries] + | 'R' -> [Result] + | 'S' -> [Source] + | 'T' -> [Times] + | '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 ?(flags = []) ?(log = ignore) () = + let flags = + if flags = [] then + flags_of_string (Helm_registry.get "mathql_interpreter.flags") + else + flags + in + let m, a = + let g = + if List.mem Galax flags + then MQIMap.empty_map else MQIMap.read_map + in g () + in + {log = log; set = flags; + pgc = begin + try + if List.mem Galax flags then No_C else + if List.mem Postgres flags then Postgres_C (MQIPostgres.init ()) else + MySQL_C (MQIMySql.init ()) + with Failure "mqi_connection" -> No_C + end; + pgm = m; pga = a + } + +let close handle = + match pgc handle with + | MySQL_C c -> MQIMySql.close c + | Postgres_C c -> MQIPostgres.close c + | No_C -> () + +let exec handle out table cols ct cfl = + match pgc handle with + | MySQL_C c -> MQIMySql.exec (c, out) table cols ct cfl + | Postgres_C c -> MQIPostgres.exec (c, out) table cols ct cfl + | No_C -> [] + +let connected handle = + pgc handle <> No_C + +let init_if_connected ?(flags = []) ?(log = ignore) () = + let handle = init ~flags:flags ~log:log () in + if connected handle then handle else raise (Failure "mqi connection failed")