Mercurial > urweb

annotate src/mysql.sml @ 1591:20f898c29525

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