(* Copyright (C) 2005, 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/.
 *)

type error_code =
 | OK
 | Table_exists_error
 | Dup_keyname
 | No_such_table
 | No_such_index
 | Bad_table_error
 | GENERIC_ERROR of string

exception Error of string

(* the exceptions raised are from the Mysql module *)

type dbtype = User | Library | Legacy
type dbimplementation = Mysql of HMysql.dbd | Sqlite of HSqlite3.dbd | FakeMySql
type result = Mysql_rc of HMysql.result | Sqlite_rc of HSqlite3.result | Nothing

  (* host port dbname user password type *)
type dbspec = (string * int option * string * string * string option * dbtype) list
type dbd = (dbtype * dbimplementation) list 

let debug = false;;
let debug_print s = if debug then prerr_endline (Lazy.force s) else ();;

let pp_dbtype = function
  | User -> "User"
  | Library -> "Library"
  | Legacy -> "Legacy"
;;

let mk_dbspec l = l;;

let quick_connect dbspec =
  HExtlib.filter_map 
    (fun (host, port, database, user, password, kind) -> 
      if Pcre.pmatch ~pat:"^file://" host then
        Some (kind, (Sqlite (HSqlite3.quick_connect (kind = Library)
          ~host:(Pcre.replace ~pat:"^file://" host) 
          ?port ~user ~database ?password ())))
      else if Pcre.pmatch ~pat:"^mysql://" host then
        Some (kind, (Mysql (HMysql.quick_connect 
          ~host:(Pcre.replace ~pat:"^mysql://" host)
          ?port ~user ~database ?password ())))
      else 
        None)
    dbspec      
;;

let mk f1 f2 = function 
  | (Sqlite dbd) -> Sqlite_rc (f1 dbd) 
  | (Mysql dbd) -> Mysql_rc (f2 dbd)
  | FakeMySql -> assert false
;;

let mk_u f1 f2 = function 
  | (_, (Sqlite dbd)) -> f1 dbd 
  | (_, (Mysql dbd)) -> f2 dbd
  | (_, FakeMySql) -> assert false
;;

let wrap f x =
  try f x with 
  | HMysql.Error s | HSqlite3.Error s -> raise (Error s)
  | Not_found -> raise (Error "Not_found")
;;

let disconnect dbd = 
  wrap (List.iter (mk_u HSqlite3.disconnect HMysql.disconnect)) dbd
;;

let exec (dbtype : dbtype) (dbd : dbd) (query : string) = 
  try
    debug_print (lazy ("EXEC: " ^ pp_dbtype dbtype ^ "|" ^ query));
    let dbd = List.assoc dbtype dbd in
    wrap (mk (HSqlite3.exec query) (HMysql.exec query)) dbd
  with Not_found -> 
    if dbtype = Legacy then Nothing else raise (Error "No ro or writable db")
;;

let map result ~f = 
  match result with
  | Mysql_rc rc -> HMysql.map rc ~f
  | Sqlite_rc rc -> HSqlite3.map rc ~f
  | Nothing -> []
;;

let iter result ~f = 
  match result with
  | Mysql_rc rc -> HMysql.iter rc ~f
  | Sqlite_rc rc -> HSqlite3.iter rc ~f
  | Nothing -> ()
;;

let sqlite_err = function 
 | HSqlite3.OK -> OK
 | HSqlite3.Table_exists_error -> Table_exists_error
 | HSqlite3.Dup_keyname -> Dup_keyname
 | HSqlite3.No_such_table -> No_such_table
 | HSqlite3.No_such_index -> No_such_index
 | HSqlite3.Bad_table_error -> Bad_table_error
 | HSqlite3.GENERIC_ERROR s -> GENERIC_ERROR s
;;

let mysql_err = function 
 | HMysql.OK -> OK
 | HMysql.Table_exists_error -> Table_exists_error
 | HMysql.Dup_keyname -> Dup_keyname
 | HMysql.No_such_table -> No_such_table
 | HMysql.No_such_index -> No_such_index
 | HMysql.Bad_table_error -> Bad_table_error
 | HMysql.GENERIC_ERROR s -> GENERIC_ERROR s
;;

let errno dbtype dbd =
  wrap 
    (fun d -> match List.assoc dbtype d with 
    | Mysql dbd -> mysql_err (HMysql.errno dbd)
    | Sqlite dbd -> sqlite_err (HSqlite3.errno dbd)
    | FakeMySql -> assert false)
    dbd
;;

let escape dbtype dbd s = 
  try
      match List.assoc dbtype dbd with
      | Mysql _ | FakeMySql -> wrap HMysql.escape s
      | Sqlite _ -> wrap HSqlite3.escape s
  with Not_found -> 
    if dbtype = Legacy then s else raise (Error "No ro or writable db")
;;

let escape_string_for_like dbtype dbd = 
  try
      match List.assoc dbtype dbd with 
      | Mysql _ | FakeMySql -> HMysql.escape_string_for_like
      | Sqlite _ -> HSqlite3.escape_string_for_like
  with Not_found -> 
    if dbtype = Legacy then ("ESCAPE \"\\\"" : ('a,'b,'c,'a) format4) 
    else raise (Error "No ro or writable db")
;;

let isMysql dbtype dbd =
  wrap 
    (fun d -> match List.assoc dbtype d with Mysql _ -> true | _ -> false) 
    dbd
;;

let fake_db_for_mysql dbtype =
  [dbtype, FakeMySql]  
;;