1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
(*
This file is part of Ceve.
Ceve 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.
Ceve 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 Ceve; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
*)
(**
SQL wrapper module
@author Jaap Boender
*)
open Options
open Mysql
type db_connection = MySQLConnection of dbd
type db_result = MySQLResult of result
type db_statement = MySQLStatement of stmt
type db_parameter =
DBString of int * string
| DBInt of int
| DBText of string
let open_database (x: unit): db_connection =
let db = {
dbhost = if !database_info.db_hostname = "" then None else Some !database_info.db_hostname;
dbname = Some !database_info.db_name;
dbport = Some !database_info.db_port;
dbpwd = if !database_info.db_password = "" then None else Some !database_info.db_password;
dbuser = if !database_info.db_user = "" then None else Some !database_info.db_user
} in
begin
prerr_endline ("[SQL] Opening database " ^ (!database_info.db_name) ^ " on host " ^ (!database_info.db_hostname) ^ " for user " ^ (!database_info.db_user) ^ "...");
MySQLConnection (connect db)
end;;
let to_mysql_bindings (bindings: db_parameter array): stmt_parameter array =
begin
Array.map (fun b ->
match b with
DBString (l, s) -> MySQLString (l, s)
| DBInt i -> MySQLInt i
| DBText t -> MySQLText t
) bindings
end;;
let from_mysql_bindings (bindings: stmt_parameter array): db_parameter array =
begin
Array.map (fun b ->
match b with
MySQLString (l, s) -> DBString (l, s)
| MySQLInt i -> DBInt i
| MySQLText t -> DBText t
) bindings
end;;
let execute_query (conn: db_connection) (query: string): db_result =
begin
match conn with
MySQLConnection mc -> MySQLResult (exec mc query)
end;;
let prepare_statement (conn: db_connection) (query: string): db_statement =
begin
match conn with
MySQLConnection mc -> MySQLStatement (prepare_statement mc query)
end;;
let execute_statement (stmt: db_statement) (bindings: db_parameter array): unit =
begin
match stmt with
MySQLStatement s -> Mysql.execute_statement s (to_mysql_bindings bindings)
end;;
let fetch_statement (stmt: db_statement): db_parameter array list =
begin
match stmt with
MySQLStatement s -> List.map from_mysql_bindings (Mysql.fetch_statement s)
end;;
let statement_insert_id (stmt: db_statement): int64 =
begin
match stmt with
MySQLStatement s -> Mysql.statement_insert_id s
end;;
|
