Mercurial > urweb

comparison src/mysql.sml @ 866:03e7f111fe99

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Start of multi-DBMS support
author Adam Chlipala <adamc@hcoop.net>
date Sun, 28 Jun 2009 13:49:32 -0400
parents
children e7f80d78075b
comparison
equal deleted inserted replaced
865:ebefb0609ac3 866:03e7f111fe99
1 (* Copyright (c) 2008-2009, Adam Chlipala
2 * All rights reserved.
3 *
4 * Redistribution and use in source and binary forms, with or without
5 * modification, are permitted provided that the following conditions are met:
6 *
7 * - Redistributions of source code must retain the above copyright notice,
8 * this list of conditions and the following disclaimer.
9 * - Redistributions in binary form must reproduce the above copyright notice,
10 * this list of conditions and the following disclaimer in the documentation
11 * and/or other materials provided with the distribution.
12 * - The names of contributors may not be used to endorse or promote products
13 * derived from this software without specific prior written permission.
14 *
15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
25 * POSSIBILITY OF SUCH DAMAGE.
26 *)
27
28 structure MySQL :> MYSQL = struct
29
30 open Settings
31 open Print.PD
32 open Print
33
34 fun init (dbstring, ss) =
35 let
36 val host = ref NONE
37 val user = ref NONE
38 val passwd = ref NONE
39 val db = ref NONE
40 val port = ref NONE
41 val unix_socket = ref NONE
42
43 fun stringOf r = case !r of
44 NONE => string "NULL"
45 | SOME s => box [string "\"",
46 string (String.toString s),
47 string "\""]
48 in
49 app (fn s =>
50 case String.fields (fn ch => ch = #"=") s of
51 [name, value] =>
52 (case name of
53 "host" =>
54 if size value > 0 andalso String.sub (value, 0) = #"/" then
55 unix_socket := SOME value
56 else
57 host := SOME value
58 | "hostaddr" => host := SOME value
59 | "port" => port := Int.fromString value
60 | "dbname" => db := SOME value
61 | "user" => user := SOME value
62 | "password" => passwd := SOME value
63 | _ => ())
64 | _ => ()) (String.tokens Char.isSpace dbstring);
65
66 box [string "typedef struct {",
67 newline,
68 box [string "MYSQL *conn;",
69 newline,
70 p_list_sepi (box [])
71 (fn i => fn _ =>
72 box [string "MYSQL_STMT *p",
73 string (Int.toString i),
74 string ";",
75 newline])
76 ss],
77 string "} uw_conn;",
78 newline,
79 newline,
80
81 if #persistent (currentProtocol ()) then
82 box [string "static void uw_db_prepare(uw_context ctx) {",
83 newline,
84 string "uw_conn *conn = uw_get_db(ctx);",
85 newline,
86 string "MYSQL_STMT *stmt;",
87 newline,
88 newline,
89
90 p_list_sepi newline (fn i => fn (s, n) =>
91 let
92 fun uhoh this s args =
93 box [p_list_sepi (box [])
94 (fn j => fn () =>
95 box [string
96 "mysql_stmt_close(conn->p",
97 string (Int.toString j),
98 string ");",
99 newline])
100 (List.tabulate (i, fn _ => ())),
101 box (if this then
102 [string
103 "mysql_stmt_close(conn->p",
104 string (Int.toString i),
105 string ");",
106 newline]
107 else
108 []),
109 string "mysql_close(conn->conn);",
110 newline,
111 string "uw_error(ctx, FATAL, \"",
112 string s,
113 string "\"",
114 p_list_sep (box []) (fn s => box [string ", ",
115 string s]) args,
116 string ");",
117 newline]
118 in
119 box [string "stmt = mysql_stmt_init(conn->conn);",
120 newline,
121 string "if (stmt == NULL) {",
122 newline,
123 uhoh false "Out of memory allocating prepared statement" [],
124 string "}",
125 newline,
126
127 string "if (mysql_stmt_prepare(stmt, \"",
128 string (String.toString s),
129 string "\", ",
130 string (Int.toString (size s)),
131 string ")) {",
132 newline,
133 box [string "char msg[1024];",
134 newline,
135 string "strncpy(msg, mysql_stmt_error(stmt), 1024);",
136 newline,
137 string "msg[1023] = 0;",
138 newline,
139 uhoh true "Error preparing statement: %s" ["msg"]],
140 string "}",
141 newline]
142 end)
143 ss,
144
145 string "}"]
146 else
147 string "static void uw_db_prepare(uw_context ctx) { }",
148 newline,
149 newline,
150
151 string "void uw_db_init(uw_context ctx) {",
152 newline,
153 string "MYSQL *mysql = mysql_init(NULL);",
154 newline,
155 string "uw_conn *conn;",
156 newline,
157 string "if (mysql == NULL) uw_error(ctx, FATAL, ",
158 string "\"libmysqlclient can't allocate a connection.\");",
159 newline,
160 string "if (mysql_real_connect(mysql, ",
161 stringOf host,
162 string ", ",
163 stringOf user,
164 string ", ",
165 stringOf passwd,
166 string ", ",
167 stringOf db,
168 string ", ",
169 case !port of
170 NONE => string "0"
171 | SOME n => string (Int.toString n),
172 string ", ",
173 stringOf unix_socket,
174 string ", 0)) {",
175 newline,
176 box [string "char msg[1024];",
177 newline,
178 string "strncpy(msg, mysql_error(mysql), 1024);",
179 newline,
180 string "msg[1023] = 0;",
181 newline,
182 string "mysql_close(mysql);",
183 newline,
184 string "uw_error(ctx, BOUNDED_RETRY, ",
185 string "\"Connection to MySQL server failed: %s\", msg);"],
186 newline,
187 string "}",
188 newline,
189 string "conn = malloc(sizeof(conn));",
190 newline,
191 string "conn->conn = mysql;",
192 newline,
193 string "uw_set_db(ctx, conn);",
194 newline,
195 string "uw_db_validate(ctx);",
196 newline,
197 string "uw_db_prepare(ctx);",
198 newline,
199 string "}",
200 newline,
201 newline,
202
203 string "void uw_db_close(uw_context ctx) {",
204 newline,
205 string "uw_conn *conn = uw_get_db(ctx);",
206 newline,
207 p_list_sepi (box [])
208 (fn i => fn _ =>
209 box [string "if (conn->p",
210 string (Int.toString i),
211 string ") mysql_stmt_close(conn->p",
212 string (Int.toString i),
213 string ");",
214 newline])
215 ss,
216 string "mysql_close(conn->conn);",
217 newline,
218 string "}",
219 newline,
220 newline,
221
222 string "int uw_db_begin(uw_context ctx) {",
223 newline,
224 string "uw_conn *conn = uw_get_db(ctx);",
225 newline,
226 newline,
227 string "return mysql_query(conn->conn, \"SET TRANSACTION ISOLATION LEVEL SERIALIZABLE\")",
228 newline,
229 string " || mysql_query(conn->conn, \"BEGIN\");",
230 newline,
231 string "}",
232 newline,
233 newline,
234
235 string "int uw_db_commit(uw_context ctx) {",
236 newline,
237 string "uw_conn *conn = uw_get_db(ctx);",
238 newline,
239 string "return mysql_commit(conn->conn);",
240 newline,
241 string "}",
242 newline,
243 newline,
244
245 string "int uw_db_rollback(uw_context ctx) {",
246 newline,
247 string "uw_conn *conn = uw_get_db(ctx);",
248 newline,
249 string "return mysql_rollback(conn->conn);",
250 newline,
251 string "}",
252 newline,
253 newline]
254 end
255
256 val () = addDbms {name = "mysql",
257 header = "mysql/mysql.h",
258 link = "-lmysqlclient",
259 global_init = box [string "void uw_client_init() {",
260 newline,
261 box [string "if (mysql_library_init(0, NULL, NULL)) {",
262 newline,
263 box [string "fprintf(stderr, \"Could not initialize MySQL library\\n\");",
264 newline,
265 string "exit(1);",
266 newline],
267 string "}",
268 newline],
269 string "}",
270 newline],
271 init = init}
272
273 end