Mercurial > urweb

annotate src/mysql.sml @ 1836:276fa06428ba

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