Mercurial > urweb

annotate src/mysql.sml @ 870:7fa9a37a34b3

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