(* 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