Mercurial > urweb

annotate src/mysql.sml @ 2237:e79ef5792c8b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fix bug in redundancy checking and use finer formula for UPDATE statements.
author Ziv Scully <ziv@mit.edu>
date Sun, 05 Jul 2015 23:57:28 -0700
parents 661b531f55bd
children d2a98983f502
rev   line source
adam@1295 1 (* Copyright (c) 2009-2010, 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
adam@1682 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@873 34 fun p_sql_type t =
adamc@873 35 case t of
adamc@873 36 Int => "bigint"
adamc@873 37 | Float => "double"
adamc@873 38 | String => "longtext"
adamc@1011 39 | Char => "char"
adamc@873 40 | Bool => "bool"
adamc@873 41 | Time => "timestamp"
adamc@873 42 | Blob => "longblob"
adamc@873 43 | Channel => "bigint"
adamc@873 44 | Client => "int"
adamc@873 45 | Nullable t => p_sql_type t
adamc@873 46
adamc@873 47 fun p_buffer_type t =
adamc@873 48 case t of
adamc@873 49 Int => "MYSQL_TYPE_LONGLONG"
adamc@873 50 | Float => "MYSQL_TYPE_DOUBLE"
adamc@873 51 | String => "MYSQL_TYPE_STRING"
adamc@1013 52 | Char => "MYSQL_TYPE_STRING"
adamc@873 53 | Bool => "MYSQL_TYPE_LONG"
adamc@938 54 | Time => "MYSQL_TYPE_TIMESTAMP"
adamc@873 55 | Blob => "MYSQL_TYPE_BLOB"
adamc@873 56 | Channel => "MYSQL_TYPE_LONGLONG"
adamc@873 57 | Client => "MYSQL_TYPE_LONG"
adamc@873 58 | Nullable t => p_buffer_type t
adamc@873 59
adamc@874 60 fun p_sql_type_base t =
adamc@874 61 case t of
adamc@874 62 Int => "bigint"
adamc@874 63 | Float => "double"
adamc@874 64 | String => "longtext"
adamc@1011 65 | Char => "char"
adamc@874 66 | Bool => "tinyint"
adamc@874 67 | Time => "timestamp"
adamc@874 68 | Blob => "longblob"
adamc@874 69 | Channel => "bigint"
adamc@874 70 | Client => "int"
adamc@874 71 | Nullable t => p_sql_type_base t
adamc@874 72
adamc@874 73 val ident = String.translate (fn #"'" => "PRIME"
adamc@874 74 | ch => str ch)
adamc@874 75
adamc@874 76 fun checkRel (table, checkNullable) (s, xts) =
adamc@874 77 let
adamc@874 78 val sl = CharVector.map Char.toLower s
adam@1953 79 val sl = if size sl > 1 andalso String.sub (sl, 0) = #"\"" then
adam@1953 80 String.substring (sl, 1, size sl - 2)
adam@1953 81 else
adam@1953 82 sl
adam@1970 83 val both = "table_name = '" ^ sl ^ "'"
adamc@874 84
adamc@998 85 val q = "SELECT COUNT(*) FROM information_schema." ^ table ^ " WHERE " ^ both
adamc@874 86
adamc@998 87 val q' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE ",
adamc@998 88 both,
adamc@998 89 " AND (",
adam@1600 90 case String.concatWith " OR "
adam@1600 91 (map (fn (x, t) =>
adam@1953 92 String.concat ["(LOWER(column_name) = '",
adam@1953 93 Settings.mangleSqlCatalog
adam@1953 94 (CharVector.map
adam@1953 95 Char.toLower (ident x)),
adam@1953 96 "' AND data_type ",
adam@1953 97 case p_sql_type_base t of
adam@1953 98 "bigint" =>
adam@1953 99 "IN ('bigint', 'int')"
adam@1953 100 | "longtext" =>
adam@1953 101 "IN ('longtext', 'varchar')"
adam@1953 102 | s => "= '" ^ s ^ "'",
adam@1600 103 if checkNullable then
adam@1600 104 (" AND is_nullable = '"
adam@1600 105 ^ (if isNotNull t then
adam@1600 106 "NO"
adam@1600 107 else
adam@1600 108 "YES")
adam@1600 109 ^ "'")
adam@1600 110 else
adam@1600 111 "",
adam@1600 112 ")"]) xts) of
adam@1600 113 "" => "FALSE"
adam@1600 114 | s => s,
adamc@874 115 ")"]
adamc@874 116
adamc@998 117 val q'' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE ",
adamc@998 118 both,
adam@1953 119 " AND LOWER(column_name) LIKE '", Settings.mangleSqlCatalog "%'"]
adamc@874 120 in
adamc@874 121 box [string "if (mysql_query(conn->conn, \"",
adamc@874 122 string q,
adamc@874 123 string "\")) {",
adamc@874 124 newline,
adamc@874 125 box [string "mysql_close(conn->conn);",
adamc@874 126 newline,
adamc@874 127 string "uw_error(ctx, FATAL, \"Query failed:\\n",
adamc@874 128 string q,
adamc@874 129 string "\");",
adamc@874 130 newline],
adamc@874 131 string "}",
adamc@874 132 newline,
adamc@874 133 newline,
adamc@874 134
adamc@874 135 string "if ((res = mysql_store_result(conn->conn)) == NULL) {",
adamc@874 136 newline,
adamc@874 137 box [string "mysql_free_result(res);",
adamc@874 138 newline,
adamc@874 139 string "mysql_close(conn->conn);",
adamc@874 140 newline,
adamc@874 141 string "uw_error(ctx, FATAL, \"Result store failed:\\n",
adamc@874 142 string q,
adamc@874 143 string "\");",
adamc@874 144 newline],
adamc@874 145 string "}",
adamc@874 146 newline,
adamc@874 147 newline,
adamc@874 148
adamc@874 149 string "if (mysql_num_fields(res) != 1) {",
adamc@874 150 newline,
adamc@874 151 box [string "mysql_free_result(res);",
adamc@874 152 newline,
adamc@874 153 string "mysql_close(conn->conn);",
adamc@874 154 newline,
adamc@874 155 string "uw_error(ctx, FATAL, \"Bad column count:\\n",
adamc@874 156 string q,
adamc@874 157 string "\");",
adamc@874 158 newline],
adamc@874 159 string "}",
adamc@874 160 newline,
adamc@874 161 newline,
adamc@874 162
adamc@874 163 string "if ((row = mysql_fetch_row(res)) == NULL) {",
adamc@874 164 newline,
adamc@874 165 box [string "mysql_free_result(res);",
adamc@874 166 newline,
adamc@874 167 string "mysql_close(conn->conn);",
adamc@874 168 newline,
adamc@874 169 string "uw_error(ctx, FATAL, \"Row fetch failed:\\n",
adamc@874 170 string q,
adamc@874 171 string "\");",
adamc@874 172 newline],
adamc@874 173 string "}",
adamc@874 174 newline,
adamc@874 175 newline,
adamc@874 176
adamc@874 177 string "if (strcmp(row[0], \"1\")) {",
adamc@874 178 newline,
adamc@874 179 box [string "mysql_free_result(res);",
adamc@874 180 newline,
adamc@874 181 string "mysql_close(conn->conn);",
adamc@874 182 newline,
adamc@874 183 string "uw_error(ctx, FATAL, \"Table '",
adam@1953 184 string sl,
adamc@874 185 string "' does not exist.\");",
adamc@874 186 newline],
adamc@874 187 string "}",
adamc@874 188 newline,
adamc@874 189 newline,
adamc@874 190 string "mysql_free_result(res);",
adamc@874 191 newline,
adamc@874 192 newline,
adamc@874 193
adamc@874 194 string "if (mysql_query(conn->conn, \"",
adamc@874 195 string q',
adamc@874 196 string "\")) {",
adamc@874 197 newline,
adamc@874 198 box [string "mysql_close(conn->conn);",
adamc@874 199 newline,
adamc@874 200 string "uw_error(ctx, FATAL, \"Query failed:\\n",
adamc@874 201 string q',
adamc@874 202 string "\");",
adamc@874 203 newline],
adamc@874 204 string "}",
adamc@874 205 newline,
adamc@874 206 newline,
adamc@874 207
adamc@874 208 string "if ((res = mysql_store_result(conn->conn)) == NULL) {",
adamc@874 209 newline,
adamc@874 210 box [string "mysql_free_result(res);",
adamc@874 211 newline,
adamc@874 212 string "mysql_close(conn->conn);",
adamc@874 213 newline,
adamc@874 214 string "uw_error(ctx, FATAL, \"Result store failed:\\n",
adamc@874 215 string q',
adamc@874 216 string "\");",
adamc@874 217 newline],
adamc@874 218 string "}",
adamc@874 219 newline,
adamc@874 220 newline,
adamc@874 221
adamc@874 222 string "if (mysql_num_fields(res) != 1) {",
adamc@874 223 newline,
adamc@874 224 box [string "mysql_free_result(res);",
adamc@874 225 newline,
adamc@874 226 string "mysql_close(conn->conn);",
adamc@874 227 newline,
adamc@874 228 string "uw_error(ctx, FATAL, \"Bad column count:\\n",
adamc@874 229 string q',
adamc@874 230 string "\");",
adamc@874 231 newline],
adamc@874 232 string "}",
adamc@874 233 newline,
adamc@874 234 newline,
adamc@874 235
adamc@874 236 string "if ((row = mysql_fetch_row(res)) == NULL) {",
adamc@874 237 newline,
adamc@874 238 box [string "mysql_free_result(res);",
adamc@874 239 newline,
adamc@874 240 string "mysql_close(conn->conn);",
adamc@874 241 newline,
adamc@874 242 string "uw_error(ctx, FATAL, \"Row fetch failed:\\n",
adamc@874 243 string q',
adamc@874 244 string "\");",
adamc@874 245 newline],
adamc@874 246 string "}",
adamc@874 247 newline,
adamc@874 248 newline,
adamc@874 249
adamc@874 250 string "if (strcmp(row[0], \"",
adamc@874 251 string (Int.toString (length xts)),
adamc@874 252 string "\")) {",
adamc@874 253 newline,
adamc@874 254 box [string "mysql_free_result(res);",
adamc@874 255 newline,
adamc@874 256 string "mysql_close(conn->conn);",
adamc@874 257 newline,
adamc@874 258 string "uw_error(ctx, FATAL, \"Table '",
adam@1953 259 string sl,
adamc@874 260 string "' has the wrong column types.\");",
adamc@874 261 newline],
adamc@874 262 string "}",
adamc@874 263 newline,
adamc@874 264 newline,
adamc@874 265 string "mysql_free_result(res);",
adamc@874 266 newline,
adamc@874 267 newline,
adam@1682 268
adamc@874 269 string "if (mysql_query(conn->conn, \"",
adamc@874 270 string q'',
adamc@874 271 string "\")) {",
adamc@874 272 newline,
adamc@874 273 box [string "mysql_close(conn->conn);",
adamc@874 274 newline,
adamc@874 275 string "uw_error(ctx, FATAL, \"Query failed:\\n",
adamc@874 276 string q'',
adamc@874 277 string "\");",
adamc@874 278 newline],
adamc@874 279 string "}",
adamc@874 280 newline,
adamc@874 281 newline,
adamc@874 282
adamc@874 283 string "if ((res = mysql_store_result(conn->conn)) == NULL) {",
adamc@874 284 newline,
adamc@874 285 box [string "mysql_free_result(res);",
adamc@874 286 newline,
adamc@874 287 string "mysql_close(conn->conn);",
adamc@874 288 newline,
adamc@874 289 string "uw_error(ctx, FATAL, \"Result store failed:\\n",
adamc@874 290 string q'',
adamc@874 291 string "\");",
adamc@874 292 newline],
adamc@874 293 string "}",
adamc@874 294 newline,
adamc@874 295 newline,
adamc@874 296
adamc@874 297 string "if (mysql_num_fields(res) != 1) {",
adamc@874 298 newline,
adamc@874 299 box [string "mysql_free_result(res);",
adamc@874 300 newline,
adamc@874 301 string "mysql_close(conn->conn);",
adamc@874 302 newline,
adamc@874 303 string "uw_error(ctx, FATAL, \"Bad column count:\\n",
adamc@874 304 string q'',
adamc@874 305 string "\");",
adamc@874 306 newline],
adamc@874 307 string "}",
adamc@874 308 newline,
adamc@874 309 newline,
adamc@874 310
adamc@874 311 string "if ((row = mysql_fetch_row(res)) == NULL) {",
adamc@874 312 newline,
adamc@874 313 box [string "mysql_free_result(res);",
adamc@874 314 newline,
adamc@874 315 string "mysql_close(conn->conn);",
adamc@874 316 newline,
adamc@874 317 string "uw_error(ctx, FATAL, \"Row fetch failed:\\n",
adamc@874 318 string q'',
adamc@874 319 string "\");",
adamc@874 320 newline],
adamc@874 321 string "}",
adamc@874 322 newline,
adamc@874 323 newline,
adamc@874 324
adamc@874 325 string "if (strcmp(row[0], \"",
adamc@874 326 string (Int.toString (length xts)),
adamc@874 327 string "\")) {",
adamc@874 328 newline,
adamc@874 329 box [string "mysql_free_result(res);",
adamc@874 330 newline,
adamc@874 331 string "mysql_close(conn->conn);",
adamc@874 332 newline,
adamc@874 333 string "uw_error(ctx, FATAL, \"Table '",
adam@1953 334 string sl,
adamc@874 335 string "' has extra columns.\");",
adamc@874 336 newline],
adamc@874 337 string "}",
adamc@874 338 newline,
adamc@874 339 newline,
adamc@874 340 string "mysql_free_result(res);",
adamc@874 341 newline]
adamc@874 342 end
adamc@874 343
adamc@872 344 fun init {dbstring, prepared = ss, tables, views, sequences} =
adamc@866 345 let
adamc@866 346 val host = ref NONE
adamc@866 347 val user = ref NONE
adamc@866 348 val passwd = ref NONE
adamc@866 349 val db = ref NONE
adamc@866 350 val port = ref NONE
adamc@866 351 val unix_socket = ref NONE
adamc@866 352
adamc@866 353 fun stringOf r = case !r of
adamc@866 354 NONE => string "NULL"
adamc@866 355 | SOME s => box [string "\"",
adam@1656 356 string (Prim.toCString s),
adamc@866 357 string "\""]
adamc@866 358 in
adamc@866 359 app (fn s =>
adamc@866 360 case String.fields (fn ch => ch = #"=") s of
adamc@866 361 [name, value] =>
adamc@866 362 (case name of
adamc@866 363 "host" =>
adamc@866 364 if size value > 0 andalso String.sub (value, 0) = #"/" then
adamc@866 365 unix_socket := SOME value
adamc@866 366 else
adamc@866 367 host := SOME value
adamc@866 368 | "hostaddr" => host := SOME value
adamc@866 369 | "port" => port := Int.fromString value
adamc@866 370 | "dbname" => db := SOME value
adamc@866 371 | "user" => user := SOME value
adamc@866 372 | "password" => passwd := SOME value
adamc@866 373 | _ => ())
adamc@866 374 | _ => ()) (String.tokens Char.isSpace dbstring);
adamc@866 375
adamc@866 376 box [string "typedef struct {",
adamc@866 377 newline,
adamc@866 378 box [string "MYSQL *conn;",
adamc@866 379 newline,
adamc@866 380 p_list_sepi (box [])
adamc@866 381 (fn i => fn _ =>
adamc@866 382 box [string "MYSQL_STMT *p",
adamc@866 383 string (Int.toString i),
adamc@866 384 string ";",
adamc@866 385 newline])
adamc@866 386 ss],
adamc@866 387 string "} uw_conn;",
adamc@866 388 newline,
adamc@866 389 newline,
adamc@866 390
adamc@1094 391 string "static void uw_client_init(void) {",
adamc@874 392 newline,
adamc@879 393 box [string "uw_sqlfmtInt = \"%lld%n\";",
adamc@879 394 newline,
adam@1920 395 string "uw_sqlfmtFloat = \"%.16g%n\";",
adamc@879 396 newline,
adamc@879 397 string "uw_Estrings = 0;",
adamc@879 398 newline,
adam@1834 399 string "uw_sql_type_annotations = 0;",
adam@1834 400 newline,
adamc@879 401 string "uw_sqlsuffixString = \"\";",
adamc@879 402 newline,
adamc@1011 403 string "uw_sqlsuffixChar = \"\";",
adamc@1011 404 newline,
adamc@879 405 string "uw_sqlsuffixBlob = \"\";",
adamc@879 406 newline,
adamc@879 407 string "uw_sqlfmtUint4 = \"%u%n\";",
adamc@879 408 newline,
adamc@879 409 newline,
adamc@879 410
adamc@879 411 string "if (mysql_library_init(0, NULL, NULL)) {",
adamc@874 412 newline,
adamc@874 413 box [string "fprintf(stderr, \"Could not initialize MySQL library\\n\");",
adamc@874 414 newline,
adamc@874 415 string "exit(1);",
adamc@874 416 newline],
adamc@874 417 string "}",
adamc@874 418 newline],
adamc@874 419 string "}",
adamc@874 420 newline,
adamc@874 421 newline,
adamc@874 422
adamc@866 423 if #persistent (currentProtocol ()) then
adamc@874 424 box [string "static void uw_db_validate(uw_context ctx) {",
adamc@874 425 newline,
adamc@874 426 string "uw_conn *conn = uw_get_db(ctx);",
adamc@874 427 newline,
adamc@874 428 string "MYSQL_RES *res;",
adamc@874 429 newline,
adamc@874 430 string "MYSQL_ROW row;",
adamc@874 431 newline,
adamc@874 432 newline,
adamc@874 433 p_list_sep newline (checkRel ("tables", true)) tables,
adamc@884 434 p_list_sep newline (fn name => checkRel ("tables", true)
adamc@884 435 (name, [("id", Settings.Client)])) sequences,
adamc@874 436 p_list_sep newline (checkRel ("views", false)) views,
adamc@874 437 string "}",
adamc@874 438 newline,
adamc@874 439 newline,
adamc@874 440
adamc@874 441 string "static void uw_db_prepare(uw_context ctx) {",
adamc@866 442 newline,
adamc@866 443 string "uw_conn *conn = uw_get_db(ctx);",
adamc@866 444 newline,
adamc@866 445 string "MYSQL_STMT *stmt;",
adamc@866 446 newline,
adamc@866 447 newline,
adamc@866 448
adam@2103 449 p_list_sepi newline (fn i => fn (s, _) =>
adamc@866 450 let
adamc@866 451 fun uhoh this s args =
adamc@866 452 box [p_list_sepi (box [])
adamc@866 453 (fn j => fn () =>
adamc@866 454 box [string
adamc@866 455 "mysql_stmt_close(conn->p",
adamc@866 456 string (Int.toString j),
adamc@866 457 string ");",
adamc@866 458 newline])
adamc@866 459 (List.tabulate (i, fn _ => ())),
adamc@866 460 box (if this then
adamc@866 461 [string
adamc@866 462 "mysql_stmt_close(conn->p",
adamc@866 463 string (Int.toString i),
adamc@866 464 string ");",
adamc@866 465 newline]
adamc@866 466 else
adamc@866 467 []),
adamc@866 468 string "mysql_close(conn->conn);",
adamc@866 469 newline,
adamc@866 470 string "uw_error(ctx, FATAL, \"",
adamc@866 471 string s,
adamc@866 472 string "\"",
adamc@866 473 p_list_sep (box []) (fn s => box [string ", ",
adamc@866 474 string s]) args,
adamc@866 475 string ");",
adamc@866 476 newline]
adamc@866 477 in
adamc@866 478 box [string "stmt = mysql_stmt_init(conn->conn);",
adamc@866 479 newline,
adamc@866 480 string "if (stmt == NULL) {",
adamc@866 481 newline,
adamc@866 482 uhoh false "Out of memory allocating prepared statement" [],
adamc@866 483 string "}",
adamc@866 484 newline,
adamc@874 485 string "conn->p",
adamc@874 486 string (Int.toString i),
adamc@874 487 string " = stmt;",
adamc@874 488 newline,
adamc@866 489
adamc@866 490 string "if (mysql_stmt_prepare(stmt, \"",
adam@1656 491 string (Prim.toCString s),
adamc@866 492 string "\", ",
adamc@866 493 string (Int.toString (size s)),
adamc@866 494 string ")) {",
adamc@866 495 newline,
adamc@866 496 box [string "char msg[1024];",
adamc@866 497 newline,
adamc@866 498 string "strncpy(msg, mysql_stmt_error(stmt), 1024);",
adamc@866 499 newline,
adamc@866 500 string "msg[1023] = 0;",
adamc@866 501 newline,
adamc@866 502 uhoh true "Error preparing statement: %s" ["msg"]],
adamc@866 503 string "}",
adamc@866 504 newline]
adamc@866 505 end)
adamc@866 506 ss,
adamc@866 507
adamc@866 508 string "}"]
adamc@866 509 else
adamc@882 510 box [string "static void uw_db_prepare(uw_context ctx) { }",
adamc@882 511 newline,
adamc@882 512 string "static void uw_db_validate(uw_context ctx) { }"],
adamc@866 513 newline,
adamc@866 514 newline,
adam@1682 515
adamc@1094 516 string "static void uw_db_init(uw_context ctx) {",
adamc@866 517 newline,
adamc@866 518 string "MYSQL *mysql = mysql_init(NULL);",
adamc@866 519 newline,
adamc@866 520 string "uw_conn *conn;",
adamc@866 521 newline,
adamc@866 522 string "if (mysql == NULL) uw_error(ctx, FATAL, ",
adamc@866 523 string "\"libmysqlclient can't allocate a connection.\");",
adamc@866 524 newline,
adamc@866 525 string "if (mysql_real_connect(mysql, ",
adamc@866 526 stringOf host,
adamc@866 527 string ", ",
adamc@866 528 stringOf user,
adamc@866 529 string ", ",
adamc@866 530 stringOf passwd,
adamc@866 531 string ", ",
adamc@866 532 stringOf db,
adamc@866 533 string ", ",
adamc@866 534 case !port of
adamc@866 535 NONE => string "0"
adamc@866 536 | SOME n => string (Int.toString n),
adamc@866 537 string ", ",
adamc@866 538 stringOf unix_socket,
adam@1955 539 string ", CLIENT_MULTI_STATEMENTS) == NULL) {",
adamc@866 540 newline,
adamc@866 541 box [string "char msg[1024];",
adamc@866 542 newline,
adamc@866 543 string "strncpy(msg, mysql_error(mysql), 1024);",
adamc@866 544 newline,
adamc@866 545 string "msg[1023] = 0;",
adamc@866 546 newline,
adamc@866 547 string "mysql_close(mysql);",
adamc@866 548 newline,
adamc@866 549 string "uw_error(ctx, BOUNDED_RETRY, ",
adamc@866 550 string "\"Connection to MySQL server failed: %s\", msg);"],
adamc@866 551 newline,
adamc@866 552 string "}",
adamc@866 553 newline,
adam@1957 554 newline,
adam@1957 555 string "if (mysql_set_character_set(mysql, \"utf8\")) {",
adam@1957 556 newline,
adam@1957 557 box [string "char msg[1024];",
adam@1957 558 newline,
adam@1957 559 string "strncpy(msg, mysql_error(mysql), 1024);",
adam@1957 560 newline,
adam@1957 561 string "msg[1023] = 0;",
adam@1957 562 newline,
adam@1957 563 string "mysql_close(mysql);",
adam@1957 564 newline,
adam@1957 565 string "uw_error(ctx, FATAL, ",
adam@1957 566 string "\"Error setting UTF-8 character set for MySQL connection: %s\", msg);"],
adam@1957 567 newline,
adam@1957 568 string "}",
adam@1957 569 newline,
adam@1957 570 newline,
adamc@874 571 string "conn = calloc(1, sizeof(uw_conn));",
adamc@866 572 newline,
adamc@866 573 string "conn->conn = mysql;",
adamc@866 574 newline,
adamc@866 575 string "uw_set_db(ctx, conn);",
adamc@866 576 newline,
adamc@866 577 string "uw_db_validate(ctx);",
adamc@866 578 newline,
adamc@866 579 string "uw_db_prepare(ctx);",
adamc@866 580 newline,
adamc@866 581 string "}",
adamc@866 582 newline,
adamc@866 583 newline,
adamc@866 584
adamc@1094 585 string "static void uw_db_close(uw_context ctx) {",
adamc@866 586 newline,
adamc@866 587 string "uw_conn *conn = uw_get_db(ctx);",
adamc@866 588 newline,
adamc@866 589 p_list_sepi (box [])
adamc@866 590 (fn i => fn _ =>
adamc@866 591 box [string "if (conn->p",
adamc@866 592 string (Int.toString i),
adamc@866 593 string ") mysql_stmt_close(conn->p",
adamc@866 594 string (Int.toString i),
adamc@866 595 string ");",
adamc@866 596 newline])
adamc@866 597 ss,
adamc@866 598 string "mysql_close(conn->conn);",
adamc@866 599 newline,
adamc@866 600 string "}",
adamc@866 601 newline,
adamc@866 602 newline,
adamc@866 603
adam@1936 604 string "static int uw_db_begin(uw_context ctx, int could_write) {",
adamc@866 605 newline,
adamc@866 606 string "uw_conn *conn = uw_get_db(ctx);",
adamc@866 607 newline,
adamc@866 608 newline,
adam@1955 609 string "return mysql_query(conn->conn, \"SET TRANSACTION ISOLATION LEVEL SERIALIZABLE; BEGIN\") ? 1 : (mysql_next_result(conn->conn), 0);",
adamc@866 610 newline,
adamc@866 611 string "}",
adamc@866 612 newline,
adamc@866 613 newline,
adamc@866 614
adamc@1094 615 string "static int uw_db_commit(uw_context ctx) {",
adamc@866 616 newline,
adamc@866 617 string "uw_conn *conn = uw_get_db(ctx);",
adamc@866 618 newline,
adamc@866 619 string "return mysql_commit(conn->conn);",
adamc@866 620 newline,
adamc@866 621 string "}",
adamc@866 622 newline,
adamc@866 623 newline,
adamc@866 624
adamc@1094 625 string "static int uw_db_rollback(uw_context ctx) {",
adamc@866 626 newline,
adamc@866 627 string "uw_conn *conn = uw_get_db(ctx);",
adamc@866 628 newline,
adamc@866 629 string "return mysql_rollback(conn->conn);",
adamc@866 630 newline,
adamc@866 631 string "}",
adamc@866 632 newline,
adamc@866 633 newline]
adamc@866 634 end
adamc@866 635
adamc@880 636 fun p_getcol {loc, wontLeakStrings = _, col = i, typ = t} =
adamc@873 637 let
adamc@873 638 fun getter t =
adamc@873 639 case t of
adamc@873 640 String => box [string "({",
adamc@873 641 newline,
adamc@873 642 string "uw_Basis_string s = uw_malloc(ctx, length",
adamc@873 643 string (Int.toString i),
adamc@873 644 string " + 1);",
adamc@873 645 newline,
adamc@873 646 string "out[",
adamc@873 647 string (Int.toString i),
adamc@873 648 string "].buffer = s;",
adamc@873 649 newline,
adamc@873 650 string "out[",
adamc@873 651 string (Int.toString i),
adamc@873 652 string "].buffer_length = length",
adamc@873 653 string (Int.toString i),
adamc@873 654 string " + 1;",
adamc@873 655 newline,
adamc@873 656 string "mysql_stmt_fetch_column(stmt, &out[",
adamc@873 657 string (Int.toString i),
adamc@873 658 string "], ",
adamc@873 659 string (Int.toString i),
adamc@873 660 string ", 0);",
adamc@873 661 newline,
adamc@873 662 string "s[length",
adamc@873 663 string (Int.toString i),
adamc@873 664 string "] = 0;",
adamc@873 665 newline,
adamc@873 666 string "s;",
adamc@873 667 newline,
adamc@873 668 string "})"]
adamc@873 669 | Blob => box [string "({",
adamc@873 670 newline,
adamc@873 671 string "uw_Basis_blob b = {length",
adamc@873 672 string (Int.toString i),
adamc@873 673 string ", uw_malloc(ctx, length",
adamc@873 674 string (Int.toString i),
adamc@873 675 string ")};",
adamc@873 676 newline,
adamc@873 677 string "out[",
adamc@873 678 string (Int.toString i),
adamc@873 679 string "].buffer = b.data;",
adamc@873 680 newline,
adamc@873 681 string "out[",
adamc@873 682 string (Int.toString i),
adamc@873 683 string "].buffer_length = length",
adamc@873 684 string (Int.toString i),
adamc@873 685 string ";",
adamc@873 686 newline,
adamc@873 687 string "mysql_stmt_fetch_column(stmt, &out[",
adamc@873 688 string (Int.toString i),
adamc@873 689 string "], ",
adamc@873 690 string (Int.toString i),
adamc@873 691 string ", 0);",
adamc@873 692 newline,
adamc@873 693 string "b;",
adamc@873 694 newline,
adamc@873 695 string "})"]
adamc@873 696 | Time => box [string "({",
adamc@876 697 string "MYSQL_TIME *mt = &buffer",
adamc@873 698 string (Int.toString i),
adamc@873 699 string ";",
adamc@873 700 newline,
adamc@873 701 newline,
adamc@938 702 string "struct tm t = {mt->second, mt->minute, mt->hour, mt->day, mt->month-1, mt->year - 1900, 0, 0, -1};",
adamc@873 703 newline,
adam@1443 704 string "uw_Basis_time res = {mktime(&t), 0};",
adam@1443 705 newline,
adam@1443 706 string "res;",
adamc@873 707 newline,
adamc@873 708 string "})"]
adamc@889 709 | Channel => box [string "({",
adamc@889 710 string "uw_Basis_channel ch = {buffer",
adamc@889 711 string (Int.toString i),
adamc@889 712 string " >> 32, buffer",
adamc@889 713 string (Int.toString i),
adamc@889 714 string " & 0xFFFFFFFF};",
adamc@889 715 newline,
adamc@889 716 string "ch;",
adamc@889 717 newline,
adamc@889 718 string "})"]
adamc@873 719 | _ => box [string "buffer",
adamc@873 720 string (Int.toString i)]
adamc@873 721 in
adamc@873 722 case t of
adamc@873 723 Nullable t => box [string "(is_null",
adamc@873 724 string (Int.toString i),
adamc@873 725 string " ? NULL : ",
adamc@873 726 case t of
adamc@873 727 String => getter t
adamc@873 728 | _ => box [string "({",
adamc@873 729 newline,
adamc@873 730 string (p_sql_ctype t),
adamc@873 731 space,
adamc@873 732 string "*tmp = uw_malloc(ctx, sizeof(",
adamc@873 733 string (p_sql_ctype t),
adamc@873 734 string "));",
adamc@873 735 newline,
adamc@873 736 string "*tmp = ",
adamc@873 737 getter t,
adamc@873 738 string ";",
adamc@873 739 newline,
adamc@873 740 string "tmp;",
adamc@873 741 newline,
adamc@873 742 string "})"],
adamc@873 743 string ")"]
adamc@873 744 | _ => box [string "(is_null",
adamc@873 745 string (Int.toString i),
adamc@873 746 string " ? ",
adamc@873 747 box [string "({",
adamc@873 748 string (p_sql_ctype t),
adamc@873 749 space,
adamc@873 750 string "tmp;",
adamc@873 751 newline,
adamc@873 752 string "uw_error(ctx, FATAL, \"Unexpectedly NULL field #",
adamc@873 753 string (Int.toString i),
adamc@873 754 string "\");",
adamc@873 755 newline,
adamc@873 756 string "tmp;",
adamc@873 757 newline,
adamc@873 758 string "})"],
adamc@873 759 string " : ",
adamc@873 760 getter t,
adamc@873 761 string ")"]
adamc@873 762 end
adamc@873 763
adamc@873 764 fun queryCommon {loc, query, cols, doCols} =
adamc@873 765 box [string "int n, r;",
adamc@873 766 newline,
adamc@873 767 string "MYSQL_BIND out[",
adamc@873 768 string (Int.toString (length cols)),
adamc@873 769 string "];",
adamc@873 770 newline,
adamc@873 771 p_list_sepi (box []) (fn i => fn t =>
adamc@873 772 let
adamc@873 773 fun buffers t =
adamc@873 774 case t of
adamc@873 775 String => box [string "unsigned long length",
adamc@873 776 string (Int.toString i),
adamc@873 777 string ";",
adamc@873 778 newline]
adamc@873 779 | Blob => box [string "unsigned long length",
adamc@873 780 string (Int.toString i),
adamc@873 781 string ";",
adamc@873 782 newline]
adamc@876 783 | Time => box [string "MYSQL_TIME buffer",
adamc@876 784 string (Int.toString i),
adamc@876 785 string ";",
adamc@876 786 newline]
adamc@889 787 | Channel => box [string "unsigned long long buffer",
adamc@889 788 string (Int.toString i),
adamc@889 789 string ";",
adamc@889 790 newline]
adamc@873 791 | _ => box [string (p_sql_ctype t),
adamc@873 792 space,
adamc@873 793 string "buffer",
adamc@873 794 string (Int.toString i),
adamc@873 795 string ";",
adamc@873 796 newline]
adamc@873 797 in
adamc@873 798 box [string "my_bool is_null",
adamc@873 799 string (Int.toString i),
adamc@873 800 string ";",
adamc@873 801 newline,
adamc@873 802 case t of
adamc@873 803 Nullable t => buffers t
adamc@873 804 | _ => buffers t,
adamc@873 805 newline]
adamc@873 806 end) cols,
adamc@873 807 newline,
adamc@873 808
adamc@873 809 string "memset(out, 0, sizeof out);",
adamc@873 810 newline,
adamc@873 811 p_list_sepi (box []) (fn i => fn t =>
adamc@873 812 let
adamc@873 813 fun buffers t =
adamc@873 814 case t of
adamc@875 815 String => box [string "out[",
adamc@875 816 string (Int.toString i),
adamc@875 817 string "].length = &length",
adamc@875 818 string (Int.toString i),
adamc@875 819 string ";",
adamc@875 820 newline]
adamc@1013 821 | Char => box [string "out[",
adamc@1013 822 string (Int.toString i),
adamc@1013 823 string "].buffer_length = 1;",
adamc@1013 824 newline,
adamc@1013 825 string "out[",
adamc@1013 826 string (Int.toString i),
adamc@1013 827 string "].buffer = &buffer",
adamc@1013 828 string (Int.toString i),
adamc@1013 829 string ";",
adamc@1013 830 newline]
adamc@875 831 | Blob => box [string "out[",
adamc@875 832 string (Int.toString i),
adamc@875 833 string "].length = &length",
adamc@875 834 string (Int.toString i),
adamc@875 835 string ";",
adamc@875 836 newline]
adamc@873 837 | _ => box [string "out[",
adamc@873 838 string (Int.toString i),
adamc@873 839 string "].buffer = &buffer",
adamc@873 840 string (Int.toString i),
adamc@873 841 string ";",
adamc@873 842 newline]
adamc@873 843 in
adamc@873 844 box [string "out[",
adamc@873 845 string (Int.toString i),
adamc@873 846 string "].buffer_type = ",
adamc@873 847 string (p_buffer_type t),
adamc@873 848 string ";",
adamc@873 849 newline,
adamc@873 850 string "out[",
adamc@873 851 string (Int.toString i),
adamc@873 852 string "].is_null = &is_null",
adamc@873 853 string (Int.toString i),
adamc@873 854 string ";",
adamc@873 855 newline,
adam@1682 856
adamc@873 857 case t of
adamc@873 858 Nullable t => buffers t
adamc@873 859 | _ => buffers t,
adamc@873 860 newline]
adamc@873 861 end) cols,
adamc@873 862 newline,
adamc@873 863
adamc@875 864 string "if (mysql_stmt_reset(stmt)) uw_error(ctx, FATAL, \"",
adamc@875 865 string (ErrorMsg.spanToString loc),
adamc@875 866 string ": Error reseting statement: %s\\n%s\", ",
adamc@875 867 query,
adamc@875 868 string ", mysql_error(conn->conn));",
adamc@875 869 newline,
adamc@875 870 newline,
adamc@875 871
adam@1954 872 string "if (mysql_stmt_execute(stmt)) {",
adam@1954 873 newline,
adam@1954 874 box [string "if (mysql_errno(conn->conn) == 1213)",
adam@1954 875 newline,
adam@1954 876 box [string "uw_error(ctx, UNLIMITED_RETRY, \"Deadlock detected\");",
adam@1954 877 newline],
adam@1954 878 newline,
adam@1954 879 string "uw_error(ctx, FATAL, \"",
adam@1954 880 string (ErrorMsg.spanToString loc),
adam@1954 881 string ": Error executing query: %s\\n%s\", ",
adam@1954 882 query,
adam@1954 883 string ", mysql_error(conn->conn));",
adam@1954 884 newline],
adam@1954 885 string "}",
adamc@875 886 newline,
adamc@875 887 newline,
adamc@875 888
adamc@875 889 string "if (mysql_stmt_bind_result(stmt, out)) uw_error(ctx, FATAL, \"",
adamc@875 890 string (ErrorMsg.spanToString loc),
adamc@875 891 string ": Error binding query result: %s\\n%s\", ",
adamc@875 892 query,
adamc@875 893 string ", mysql_error(conn->conn));",
adamc@873 894 newline,
adamc@873 895 newline,
adamc@873 896
adamc@873 897 string "if (mysql_stmt_store_result(stmt)) uw_error(ctx, FATAL, \"",
adamc@873 898 string (ErrorMsg.spanToString loc),
adamc@875 899 string ": Error storing query result: %s\\n%s\", ",
adamc@875 900 query,
adamc@875 901 string ", mysql_error(conn->conn));",
adamc@873 902 newline,
adamc@873 903 newline,
adamc@873 904
adamc@873 905 string "uw_end_region(ctx);",
adamc@873 906 newline,
adamc@875 907 string "while (1) {",
adamc@875 908 newline,
adamc@875 909 string "r = mysql_stmt_fetch(stmt);",
adamc@875 910 newline,
adamc@875 911 string "if (r != 0 && r != MYSQL_DATA_TRUNCATED) break;",
adamc@873 912 newline,
adamc@873 913 doCols p_getcol,
adamc@873 914 string "}",
adamc@873 915 newline,
adamc@873 916 newline,
adamc@873 917
adamc@874 918 string "if (r == 1) uw_error(ctx, FATAL, \"",
adamc@873 919 string (ErrorMsg.spanToString loc),
adamc@875 920 string ": query result fetching failed: %s\\n%s\", ",
adamc@875 921 query,
adamc@875 922 string ", mysql_error(conn->conn));",
adamc@875 923 newline,
adamc@875 924 newline,
adamc@875 925
adamc@875 926 string "if (mysql_stmt_reset(stmt)) uw_error(ctx, FATAL, \"",
adamc@875 927 string (ErrorMsg.spanToString loc),
adamc@875 928 string ": Error reseting statement: %s\\n%s\", ",
adamc@875 929 query,
adamc@875 930 string ", mysql_error(conn->conn));",
adamc@875 931 newline,
adamc@875 932 newline]
adamc@873 933
adamc@873 934 fun query {loc, cols, doCols} =
adamc@873 935 box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@873 936 newline,
adamc@876 937 string "MYSQL_STMT *stmt = mysql_stmt_init(conn->conn);",
adamc@873 938 newline,
adamc@875 939 string "if (stmt == NULL) uw_error(ctx, FATAL, \"",
adamc@873 940 string (ErrorMsg.spanToString loc),
adamc@873 941 string ": can't allocate temporary prepared statement\");",
adamc@873 942 newline,
adamc@873 943 string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);",
adamc@873 944 newline,
adamc@873 945 string "if (mysql_stmt_prepare(stmt, query, strlen(query))) uw_error(ctx, FATAL, \"",
adamc@873 946 string (ErrorMsg.spanToString loc),
adamc@875 947 string ": error preparing statement: %s\\n%s\", query, mysql_error(conn->conn));",
adamc@873 948 newline,
adamc@873 949 newline,
adamc@873 950
adamc@873 951 queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"},
adamc@873 952
adamc@873 953 string "uw_pop_cleanup(ctx);",
adamc@873 954 newline]
adamc@873 955
adamc@879 956 fun queryPrepared {loc, id, query, inputs, cols, doCols, nested} =
adamc@873 957 box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@873 958 newline,
adamc@873 959 string "MYSQL_BIND in[",
adamc@873 960 string (Int.toString (length inputs)),
adamc@873 961 string "];",
adamc@873 962 newline,
adamc@873 963 p_list_sepi (box []) (fn i => fn t =>
adamc@873 964 let
adamc@873 965 fun buffers t =
adamc@873 966 case t of
adamc@873 967 String => box [string "unsigned long in_length",
adamc@873 968 string (Int.toString i),
adamc@873 969 string ";",
adamc@873 970 newline]
adamc@873 971 | Blob => box [string "unsigned long in_length",
adamc@873 972 string (Int.toString i),
adamc@873 973 string ";",
adamc@873 974 newline]
adamc@876 975 | Time => box [string "MYSQL_TIME in_buffer",
adamc@873 976 string (Int.toString i),
adamc@1013 977 string ";",
adamc@1013 978 newline]
adamc@873 979 | _ => box []
adamc@873 980 in
adamc@873 981 box [case t of
adamc@873 982 Nullable t => box [string "my_bool in_is_null",
adamc@873 983 string (Int.toString i),
adamc@873 984 string ";",
adamc@873 985 newline,
adamc@873 986 buffers t]
adamc@873 987 | _ => buffers t,
adamc@873 988 newline]
adamc@873 989 end) inputs,
adamc@873 990
adamc@879 991 if nested then
adamc@879 992 box [string "MYSQL_STMT *stmt;",
adamc@879 993 newline]
adamc@879 994 else
adamc@879 995 box [string "MYSQL_STMT *stmt = conn->p",
adamc@879 996 string (Int.toString id),
adamc@879 997 string ";",
adamc@879 998 newline,
adamc@879 999 newline,
adamc@879 1000
adamc@879 1001 string "if (stmt == NULL) {",
adamc@879 1002 newline],
adamc@879 1003
adamc@878 1004 box [string "stmt = mysql_stmt_init(conn->conn);",
adamc@878 1005 newline,
adamc@878 1006 string "if (stmt == NULL) uw_error(ctx, FATAL, \"Out of memory allocating prepared statement\");",
adamc@878 1007 newline,
adamc@880 1008 if nested then
adamc@880 1009 box [string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);",
adamc@880 1010 newline]
adamc@880 1011 else
adamc@880 1012 box [],
adamc@878 1013 string "if (mysql_stmt_prepare(stmt, \"",
adam@1656 1014 string (Prim.toCString query),
adamc@878 1015 string "\", ",
adamc@878 1016 string (Int.toString (size query)),
adamc@878 1017 string ")) {",
adamc@878 1018 newline,
adamc@878 1019 box [string "char msg[1024];",
adamc@878 1020 newline,
adamc@878 1021 string "strncpy(msg, mysql_stmt_error(stmt), 1024);",
adamc@878 1022 newline,
adamc@878 1023 string "msg[1023] = 0;",
adamc@878 1024 newline,
adamc@880 1025 if nested then
adamc@880 1026 box []
adamc@880 1027 else
adamc@880 1028 box [string "mysql_stmt_close(stmt);",
adamc@880 1029 newline],
adamc@878 1030 string "uw_error(ctx, FATAL, \"Error preparing statement: %s\", msg);",
adamc@878 1031 newline],
adamc@878 1032 string "}",
adamc@878 1033 newline,
adamc@879 1034 if nested then
adamc@879 1035 box []
adamc@879 1036 else
adamc@879 1037 box [string "conn->p",
adamc@879 1038 string (Int.toString id),
adamc@879 1039 string " = stmt;",
adamc@879 1040 newline]],
adamc@879 1041 if nested then
adamc@879 1042 box []
adamc@879 1043 else
adamc@879 1044 box [string "}",
adamc@879 1045 newline],
adamc@878 1046 newline,
adamc@878 1047
adamc@873 1048 string "memset(in, 0, sizeof in);",
adamc@873 1049 newline,
adamc@873 1050 p_list_sepi (box []) (fn i => fn t =>
adamc@873 1051 let
adamc@873 1052 fun buffers t =
adamc@873 1053 case t of
adamc@873 1054 String => box [string "in[",
adamc@873 1055 string (Int.toString i),
adamc@873 1056 string "].buffer = arg",
adamc@873 1057 string (Int.toString (i + 1)),
adamc@873 1058 string ";",
adamc@873 1059 newline,
adamc@873 1060 string "in_length",
adamc@873 1061 string (Int.toString i),
adamc@873 1062 string "= in[",
adamc@873 1063 string (Int.toString i),
adamc@873 1064 string "].buffer_length = strlen(arg",
adamc@873 1065 string (Int.toString (i + 1)),
adamc@873 1066 string ");",
adamc@873 1067 newline,
adamc@873 1068 string "in[",
adamc@873 1069 string (Int.toString i),
adamc@873 1070 string "].length = &in_length",
adamc@873 1071 string (Int.toString i),
adamc@873 1072 string ";",
adamc@873 1073 newline]
adamc@1013 1074 | Char => box [string "in[",
adamc@1013 1075 string (Int.toString i),
adamc@1013 1076 string "].buffer = &arg",
adamc@1013 1077 string (Int.toString (i + 1)),
adamc@1013 1078 string ";",
adamc@1013 1079 newline,
adamc@1013 1080 string "in[",
adamc@1013 1081 string (Int.toString i),
adamc@1013 1082 string "].buffer_length = 1;",
adamc@1013 1083 newline]
adamc@873 1084 | Blob => box [string "in[",
adamc@873 1085 string (Int.toString i),
adamc@873 1086 string "].buffer = arg",
adamc@873 1087 string (Int.toString (i + 1)),
adamc@873 1088 string ".data;",
adamc@873 1089 newline,
adamc@873 1090 string "in_length",
adamc@873 1091 string (Int.toString i),
adamc@873 1092 string "= in[",
adamc@873 1093 string (Int.toString i),
adamc@873 1094 string "].buffer_length = arg",
adamc@873 1095 string (Int.toString (i + 1)),
adamc@873 1096 string ".size;",
adamc@873 1097 newline,
adamc@873 1098 string "in[",
adamc@873 1099 string (Int.toString i),
adamc@873 1100 string "].length = &in_length",
adamc@873 1101 string (Int.toString i),
adamc@873 1102 string ";",
adamc@873 1103 newline]
adamc@873 1104 | Time =>
adamc@873 1105 let
adamc@873 1106 fun oneField dst src =
adamc@873 1107 box [string "in_buffer",
adamc@873 1108 string (Int.toString i),
adamc@873 1109 string ".",
adamc@873 1110 string dst,
adamc@873 1111 string " = tms.tm_",
adamc@873 1112 string src,
adamc@873 1113 string ";",
adamc@873 1114 newline]
adamc@873 1115 in
adamc@873 1116 box [string "({",
adamc@873 1117 newline,
adamc@873 1118 string "struct tm tms;",
adamc@873 1119 newline,
adamc@873 1120 string "if (localtime_r(&arg",
adamc@873 1121 string (Int.toString (i + 1)),
adam@1443 1122 string ".seconds, &tms) == NULL) uw_error(ctx, FATAL, \"",
adamc@873 1123 string (ErrorMsg.spanToString loc),
adamc@873 1124 string ": error converting to MySQL time\");",
adamc@873 1125 newline,
adamc@938 1126 oneField "year" "year + 1900",
adamc@888 1127 box [string "in_buffer",
adamc@888 1128 string (Int.toString i),
adamc@888 1129 string ".month = tms.tm_mon + 1;",
adamc@888 1130 newline],
adamc@873 1131 oneField "day" "mday",
adam@1839 1132 oneField "hour" "hour",
adamc@873 1133 oneField "minute" "min",
adamc@873 1134 oneField "second" "sec",
adamc@873 1135 newline,
adamc@873 1136 string "in[",
adamc@873 1137 string (Int.toString i),
adamc@873 1138 string "].buffer = &in_buffer",
adamc@873 1139 string (Int.toString i),
adamc@873 1140 string ";",
adamc@933 1141 newline,
adamc@933 1142 string "});",
adamc@873 1143 newline]
adamc@873 1144 end
adamc@889 1145 | Channel => box [string "in_buffer",
adamc@889 1146 string (Int.toString i),
adamc@889 1147 string " = ((unsigned long long)arg",
adamc@889 1148 string (Int.toString (i + 1)),
adamc@889 1149 string ".cli << 32) | arg",
adamc@889 1150 string (Int.toString (i + 1)),
adamc@889 1151 string ".chn;",
adamc@889 1152 newline,
adamc@889 1153 string "in[",
adamc@889 1154 string (Int.toString i),
adamc@889 1155 string "].buffer = &in_buffer",
adamc@889 1156 string (Int.toString i),
adamc@889 1157 string ";",
adamc@889 1158 newline]
adam@1682 1159
adamc@873 1160 | _ => box [string "in[",
adamc@873 1161 string (Int.toString i),
adamc@873 1162 string "].buffer = &arg",
adamc@873 1163 string (Int.toString (i + 1)),
adamc@873 1164 string ";",
adamc@873 1165 newline]
adamc@873 1166 in
adamc@873 1167 box [string "in[",
adamc@873 1168 string (Int.toString i),
adamc@873 1169 string "].buffer_type = ",
adamc@873 1170 string (p_buffer_type t),
adamc@873 1171 string ";",
adamc@873 1172 newline,
adam@1682 1173
adamc@873 1174 case t of
adamc@873 1175 Nullable t => box [string "in[",
adamc@873 1176 string (Int.toString i),
adamc@873 1177 string "].is_null = &in_is_null",
adamc@873 1178 string (Int.toString i),
adamc@873 1179 string ";",
adamc@873 1180 newline,
adamc@873 1181 string "if (arg",
adamc@873 1182 string (Int.toString (i + 1)),
adamc@873 1183 string " == NULL) {",
adamc@873 1184 newline,
adamc@873 1185 box [string "in_is_null",
adamc@873 1186 string (Int.toString i),
adamc@873 1187 string " = 1;",
adamc@873 1188 newline],
adamc@873 1189 string "} else {",
adamc@873 1190 box [case t of
adamc@873 1191 String => box []
adamc@873 1192 | _ =>
adamc@873 1193 box [string (p_sql_ctype t),
adamc@873 1194 space,
adamc@876 1195 string "tmp = *arg",
adamc@876 1196 string (Int.toString (i + 1)),
adamc@876 1197 string ";",
adamc@876 1198 newline,
adamc@876 1199 string (p_sql_ctype t),
adamc@876 1200 space,
adamc@873 1201 string "arg",
adamc@873 1202 string (Int.toString (i + 1)),
adamc@876 1203 string " = tmp;",
adamc@873 1204 newline],
adamc@873 1205 string "in_is_null",
adamc@873 1206 string (Int.toString i),
adamc@873 1207 string " = 0;",
adamc@873 1208 newline,
adamc@873 1209 buffers t,
adamc@876 1210 newline],
adamc@876 1211 string "}",
adamc@876 1212 newline]
adam@1682 1213
adamc@873 1214 | _ => buffers t,
adamc@873 1215 newline]
adamc@873 1216 end) inputs,
adamc@873 1217 newline,
adamc@873 1218
adamc@875 1219 string "if (mysql_stmt_bind_param(stmt, in)) uw_error(ctx, FATAL, \"",
adamc@875 1220 string (ErrorMsg.spanToString loc),
adamc@875 1221 string ": error binding parameters\");",
adamc@875 1222 newline,
adamc@875 1223
adamc@873 1224 queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
adam@1656 1225 string (Prim.toCString query),
adamc@879 1226 string "\""]},
adamc@879 1227
adamc@879 1228 if nested then
adamc@879 1229 box [string "uw_pop_cleanup(ctx);",
adamc@879 1230 newline]
adamc@879 1231 else
adamc@879 1232 box []]
adamc@873 1233
adam@1293 1234 fun dmlCommon {loc, dml, mode} =
adam@1953 1235 box [string "if (mysql_stmt_execute(stmt)) {",
adam@1953 1236 box [string "if (mysql_errno(conn->conn) == 1213)",
adam@1953 1237 newline,
adam@1953 1238 box [string "uw_error(ctx, UNLIMITED_RETRY, \"Deadlock detected\");",
adam@1953 1239 newline],
adam@1953 1240 newline,
adam@1953 1241 case mode of
adam@1953 1242 Settings.Error => box [string "uw_error(ctx, FATAL, \"",
adam@1953 1243 string (ErrorMsg.spanToString loc),
adam@1953 1244 string ": Error executing DML: %s\\n%s\", ",
adam@1953 1245 dml,
adam@1953 1246 string ", mysql_error(conn->conn));"]
adam@1953 1247 | Settings.None => string "uw_set_error_message(ctx, mysql_error(conn->conn));",
adam@1953 1248 newline],
adam@1953 1249 string "}",
adamc@875 1250 newline]
adamc@875 1251
adam@1293 1252 fun dml (loc, mode) =
adamc@875 1253 box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@875 1254 newline,
adamc@1013 1255 string "MYSQL_STMT *stmt = mysql_stmt_init(conn->conn);",
adamc@875 1256 newline,
adamc@933 1257 string "if (stmt == NULL) uw_error(ctx, FATAL, \"",
adamc@875 1258 string (ErrorMsg.spanToString loc),
adamc@875 1259 string ": can't allocate temporary prepared statement\");",
adamc@875 1260 newline,
adamc@875 1261 string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);",
adamc@875 1262 newline,
adamc@875 1263 string "if (mysql_stmt_prepare(stmt, dml, strlen(dml))) uw_error(ctx, FATAL, \"",
adamc@875 1264 string (ErrorMsg.spanToString loc),
adamc@875 1265 string ": error preparing statement: %s\\n%s\", dml, mysql_error(conn->conn));",
adamc@875 1266 newline,
adamc@875 1267 newline,
adamc@875 1268
adam@1293 1269 dmlCommon {loc = loc, dml = string "dml", mode = mode},
adamc@875 1270
adamc@875 1271 string "uw_pop_cleanup(ctx);",
adamc@875 1272 newline]
adamc@875 1273
adam@1293 1274 fun dmlPrepared {loc, id, dml, inputs, mode} =
adamc@875 1275 box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@875 1276 newline,
adamc@875 1277 string "MYSQL_BIND in[",
adamc@875 1278 string (Int.toString (length inputs)),
adamc@875 1279 string "];",
adamc@875 1280 newline,
adamc@875 1281 p_list_sepi (box []) (fn i => fn t =>
adamc@875 1282 let
adamc@875 1283 fun buffers t =
adamc@875 1284 case t of
adamc@875 1285 String => box [string "unsigned long in_length",
adamc@875 1286 string (Int.toString i),
adamc@875 1287 string ";",
adamc@875 1288 newline]
adamc@875 1289 | Blob => box [string "unsigned long in_length",
adamc@875 1290 string (Int.toString i),
adamc@875 1291 string ";",
adamc@875 1292 newline]
adamc@876 1293 | Time => box [string "MYSQL_TIME in_buffer",
adamc@875 1294 string (Int.toString i),
adamc@875 1295 string ";",
adamc@875 1296 newline]
adamc@889 1297 | Channel => box [string "unsigned long long in_buffer",
adamc@889 1298 string (Int.toString i),
adamc@889 1299 string ";",
adamc@889 1300 newline]
adamc@875 1301 | _ => box []
adamc@875 1302 in
adamc@875 1303 box [case t of
adamc@875 1304 Nullable t => box [string "my_bool in_is_null",
adamc@875 1305 string (Int.toString i),
adamc@875 1306 string ";",
adamc@875 1307 newline,
adamc@875 1308 buffers t]
adamc@875 1309 | _ => buffers t,
adamc@875 1310 newline]
adamc@875 1311 end) inputs,
adamc@875 1312 string "MYSQL_STMT *stmt = conn->p",
adamc@875 1313 string (Int.toString id),
adamc@875 1314 string ";",
adamc@875 1315 newline,
adamc@875 1316 newline,
adamc@875 1317
adamc@878 1318 string "if (stmt == NULL) {",
adamc@878 1319 newline,
adamc@878 1320 box [string "stmt = mysql_stmt_init(conn->conn);",
adamc@878 1321 newline,
adamc@878 1322 string "if (stmt == NULL) uw_error(ctx, FATAL, \"Out of memory allocating prepared statement\");",
adamc@878 1323 newline,
adamc@878 1324 string "if (mysql_stmt_prepare(stmt, \"",
adam@1656 1325 string (Prim.toCString dml),
adamc@878 1326 string "\", ",
adamc@878 1327 string (Int.toString (size dml)),
adamc@878 1328 string ")) {",
adamc@878 1329 newline,
adamc@878 1330 box [string "char msg[1024];",
adamc@878 1331 newline,
adamc@878 1332 string "strncpy(msg, mysql_stmt_error(stmt), 1024);",
adamc@878 1333 newline,
adamc@878 1334 string "msg[1023] = 0;",
adamc@878 1335 newline,
adamc@878 1336 string "uw_error(ctx, FATAL, \"Error preparing statement: %s\", msg);",
adamc@878 1337 newline],
adamc@878 1338 string "}",
adamc@878 1339 newline,
adamc@878 1340 string "conn->p",
adamc@878 1341 string (Int.toString id),
adamc@878 1342 string " = stmt;",
adamc@878 1343 newline],
adamc@878 1344 string "}",
adamc@878 1345 newline,
adamc@878 1346 newline,
adamc@878 1347
adamc@875 1348 string "memset(in, 0, sizeof in);",
adamc@875 1349 newline,
adamc@875 1350 p_list_sepi (box []) (fn i => fn t =>
adamc@875 1351 let
adamc@875 1352 fun buffers t =
adamc@875 1353 case t of
adamc@875 1354 String => box [string "in[",
adamc@875 1355 string (Int.toString i),
adamc@875 1356 string "].buffer = arg",
adamc@875 1357 string (Int.toString (i + 1)),
adamc@875 1358 string ";",
adamc@875 1359 newline,
adamc@875 1360 string "in_length",
adamc@875 1361 string (Int.toString i),
adamc@875 1362 string "= in[",
adamc@875 1363 string (Int.toString i),
adamc@875 1364 string "].buffer_length = strlen(arg",
adamc@875 1365 string (Int.toString (i + 1)),
adamc@875 1366 string ");",
adamc@875 1367 newline,
adamc@875 1368 string "in[",
adamc@875 1369 string (Int.toString i),
adamc@875 1370 string "].length = &in_length",
adamc@875 1371 string (Int.toString i),
adamc@875 1372 string ";",
adamc@875 1373 newline]
adamc@875 1374 | Blob => box [string "in[",
adamc@875 1375 string (Int.toString i),
adamc@875 1376 string "].buffer = arg",
adamc@875 1377 string (Int.toString (i + 1)),
adamc@875 1378 string ".data;",
adamc@875 1379 newline,
adamc@875 1380 string "in_length",
adamc@875 1381 string (Int.toString i),
adamc@875 1382 string "= in[",
adamc@875 1383 string (Int.toString i),
adamc@875 1384 string "].buffer_length = arg",
adamc@875 1385 string (Int.toString (i + 1)),
adamc@875 1386 string ".size;",
adamc@875 1387 newline,
adamc@875 1388 string "in[",
adamc@875 1389 string (Int.toString i),
adamc@875 1390 string "].length = &in_length",
adamc@875 1391 string (Int.toString i),
adamc@875 1392 string ";",
adamc@875 1393 newline]
adamc@875 1394 | Time =>
adamc@875 1395 let
adamc@875 1396 fun oneField dst src =
adamc@875 1397 box [string "in_buffer",
adamc@875 1398 string (Int.toString i),
adamc@875 1399 string ".",
adamc@875 1400 string dst,
adamc@875 1401 string " = tms.tm_",
adamc@875 1402 string src,
adamc@875 1403 string ";",
adamc@875 1404 newline]
adamc@875 1405 in
adamc@875 1406 box [string "({",
adamc@875 1407 newline,
adamc@875 1408 string "struct tm tms;",
adamc@875 1409 newline,
adamc@875 1410 string "if (localtime_r(&arg",
adamc@875 1411 string (Int.toString (i + 1)),
adam@1443 1412 string ".seconds, &tms) == NULL) uw_error(ctx, FATAL, \"",
adamc@875 1413 string (ErrorMsg.spanToString loc),
adamc@875 1414 string ": error converting to MySQL time\");",
adamc@875 1415 newline,
adamc@938 1416 oneField "year" "year + 1900",
adamc@938 1417 oneField "month" "mon + 1",
adamc@875 1418 oneField "day" "mday",
adam@1839 1419 oneField "hour" "hour",
adamc@875 1420 oneField "minute" "min",
adamc@875 1421 oneField "second" "sec",
adamc@875 1422 newline,
adamc@875 1423 string "in[",
adamc@875 1424 string (Int.toString i),
adamc@875 1425 string "].buffer = &in_buffer",
adamc@875 1426 string (Int.toString i),
adamc@875 1427 string ";",
adamc@933 1428 newline,
adamc@933 1429 string "});",
adamc@875 1430 newline]
adamc@875 1431 end
adamc@889 1432 | Channel => box [string "in_buffer",
adamc@889 1433 string (Int.toString i),
adamc@889 1434 string " = ((unsigned long long)arg",
adamc@889 1435 string (Int.toString (i + 1)),
adamc@889 1436 string ".cli << 32) | arg",
adamc@889 1437 string (Int.toString (i + 1)),
adamc@889 1438 string ".chn;",
adamc@889 1439 newline,
adamc@889 1440 string "in[",
adamc@889 1441 string (Int.toString i),
adamc@889 1442 string "].buffer = &in_buffer",
adamc@889 1443 string (Int.toString i),
adamc@889 1444 string ";",
adamc@889 1445 newline]
adam@1682 1446
adamc@875 1447 | _ => box [string "in[",
adamc@875 1448 string (Int.toString i),
adamc@875 1449 string "].buffer = &arg",
adamc@875 1450 string (Int.toString (i + 1)),
adamc@875 1451 string ";",
adamc@875 1452 newline]
adamc@875 1453 in
adamc@875 1454 box [string "in[",
adamc@875 1455 string (Int.toString i),
adamc@875 1456 string "].buffer_type = ",
adamc@875 1457 string (p_buffer_type t),
adamc@875 1458 string ";",
adamc@875 1459 newline,
adamc@889 1460
adamc@889 1461 case t of
adamc@889 1462 Channel => box [string "in[",
adamc@889 1463 string (Int.toString i),
adamc@889 1464 string "].is_unsigned = 1;",
adamc@889 1465 newline]
adamc@889 1466 | _ => box [],
adam@1682 1467
adamc@875 1468 case t of
adamc@875 1469 Nullable t => box [string "in[",
adamc@875 1470 string (Int.toString i),
adamc@875 1471 string "].is_null = &in_is_null",
adamc@875 1472 string (Int.toString i),
adamc@875 1473 string ";",
adamc@875 1474 newline,
adamc@875 1475 string "if (arg",
adamc@875 1476 string (Int.toString (i + 1)),
adamc@875 1477 string " == NULL) {",
adamc@875 1478 newline,
adamc@875 1479 box [string "in_is_null",
adamc@875 1480 string (Int.toString i),
adamc@875 1481 string " = 1;",
adamc@875 1482 newline],
adamc@875 1483 string "} else {",
adamc@875 1484 box [case t of
adamc@875 1485 String => box []
adamc@875 1486 | _ =>
adamc@875 1487 box [string (p_sql_ctype t),
adamc@875 1488 space,
adamc@876 1489 string "tmp = *arg",
adamc@876 1490 string (Int.toString (i + 1)),
adamc@876 1491 string ";",
adamc@876 1492 newline,
adamc@876 1493 string (p_sql_ctype t),
adamc@876 1494 space,
adamc@875 1495 string "arg",
adamc@875 1496 string (Int.toString (i + 1)),
adamc@876 1497 string " = tmp;",
adamc@875 1498 newline],
adamc@875 1499 string "in_is_null",
adamc@875 1500 string (Int.toString i),
adamc@875 1501 string " = 0;",
adamc@875 1502 newline,
adamc@875 1503 buffers t,
adamc@876 1504 newline],
adamc@876 1505 string "}",
adamc@876 1506 newline]
adam@1682 1507
adamc@875 1508 | _ => buffers t,
adamc@875 1509 newline]
adamc@875 1510 end) inputs,
adamc@875 1511 newline,
adamc@875 1512
adamc@875 1513 string "if (mysql_stmt_bind_param(stmt, in)) uw_error(ctx, FATAL, \"",
adamc@875 1514 string (ErrorMsg.spanToString loc),
adamc@875 1515 string ": error binding parameters\");",
adamc@875 1516 newline,
adamc@875 1517
adamc@875 1518 dmlCommon {loc = loc, dml = box [string "\"",
adam@1656 1519 string (Prim.toCString dml),
adam@1293 1520 string "\""], mode = mode}]
adamc@875 1521
adamc@878 1522 fun nextval {loc, seqE, seqName} =
adamc@878 1523 box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@878 1524 newline,
adamc@878 1525 string "char *insert = ",
adamc@878 1526 case seqName of
adamc@878 1527 SOME s => string ("\"INSERT INTO " ^ s ^ " VALUES ()\"")
adamc@878 1528 | NONE => box [string "uw_Basis_strcat(ctx, \"INSERT INTO \", uw_Basis_strcat(ctx, ",
adamc@878 1529 seqE,
adamc@878 1530 string ", \" VALUES ()\"))"],
adamc@878 1531 string ";",
adamc@878 1532 newline,
adamc@878 1533 string "char *delete = ",
adamc@878 1534 case seqName of
adamc@878 1535 SOME s => string ("\"DELETE FROM " ^ s ^ "\"")
adamc@878 1536 | NONE => box [string "uw_Basis_strcat(ctx, \"DELETE FROM \", ",
adamc@878 1537 seqE,
adamc@878 1538 string ")"],
adamc@878 1539 string ";",
adamc@878 1540 newline,
adamc@878 1541 newline,
adamc@878 1542
adamc@878 1543 string "if (mysql_query(conn->conn, insert)) uw_error(ctx, FATAL, \"'nextval' INSERT failed\");",
adamc@878 1544 newline,
adamc@878 1545 string "n = mysql_insert_id(conn->conn);",
adamc@878 1546 newline,
adamc@878 1547 string "if (mysql_query(conn->conn, delete)) uw_error(ctx, FATAL, \"'nextval' DELETE failed\");",
adamc@878 1548 newline]
adamc@878 1549
adamc@878 1550 fun nextvalPrepared _ = raise Fail "MySQL.nextvalPrepared called"
adamc@867 1551
adamc@1073 1552 fun setval _ = raise Fail "MySQL.setval called"
adamc@1073 1553
adamc@877 1554 fun sqlifyString s = "'" ^ String.translate (fn #"'" => "\\'"
adamc@877 1555 | #"\\" => "\\\\"
adamc@877 1556 | ch =>
adamc@877 1557 if Char.isPrint ch then
adamc@877 1558 str ch
adamc@877 1559 else
adamc@877 1560 (ErrorMsg.error
adamc@877 1561 "Non-printing character found in SQL string literal";
adamc@877 1562 ""))
adam@1656 1563 (Prim.toCString s) ^ "'"
adamc@874 1564
adamc@877 1565 fun p_cast (s, _) = s
adamc@874 1566
adamc@874 1567 fun p_blank _ = "?"
adamc@874 1568
adamc@866 1569 val () = addDbms {name = "mysql",
adam@1464 1570 header = Config.msheader,
adam@1682 1571 randomFunction = "RAND",
adamc@866 1572 link = "-lmysqlclient",
adamc@867 1573 init = init,
adamc@873 1574 p_sql_type = p_sql_type,
adamc@867 1575 query = query,
adamc@868 1576 queryPrepared = queryPrepared,
adamc@868 1577 dml = dml,
adamc@869 1578 dmlPrepared = dmlPrepared,
adamc@869 1579 nextval = nextval,
adamc@874 1580 nextvalPrepared = nextvalPrepared,
adamc@1073 1581 setval = setval,
adamc@874 1582 sqlifyString = sqlifyString,
adamc@874 1583 p_cast = p_cast,
adamc@874 1584 p_blank = p_blank,
adamc@877 1585 supportsDeleteAs = false,
adamc@886 1586 supportsUpdateAs = false,
adamc@884 1587 createSequence = fn s => "CREATE TABLE " ^ s ^ " (uw_id INTEGER PRIMARY KEY AUTO_INCREMENT)",
adamc@878 1588 textKeysNeedLengths = true,
adamc@879 1589 supportsNextval = false,
adamc@882 1590 supportsNestedPrepared = false,
adamc@890 1591 sqlPrefix = "SET storage_engine=InnoDB;\n\n",
adamc@1014 1592 supportsOctetLength = true,
adamc@1014 1593 trueString = "TRUE",
adamc@1196 1594 falseString = "FALSE",
adamc@1196 1595 onlyUnion = true,
adam@1777 1596 nestedRelops = false,
adam@1777 1597 windowFunctions = false}
adamc@866 1598
adamc@866 1599 end