From 40ab699e0514d401555a7d605273f696ef982251 Mon Sep 17 00:00:00 2001 From: no author Date: Fri, 27 Feb 2004 14:06:41 +0000 Subject: [PATCH] This commit was manufactured by cvs2svn to create branch 'mathql_1_4'. --- helm/ocaml/mathql_interpreter/mQIMySql.ml | 84 +++++++++++++++++ helm/ocaml/mathql_interpreter/mQIPostgres.ml | 94 ++++++++++++++++++++ helm/ocaml/mathql_interpreter/mQITypes.ml | 41 +++++++++ 3 files changed, 219 insertions(+) create mode 100644 helm/ocaml/mathql_interpreter/mQIMySql.ml create mode 100644 helm/ocaml/mathql_interpreter/mQIPostgres.ml create mode 100644 helm/ocaml/mathql_interpreter/mQITypes.ml diff --git a/helm/ocaml/mathql_interpreter/mQIMySql.ml b/helm/ocaml/mathql_interpreter/mQIMySql.ml new file mode 100644 index 000000000..af50af8ff --- /dev/null +++ b/helm/ocaml/mathql_interpreter/mQIMySql.ml @@ -0,0 +1,84 @@ +(* 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 () = + try Mysql.quick_connect + ~host:"mowgli.cs.unibo.it" ~database:"mowgli" ~user:"helm" () + with _ -> raise (Failure "mqi_connecion") + +let close c = Mysql.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 q = + let g = function None -> "" | Some v -> v in + let f a = List.map g (Array.to_list a) in + Mysql.map ~f:f (Mysql.exec c q), q + +let exec c table cols ct cfl = + let rec iter f sep = function + | [] -> "" + | [head] -> f head + | head :: tail -> f head ^ sep ^ iter f 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 " or " v ^ ")" + else match v with + | [s] -> "binary " ^ col ^ " = " ^ (quote s) + | v -> "binary " ^ col ^ " in (" ^ pg_msval v ^ ")" + else "1" + in + let pg_cons l = iter pg_con " and " l in + let pg_cons_not l = "not (" ^ pg_cons l ^ ")" in + let pg_cons_not_l ll = iter pg_cons_not " 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, q = exec c ("select count (source) from " ^ table ^ pg_where) in + match r with + | [[s]] when int_of_string s > 0 -> [[]], q + | _ -> [], q + else + exec c ("select " ^ pg_cols ^ " from " ^ table ^ pg_where ^ + " order by " ^ List.hd cols ^ " asc") diff --git a/helm/ocaml/mathql_interpreter/mQIPostgres.ml b/helm/ocaml/mathql_interpreter/mQIPostgres.ml new file mode 100644 index 000000000..cf82814e9 --- /dev/null +++ b/helm/ocaml/mathql_interpreter/mQIPostgres.ml @@ -0,0 +1,94 @@ +(* 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 connection_string = + Helm_registry.get "mathql_interpreter.postgresql_connection_string" + in + try new Postgres.connection connection_string + with _ -> raise (Failure "mqi_connecion") + +let close c = c#close + +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 q = (c#exec q)#get_list, q + +let exec c table cols ct cfl = + let rec iter f sep = function + | [] -> "" + | [head] -> f head + | head :: tail -> f head ^ sep ^ iter f 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 ^ " ~ " ^ quote ("^" ^ s ^ "$") in + if pat then "(" ^ iter f " or " v ^ ")" + else match v with + | [s] -> col ^ " = " ^ (quote s) + | v -> col ^ " in (" ^ pg_msval v ^ ")" + else "true" + in + let pg_cons l = iter pg_con " and " l in + let pg_cons_not l = "not (" ^ pg_cons l ^ ")" in + let pg_cons_not_l ll = iter pg_cons_not " 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, q = exec c ("select count (source) from " ^ table ^ pg_where) in + match r with + | [[s]] when int_of_string s > 0 -> [[]], q + | _ -> [], q + else + exec c ("select " ^ pg_cols ^ " from " ^ table ^ pg_where ^ + " order by " ^ List.hd cols ^ " asc") + +(* funzioni vecchie ********************************************************) +(* +let pg_name h s = + let q = "select id from registry where uri = " ^ quote s in + match exec h q with + | [[id]] -> "t" ^ id + | _ -> "" + +let get_id b = if b then ["B"] else ["F"] +*) diff --git a/helm/ocaml/mathql_interpreter/mQITypes.ml b/helm/ocaml/mathql_interpreter/mQITypes.ml new file mode 100644 index 000000000..44b21ce18 --- /dev/null +++ b/helm/ocaml/mathql_interpreter/mQITypes.ml @@ -0,0 +1,41 @@ +(* 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 + *) + +type 'a con = MathQL.pattern * 'a * MathQL.value + +type 'a con_true = 'a con list + +type 'a con_false = 'a con list list + +type table = string + +type columns = string list + +type result = string list list + +type query = string -- 2.39.2