Mercurial > urweb

annotate src/mysql.sml @ 1380:ede95ecb4000

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Thanks to Vag Vagoff, catch some cases of an obsolete notation for guarded types in the manual
author Adam Chlipala <adam@chlipala.net>
date Thu, 06 Jan 2011 08:55:53 -0500
parents 929981850d9d
children 19e8e3d556d6
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,
adamc@876 678 string "mktime(&t);",
adamc@873 679 newline,
adamc@873 680 string "})"]
adamc@889 681 | Channel => box [string "({",
adamc@889 682 string "uw_Basis_channel ch = {buffer",
adamc@889 683 string (Int.toString i),
adamc@889 684 string " >> 32, buffer",
adamc@889 685 string (Int.toString i),
adamc@889 686 string " & 0xFFFFFFFF};",
adamc@889 687 newline,
adamc@889 688 string "ch;",
adamc@889 689 newline,
adamc@889 690 string "})"]
adamc@873 691 | _ => box [string "buffer",
adamc@873 692 string (Int.toString i)]
adamc@873 693 in
adamc@873 694 case t of
adamc@873 695 Nullable t => box [string "(is_null",
adamc@873 696 string (Int.toString i),
adamc@873 697 string " ? NULL : ",
adamc@873 698 case t of
adamc@873 699 String => getter t
adamc@873 700 | _ => box [string "({",
adamc@873 701 newline,
adamc@873 702 string (p_sql_ctype t),
adamc@873 703 space,
adamc@873 704 string "*tmp = uw_malloc(ctx, sizeof(",
adamc@873 705 string (p_sql_ctype t),
adamc@873 706 string "));",
adamc@873 707 newline,
adamc@873 708 string "*tmp = ",
adamc@873 709 getter t,
adamc@873 710 string ";",
adamc@873 711 newline,
adamc@873 712 string "tmp;",
adamc@873 713 newline,
adamc@873 714 string "})"],
adamc@873 715 string ")"]
adamc@873 716 | _ => box [string "(is_null",
adamc@873 717 string (Int.toString i),
adamc@873 718 string " ? ",
adamc@873 719 box [string "({",
adamc@873 720 string (p_sql_ctype t),
adamc@873 721 space,
adamc@873 722 string "tmp;",
adamc@873 723 newline,
adamc@873 724 string "uw_error(ctx, FATAL, \"Unexpectedly NULL field #",
adamc@873 725 string (Int.toString i),
adamc@873 726 string "\");",
adamc@873 727 newline,
adamc@873 728 string "tmp;",
adamc@873 729 newline,
adamc@873 730 string "})"],
adamc@873 731 string " : ",
adamc@873 732 getter t,
adamc@873 733 string ")"]
adamc@873 734 end
adamc@873 735
adamc@873 736 fun queryCommon {loc, query, cols, doCols} =
adamc@873 737 box [string "int n, r;",
adamc@873 738 newline,
adamc@873 739 string "MYSQL_BIND out[",
adamc@873 740 string (Int.toString (length cols)),
adamc@873 741 string "];",
adamc@873 742 newline,
adamc@873 743 p_list_sepi (box []) (fn i => fn t =>
adamc@873 744 let
adamc@873 745 fun buffers t =
adamc@873 746 case t of
adamc@873 747 String => box [string "unsigned long length",
adamc@873 748 string (Int.toString i),
adamc@873 749 string ";",
adamc@873 750 newline]
adamc@873 751 | Blob => box [string "unsigned long length",
adamc@873 752 string (Int.toString i),
adamc@873 753 string ";",
adamc@873 754 newline]
adamc@876 755 | Time => box [string "MYSQL_TIME buffer",
adamc@876 756 string (Int.toString i),
adamc@876 757 string ";",
adamc@876 758 newline]
adamc@889 759 | Channel => box [string "unsigned long long buffer",
adamc@889 760 string (Int.toString i),
adamc@889 761 string ";",
adamc@889 762 newline]
adamc@873 763 | _ => box [string (p_sql_ctype t),
adamc@873 764 space,
adamc@873 765 string "buffer",
adamc@873 766 string (Int.toString i),
adamc@873 767 string ";",
adamc@873 768 newline]
adamc@873 769 in
adamc@873 770 box [string "my_bool is_null",
adamc@873 771 string (Int.toString i),
adamc@873 772 string ";",
adamc@873 773 newline,
adamc@873 774 case t of
adamc@873 775 Nullable t => buffers t
adamc@873 776 | _ => buffers t,
adamc@873 777 newline]
adamc@873 778 end) cols,
adamc@873 779 newline,
adamc@873 780
adamc@873 781 string "memset(out, 0, sizeof out);",
adamc@873 782 newline,
adamc@873 783 p_list_sepi (box []) (fn i => fn t =>
adamc@873 784 let
adamc@873 785 fun buffers t =
adamc@873 786 case t of
adamc@875 787 String => box [string "out[",
adamc@875 788 string (Int.toString i),
adamc@875 789 string "].length = &length",
adamc@875 790 string (Int.toString i),
adamc@875 791 string ";",
adamc@875 792 newline]
adamc@1013 793 | Char => box [string "out[",
adamc@1013 794 string (Int.toString i),
adamc@1013 795 string "].buffer_length = 1;",
adamc@1013 796 newline,
adamc@1013 797 string "out[",
adamc@1013 798 string (Int.toString i),
adamc@1013 799 string "].buffer = &buffer",
adamc@1013 800 string (Int.toString i),
adamc@1013 801 string ";",
adamc@1013 802 newline]
adamc@875 803 | Blob => box [string "out[",
adamc@875 804 string (Int.toString i),
adamc@875 805 string "].length = &length",
adamc@875 806 string (Int.toString i),
adamc@875 807 string ";",
adamc@875 808 newline]
adamc@873 809 | _ => box [string "out[",
adamc@873 810 string (Int.toString i),
adamc@873 811 string "].buffer = &buffer",
adamc@873 812 string (Int.toString i),
adamc@873 813 string ";",
adamc@873 814 newline]
adamc@873 815 in
adamc@873 816 box [string "out[",
adamc@873 817 string (Int.toString i),
adamc@873 818 string "].buffer_type = ",
adamc@873 819 string (p_buffer_type t),
adamc@873 820 string ";",
adamc@873 821 newline,
adamc@873 822 string "out[",
adamc@873 823 string (Int.toString i),
adamc@873 824 string "].is_null = &is_null",
adamc@873 825 string (Int.toString i),
adamc@873 826 string ";",
adamc@873 827 newline,
adamc@873 828
adamc@873 829 case t of
adamc@873 830 Nullable t => buffers t
adamc@873 831 | _ => buffers t,
adamc@873 832 newline]
adamc@873 833 end) cols,
adamc@873 834 newline,
adamc@873 835
adamc@875 836 string "if (mysql_stmt_reset(stmt)) uw_error(ctx, FATAL, \"",
adamc@875 837 string (ErrorMsg.spanToString loc),
adamc@875 838 string ": Error reseting statement: %s\\n%s\", ",
adamc@875 839 query,
adamc@875 840 string ", mysql_error(conn->conn));",
adamc@875 841 newline,
adamc@875 842 newline,
adamc@875 843
adamc@873 844 string "if (mysql_stmt_execute(stmt)) uw_error(ctx, FATAL, \"",
adamc@873 845 string (ErrorMsg.spanToString loc),
adamc@875 846 string ": Error executing query: %s\\n%s\", ",
adamc@875 847 query,
adamc@875 848 string ", mysql_error(conn->conn));",
adamc@875 849 newline,
adamc@875 850 newline,
adamc@875 851
adamc@875 852 string "if (mysql_stmt_bind_result(stmt, out)) uw_error(ctx, FATAL, \"",
adamc@875 853 string (ErrorMsg.spanToString loc),
adamc@875 854 string ": Error binding query result: %s\\n%s\", ",
adamc@875 855 query,
adamc@875 856 string ", mysql_error(conn->conn));",
adamc@873 857 newline,
adamc@873 858 newline,
adamc@873 859
adamc@873 860 string "if (mysql_stmt_store_result(stmt)) uw_error(ctx, FATAL, \"",
adamc@873 861 string (ErrorMsg.spanToString loc),
adamc@875 862 string ": Error storing query result: %s\\n%s\", ",
adamc@875 863 query,
adamc@875 864 string ", mysql_error(conn->conn));",
adamc@873 865 newline,
adamc@873 866 newline,
adamc@873 867
adamc@873 868 string "uw_end_region(ctx);",
adamc@873 869 newline,
adamc@875 870 string "while (1) {",
adamc@875 871 newline,
adamc@875 872 string "r = mysql_stmt_fetch(stmt);",
adamc@875 873 newline,
adamc@875 874 string "if (r != 0 && r != MYSQL_DATA_TRUNCATED) break;",
adamc@873 875 newline,
adamc@873 876 doCols p_getcol,
adamc@873 877 string "}",
adamc@873 878 newline,
adamc@873 879 newline,
adamc@873 880
adamc@874 881 string "if (r == 1) uw_error(ctx, FATAL, \"",
adamc@873 882 string (ErrorMsg.spanToString loc),
adamc@875 883 string ": query result fetching failed: %s\\n%s\", ",
adamc@875 884 query,
adamc@875 885 string ", mysql_error(conn->conn));",
adamc@875 886 newline,
adamc@875 887 newline,
adamc@875 888
adamc@875 889 string "if (mysql_stmt_reset(stmt)) uw_error(ctx, FATAL, \"",
adamc@875 890 string (ErrorMsg.spanToString loc),
adamc@875 891 string ": Error reseting statement: %s\\n%s\", ",
adamc@875 892 query,
adamc@875 893 string ", mysql_error(conn->conn));",
adamc@875 894 newline,
adamc@875 895 newline]
adamc@873 896
adamc@873 897 fun query {loc, cols, doCols} =
adamc@873 898 box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@873 899 newline,
adamc@876 900 string "MYSQL_STMT *stmt = mysql_stmt_init(conn->conn);",
adamc@873 901 newline,
adamc@875 902 string "if (stmt == NULL) uw_error(ctx, FATAL, \"",
adamc@873 903 string (ErrorMsg.spanToString loc),
adamc@873 904 string ": can't allocate temporary prepared statement\");",
adamc@873 905 newline,
adamc@873 906 string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);",
adamc@873 907 newline,
adamc@873 908 string "if (mysql_stmt_prepare(stmt, query, strlen(query))) uw_error(ctx, FATAL, \"",
adamc@873 909 string (ErrorMsg.spanToString loc),
adamc@875 910 string ": error preparing statement: %s\\n%s\", query, mysql_error(conn->conn));",
adamc@873 911 newline,
adamc@873 912 newline,
adamc@873 913
adamc@873 914 queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"},
adamc@873 915
adamc@873 916 string "uw_pop_cleanup(ctx);",
adamc@873 917 newline]
adamc@873 918
adamc@879 919 fun queryPrepared {loc, id, query, inputs, cols, doCols, nested} =
adamc@873 920 box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@873 921 newline,
adamc@873 922 string "MYSQL_BIND in[",
adamc@873 923 string (Int.toString (length inputs)),
adamc@873 924 string "];",
adamc@873 925 newline,
adamc@873 926 p_list_sepi (box []) (fn i => fn t =>
adamc@873 927 let
adamc@873 928 fun buffers t =
adamc@873 929 case t of
adamc@873 930 String => box [string "unsigned long in_length",
adamc@873 931 string (Int.toString i),
adamc@873 932 string ";",
adamc@873 933 newline]
adamc@873 934 | Blob => box [string "unsigned long in_length",
adamc@873 935 string (Int.toString i),
adamc@873 936 string ";",
adamc@873 937 newline]
adamc@876 938 | Time => box [string "MYSQL_TIME in_buffer",
adamc@873 939 string (Int.toString i),
adamc@1013 940 string ";",
adamc@1013 941 newline]
adamc@873 942 | _ => box []
adamc@873 943 in
adamc@873 944 box [case t of
adamc@873 945 Nullable t => box [string "my_bool in_is_null",
adamc@873 946 string (Int.toString i),
adamc@873 947 string ";",
adamc@873 948 newline,
adamc@873 949 buffers t]
adamc@873 950 | _ => buffers t,
adamc@873 951 newline]
adamc@873 952 end) inputs,
adamc@873 953
adamc@879 954 if nested then
adamc@879 955 box [string "MYSQL_STMT *stmt;",
adamc@879 956 newline]
adamc@879 957 else
adamc@879 958 box [string "MYSQL_STMT *stmt = conn->p",
adamc@879 959 string (Int.toString id),
adamc@879 960 string ";",
adamc@879 961 newline,
adamc@879 962 newline,
adamc@879 963
adamc@879 964 string "if (stmt == NULL) {",
adamc@879 965 newline],
adamc@879 966
adamc@878 967 box [string "stmt = mysql_stmt_init(conn->conn);",
adamc@878 968 newline,
adamc@878 969 string "if (stmt == NULL) uw_error(ctx, FATAL, \"Out of memory allocating prepared statement\");",
adamc@878 970 newline,
adamc@880 971 if nested then
adamc@880 972 box [string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);",
adamc@880 973 newline]
adamc@880 974 else
adamc@880 975 box [],
adamc@878 976 string "if (mysql_stmt_prepare(stmt, \"",
adam@1285 977 string (String.toCString query),
adamc@878 978 string "\", ",
adamc@878 979 string (Int.toString (size query)),
adamc@878 980 string ")) {",
adamc@878 981 newline,
adamc@878 982 box [string "char msg[1024];",
adamc@878 983 newline,
adamc@878 984 string "strncpy(msg, mysql_stmt_error(stmt), 1024);",
adamc@878 985 newline,
adamc@878 986 string "msg[1023] = 0;",
adamc@878 987 newline,
adamc@880 988 if nested then
adamc@880 989 box []
adamc@880 990 else
adamc@880 991 box [string "mysql_stmt_close(stmt);",
adamc@880 992 newline],
adamc@878 993 string "uw_error(ctx, FATAL, \"Error preparing statement: %s\", msg);",
adamc@878 994 newline],
adamc@878 995 string "}",
adamc@878 996 newline,
adamc@879 997 if nested then
adamc@879 998 box []
adamc@879 999 else
adamc@879 1000 box [string "conn->p",
adamc@879 1001 string (Int.toString id),
adamc@879 1002 string " = stmt;",
adamc@879 1003 newline]],
adamc@879 1004 if nested then
adamc@879 1005 box []
adamc@879 1006 else
adamc@879 1007 box [string "}",
adamc@879 1008 newline],
adamc@878 1009 newline,
adamc@878 1010
adamc@873 1011 string "memset(in, 0, sizeof in);",
adamc@873 1012 newline,
adamc@873 1013 p_list_sepi (box []) (fn i => fn t =>
adamc@873 1014 let
adamc@873 1015 fun buffers t =
adamc@873 1016 case t of
adamc@873 1017 String => box [string "in[",
adamc@873 1018 string (Int.toString i),
adamc@873 1019 string "].buffer = arg",
adamc@873 1020 string (Int.toString (i + 1)),
adamc@873 1021 string ";",
adamc@873 1022 newline,
adamc@873 1023 string "in_length",
adamc@873 1024 string (Int.toString i),
adamc@873 1025 string "= in[",
adamc@873 1026 string (Int.toString i),
adamc@873 1027 string "].buffer_length = strlen(arg",
adamc@873 1028 string (Int.toString (i + 1)),
adamc@873 1029 string ");",
adamc@873 1030 newline,
adamc@873 1031 string "in[",
adamc@873 1032 string (Int.toString i),
adamc@873 1033 string "].length = &in_length",
adamc@873 1034 string (Int.toString i),
adamc@873 1035 string ";",
adamc@873 1036 newline]
adamc@1013 1037 | Char => box [string "in[",
adamc@1013 1038 string (Int.toString i),
adamc@1013 1039 string "].buffer = &arg",
adamc@1013 1040 string (Int.toString (i + 1)),
adamc@1013 1041 string ";",
adamc@1013 1042 newline,
adamc@1013 1043 string "in[",
adamc@1013 1044 string (Int.toString i),
adamc@1013 1045 string "].buffer_length = 1;",
adamc@1013 1046 newline]
adamc@873 1047 | Blob => box [string "in[",
adamc@873 1048 string (Int.toString i),
adamc@873 1049 string "].buffer = arg",
adamc@873 1050 string (Int.toString (i + 1)),
adamc@873 1051 string ".data;",
adamc@873 1052 newline,
adamc@873 1053 string "in_length",
adamc@873 1054 string (Int.toString i),
adamc@873 1055 string "= in[",
adamc@873 1056 string (Int.toString i),
adamc@873 1057 string "].buffer_length = arg",
adamc@873 1058 string (Int.toString (i + 1)),
adamc@873 1059 string ".size;",
adamc@873 1060 newline,
adamc@873 1061 string "in[",
adamc@873 1062 string (Int.toString i),
adamc@873 1063 string "].length = &in_length",
adamc@873 1064 string (Int.toString i),
adamc@873 1065 string ";",
adamc@873 1066 newline]
adamc@873 1067 | Time =>
adamc@873 1068 let
adamc@873 1069 fun oneField dst src =
adamc@873 1070 box [string "in_buffer",
adamc@873 1071 string (Int.toString i),
adamc@873 1072 string ".",
adamc@873 1073 string dst,
adamc@873 1074 string " = tms.tm_",
adamc@873 1075 string src,
adamc@873 1076 string ";",
adamc@873 1077 newline]
adamc@873 1078 in
adamc@873 1079 box [string "({",
adamc@873 1080 newline,
adamc@873 1081 string "struct tm tms;",
adamc@873 1082 newline,
adamc@873 1083 string "if (localtime_r(&arg",
adamc@873 1084 string (Int.toString (i + 1)),
adamc@933 1085 string ", &tms) == NULL) uw_error(ctx, FATAL, \"",
adamc@873 1086 string (ErrorMsg.spanToString loc),
adamc@873 1087 string ": error converting to MySQL time\");",
adamc@873 1088 newline,
adamc@938 1089 oneField "year" "year + 1900",
adamc@888 1090 box [string "in_buffer",
adamc@888 1091 string (Int.toString i),
adamc@888 1092 string ".month = tms.tm_mon + 1;",
adamc@888 1093 newline],
adamc@873 1094 oneField "day" "mday",
adamc@938 1095 oneField "hour" "hour - 1",
adamc@873 1096 oneField "minute" "min",
adamc@873 1097 oneField "second" "sec",
adamc@873 1098 newline,
adamc@873 1099 string "in[",
adamc@873 1100 string (Int.toString i),
adamc@873 1101 string "].buffer = &in_buffer",
adamc@873 1102 string (Int.toString i),
adamc@873 1103 string ";",
adamc@933 1104 newline,
adamc@933 1105 string "});",
adamc@873 1106 newline]
adamc@873 1107 end
adamc@889 1108 | Channel => box [string "in_buffer",
adamc@889 1109 string (Int.toString i),
adamc@889 1110 string " = ((unsigned long long)arg",
adamc@889 1111 string (Int.toString (i + 1)),
adamc@889 1112 string ".cli << 32) | arg",
adamc@889 1113 string (Int.toString (i + 1)),
adamc@889 1114 string ".chn;",
adamc@889 1115 newline,
adamc@889 1116 string "in[",
adamc@889 1117 string (Int.toString i),
adamc@889 1118 string "].buffer = &in_buffer",
adamc@889 1119 string (Int.toString i),
adamc@889 1120 string ";",
adamc@889 1121 newline]
adamc@873 1122
adamc@873 1123 | _ => box [string "in[",
adamc@873 1124 string (Int.toString i),
adamc@873 1125 string "].buffer = &arg",
adamc@873 1126 string (Int.toString (i + 1)),
adamc@873 1127 string ";",
adamc@873 1128 newline]
adamc@873 1129 in
adamc@873 1130 box [string "in[",
adamc@873 1131 string (Int.toString i),
adamc@873 1132 string "].buffer_type = ",
adamc@873 1133 string (p_buffer_type t),
adamc@873 1134 string ";",
adamc@873 1135 newline,
adamc@873 1136
adamc@873 1137 case t of
adamc@873 1138 Nullable t => box [string "in[",
adamc@873 1139 string (Int.toString i),
adamc@873 1140 string "].is_null = &in_is_null",
adamc@873 1141 string (Int.toString i),
adamc@873 1142 string ";",
adamc@873 1143 newline,
adamc@873 1144 string "if (arg",
adamc@873 1145 string (Int.toString (i + 1)),
adamc@873 1146 string " == NULL) {",
adamc@873 1147 newline,
adamc@873 1148 box [string "in_is_null",
adamc@873 1149 string (Int.toString i),
adamc@873 1150 string " = 1;",
adamc@873 1151 newline],
adamc@873 1152 string "} else {",
adamc@873 1153 box [case t of
adamc@873 1154 String => box []
adamc@873 1155 | _ =>
adamc@873 1156 box [string (p_sql_ctype t),
adamc@873 1157 space,
adamc@876 1158 string "tmp = *arg",
adamc@876 1159 string (Int.toString (i + 1)),
adamc@876 1160 string ";",
adamc@876 1161 newline,
adamc@876 1162 string (p_sql_ctype t),
adamc@876 1163 space,
adamc@873 1164 string "arg",
adamc@873 1165 string (Int.toString (i + 1)),
adamc@876 1166 string " = tmp;",
adamc@873 1167 newline],
adamc@873 1168 string "in_is_null",
adamc@873 1169 string (Int.toString i),
adamc@873 1170 string " = 0;",
adamc@873 1171 newline,
adamc@873 1172 buffers t,
adamc@876 1173 newline],
adamc@876 1174 string "}",
adamc@876 1175 newline]
adamc@873 1176
adamc@873 1177 | _ => buffers t,
adamc@873 1178 newline]
adamc@873 1179 end) inputs,
adamc@873 1180 newline,
adamc@873 1181
adamc@875 1182 string "if (mysql_stmt_bind_param(stmt, in)) uw_error(ctx, FATAL, \"",
adamc@875 1183 string (ErrorMsg.spanToString loc),
adamc@875 1184 string ": error binding parameters\");",
adamc@875 1185 newline,
adamc@875 1186
adamc@873 1187 queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
adam@1285 1188 string (String.toCString query),
adamc@879 1189 string "\""]},
adamc@879 1190
adamc@879 1191 if nested then
adamc@879 1192 box [string "uw_pop_cleanup(ctx);",
adamc@879 1193 newline]
adamc@879 1194 else
adamc@879 1195 box []]
adamc@873 1196
adam@1293 1197 fun dmlCommon {loc, dml, mode} =
adam@1293 1198 box [string "if (mysql_stmt_execute(stmt)) ",
adam@1293 1199 case mode of
adam@1293 1200 Settings.Error => box [string "uw_error(ctx, FATAL, \"",
adam@1293 1201 string (ErrorMsg.spanToString loc),
adam@1293 1202 string ": Error executing DML: %s\\n%s\", ",
adam@1293 1203 dml,
adam@1293 1204 string ", mysql_error(conn->conn));"]
adam@1295 1205 | Settings.None => string "uw_set_error_message(ctx, mysql_error(conn->conn));",
adamc@875 1206 newline,
adamc@875 1207 newline]
adamc@875 1208
adam@1293 1209 fun dml (loc, mode) =
adamc@875 1210 box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@875 1211 newline,
adamc@1013 1212 string "MYSQL_STMT *stmt = mysql_stmt_init(conn->conn);",
adamc@875 1213 newline,
adamc@933 1214 string "if (stmt == NULL) uw_error(ctx, FATAL, \"",
adamc@875 1215 string (ErrorMsg.spanToString loc),
adamc@875 1216 string ": can't allocate temporary prepared statement\");",
adamc@875 1217 newline,
adamc@875 1218 string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);",
adamc@875 1219 newline,
adamc@875 1220 string "if (mysql_stmt_prepare(stmt, dml, strlen(dml))) uw_error(ctx, FATAL, \"",
adamc@875 1221 string (ErrorMsg.spanToString loc),
adamc@875 1222 string ": error preparing statement: %s\\n%s\", dml, mysql_error(conn->conn));",
adamc@875 1223 newline,
adamc@875 1224 newline,
adamc@875 1225
adam@1293 1226 dmlCommon {loc = loc, dml = string "dml", mode = mode},
adamc@875 1227
adamc@875 1228 string "uw_pop_cleanup(ctx);",
adamc@875 1229 newline]
adamc@875 1230
adam@1293 1231 fun dmlPrepared {loc, id, dml, inputs, mode} =
adamc@875 1232 box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@875 1233 newline,
adamc@875 1234 string "MYSQL_BIND in[",
adamc@875 1235 string (Int.toString (length inputs)),
adamc@875 1236 string "];",
adamc@875 1237 newline,
adamc@875 1238 p_list_sepi (box []) (fn i => fn t =>
adamc@875 1239 let
adamc@875 1240 fun buffers t =
adamc@875 1241 case t of
adamc@875 1242 String => box [string "unsigned long in_length",
adamc@875 1243 string (Int.toString i),
adamc@875 1244 string ";",
adamc@875 1245 newline]
adamc@875 1246 | Blob => box [string "unsigned long in_length",
adamc@875 1247 string (Int.toString i),
adamc@875 1248 string ";",
adamc@875 1249 newline]
adamc@876 1250 | Time => box [string "MYSQL_TIME in_buffer",
adamc@875 1251 string (Int.toString i),
adamc@875 1252 string ";",
adamc@875 1253 newline]
adamc@889 1254 | Channel => box [string "unsigned long long in_buffer",
adamc@889 1255 string (Int.toString i),
adamc@889 1256 string ";",
adamc@889 1257 newline]
adamc@875 1258 | _ => box []
adamc@875 1259 in
adamc@875 1260 box [case t of
adamc@875 1261 Nullable t => box [string "my_bool in_is_null",
adamc@875 1262 string (Int.toString i),
adamc@875 1263 string ";",
adamc@875 1264 newline,
adamc@875 1265 buffers t]
adamc@875 1266 | _ => buffers t,
adamc@875 1267 newline]
adamc@875 1268 end) inputs,
adamc@875 1269 string "MYSQL_STMT *stmt = conn->p",
adamc@875 1270 string (Int.toString id),
adamc@875 1271 string ";",
adamc@875 1272 newline,
adamc@875 1273 newline,
adamc@875 1274
adamc@878 1275 string "if (stmt == NULL) {",
adamc@878 1276 newline,
adamc@878 1277 box [string "stmt = mysql_stmt_init(conn->conn);",
adamc@878 1278 newline,
adamc@878 1279 string "if (stmt == NULL) uw_error(ctx, FATAL, \"Out of memory allocating prepared statement\");",
adamc@878 1280 newline,
adamc@878 1281 string "if (mysql_stmt_prepare(stmt, \"",
adam@1285 1282 string (String.toCString dml),
adamc@878 1283 string "\", ",
adamc@878 1284 string (Int.toString (size dml)),
adamc@878 1285 string ")) {",
adamc@878 1286 newline,
adamc@878 1287 box [string "char msg[1024];",
adamc@878 1288 newline,
adamc@878 1289 string "strncpy(msg, mysql_stmt_error(stmt), 1024);",
adamc@878 1290 newline,
adamc@878 1291 string "msg[1023] = 0;",
adamc@878 1292 newline,
adamc@878 1293 string "uw_error(ctx, FATAL, \"Error preparing statement: %s\", msg);",
adamc@878 1294 newline],
adamc@878 1295 string "}",
adamc@878 1296 newline,
adamc@878 1297 string "conn->p",
adamc@878 1298 string (Int.toString id),
adamc@878 1299 string " = stmt;",
adamc@878 1300 newline],
adamc@878 1301 string "}",
adamc@878 1302 newline,
adamc@878 1303 newline,
adamc@878 1304
adamc@875 1305 string "memset(in, 0, sizeof in);",
adamc@875 1306 newline,
adamc@875 1307 p_list_sepi (box []) (fn i => fn t =>
adamc@875 1308 let
adamc@875 1309 fun buffers t =
adamc@875 1310 case t of
adamc@875 1311 String => box [string "in[",
adamc@875 1312 string (Int.toString i),
adamc@875 1313 string "].buffer = arg",
adamc@875 1314 string (Int.toString (i + 1)),
adamc@875 1315 string ";",
adamc@875 1316 newline,
adamc@875 1317 string "in_length",
adamc@875 1318 string (Int.toString i),
adamc@875 1319 string "= in[",
adamc@875 1320 string (Int.toString i),
adamc@875 1321 string "].buffer_length = strlen(arg",
adamc@875 1322 string (Int.toString (i + 1)),
adamc@875 1323 string ");",
adamc@875 1324 newline,
adamc@875 1325 string "in[",
adamc@875 1326 string (Int.toString i),
adamc@875 1327 string "].length = &in_length",
adamc@875 1328 string (Int.toString i),
adamc@875 1329 string ";",
adamc@875 1330 newline]
adamc@875 1331 | Blob => box [string "in[",
adamc@875 1332 string (Int.toString i),
adamc@875 1333 string "].buffer = arg",
adamc@875 1334 string (Int.toString (i + 1)),
adamc@875 1335 string ".data;",
adamc@875 1336 newline,
adamc@875 1337 string "in_length",
adamc@875 1338 string (Int.toString i),
adamc@875 1339 string "= in[",
adamc@875 1340 string (Int.toString i),
adamc@875 1341 string "].buffer_length = arg",
adamc@875 1342 string (Int.toString (i + 1)),
adamc@875 1343 string ".size;",
adamc@875 1344 newline,
adamc@875 1345 string "in[",
adamc@875 1346 string (Int.toString i),
adamc@875 1347 string "].length = &in_length",
adamc@875 1348 string (Int.toString i),
adamc@875 1349 string ";",
adamc@875 1350 newline]
adamc@875 1351 | Time =>
adamc@875 1352 let
adamc@875 1353 fun oneField dst src =
adamc@875 1354 box [string "in_buffer",
adamc@875 1355 string (Int.toString i),
adamc@875 1356 string ".",
adamc@875 1357 string dst,
adamc@875 1358 string " = tms.tm_",
adamc@875 1359 string src,
adamc@875 1360 string ";",
adamc@875 1361 newline]
adamc@875 1362 in
adamc@875 1363 box [string "({",
adamc@875 1364 newline,
adamc@875 1365 string "struct tm tms;",
adamc@875 1366 newline,
adamc@875 1367 string "if (localtime_r(&arg",
adamc@875 1368 string (Int.toString (i + 1)),
adamc@933 1369 string ", &tms) == NULL) uw_error(ctx, FATAL, \"",
adamc@875 1370 string (ErrorMsg.spanToString loc),
adamc@875 1371 string ": error converting to MySQL time\");",
adamc@875 1372 newline,
adamc@938 1373 oneField "year" "year + 1900",
adamc@938 1374 oneField "month" "mon + 1",
adamc@875 1375 oneField "day" "mday",
adamc@938 1376 oneField "hour" "hour - 1",
adamc@875 1377 oneField "minute" "min",
adamc@875 1378 oneField "second" "sec",
adamc@875 1379 newline,
adamc@875 1380 string "in[",
adamc@875 1381 string (Int.toString i),
adamc@875 1382 string "].buffer = &in_buffer",
adamc@875 1383 string (Int.toString i),
adamc@875 1384 string ";",
adamc@933 1385 newline,
adamc@933 1386 string "});",
adamc@875 1387 newline]
adamc@875 1388 end
adamc@889 1389 | Channel => box [string "in_buffer",
adamc@889 1390 string (Int.toString i),
adamc@889 1391 string " = ((unsigned long long)arg",
adamc@889 1392 string (Int.toString (i + 1)),
adamc@889 1393 string ".cli << 32) | arg",
adamc@889 1394 string (Int.toString (i + 1)),
adamc@889 1395 string ".chn;",
adamc@889 1396 newline,
adamc@889 1397 string "in[",
adamc@889 1398 string (Int.toString i),
adamc@889 1399 string "].buffer = &in_buffer",
adamc@889 1400 string (Int.toString i),
adamc@889 1401 string ";",
adamc@889 1402 newline]
adamc@875 1403
adamc@875 1404 | _ => box [string "in[",
adamc@875 1405 string (Int.toString i),
adamc@875 1406 string "].buffer = &arg",
adamc@875 1407 string (Int.toString (i + 1)),
adamc@875 1408 string ";",
adamc@875 1409 newline]
adamc@875 1410 in
adamc@875 1411 box [string "in[",
adamc@875 1412 string (Int.toString i),
adamc@875 1413 string "].buffer_type = ",
adamc@875 1414 string (p_buffer_type t),
adamc@875 1415 string ";",
adamc@875 1416 newline,
adamc@889 1417
adamc@889 1418 case t of
adamc@889 1419 Channel => box [string "in[",
adamc@889 1420 string (Int.toString i),
adamc@889 1421 string "].is_unsigned = 1;",
adamc@889 1422 newline]
adamc@889 1423 | _ => box [],
adamc@875 1424
adamc@875 1425 case t of
adamc@875 1426 Nullable t => box [string "in[",
adamc@875 1427 string (Int.toString i),
adamc@875 1428 string "].is_null = &in_is_null",
adamc@875 1429 string (Int.toString i),
adamc@875 1430 string ";",
adamc@875 1431 newline,
adamc@875 1432 string "if (arg",
adamc@875 1433 string (Int.toString (i + 1)),
adamc@875 1434 string " == NULL) {",
adamc@875 1435 newline,
adamc@875 1436 box [string "in_is_null",
adamc@875 1437 string (Int.toString i),
adamc@875 1438 string " = 1;",
adamc@875 1439 newline],
adamc@875 1440 string "} else {",
adamc@875 1441 box [case t of
adamc@875 1442 String => box []
adamc@875 1443 | _ =>
adamc@875 1444 box [string (p_sql_ctype t),
adamc@875 1445 space,
adamc@876 1446 string "tmp = *arg",
adamc@876 1447 string (Int.toString (i + 1)),
adamc@876 1448 string ";",
adamc@876 1449 newline,
adamc@876 1450 string (p_sql_ctype t),
adamc@876 1451 space,
adamc@875 1452 string "arg",
adamc@875 1453 string (Int.toString (i + 1)),
adamc@876 1454 string " = tmp;",
adamc@875 1455 newline],
adamc@875 1456 string "in_is_null",
adamc@875 1457 string (Int.toString i),
adamc@875 1458 string " = 0;",
adamc@875 1459 newline,
adamc@875 1460 buffers t,
adamc@876 1461 newline],
adamc@876 1462 string "}",
adamc@876 1463 newline]
adamc@875 1464
adamc@875 1465 | _ => buffers t,
adamc@875 1466 newline]
adamc@875 1467 end) inputs,
adamc@875 1468 newline,
adamc@875 1469
adamc@875 1470 string "if (mysql_stmt_bind_param(stmt, in)) uw_error(ctx, FATAL, \"",
adamc@875 1471 string (ErrorMsg.spanToString loc),
adamc@875 1472 string ": error binding parameters\");",
adamc@875 1473 newline,
adamc@875 1474
adamc@875 1475 dmlCommon {loc = loc, dml = box [string "\"",
adam@1285 1476 string (String.toCString dml),
adam@1293 1477 string "\""], mode = mode}]
adamc@875 1478
adamc@878 1479 fun nextval {loc, seqE, seqName} =
adamc@878 1480 box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@878 1481 newline,
adamc@878 1482 string "char *insert = ",
adamc@878 1483 case seqName of
adamc@878 1484 SOME s => string ("\"INSERT INTO " ^ s ^ " VALUES ()\"")
adamc@878 1485 | NONE => box [string "uw_Basis_strcat(ctx, \"INSERT INTO \", uw_Basis_strcat(ctx, ",
adamc@878 1486 seqE,
adamc@878 1487 string ", \" VALUES ()\"))"],
adamc@878 1488 string ";",
adamc@878 1489 newline,
adamc@878 1490 string "char *delete = ",
adamc@878 1491 case seqName of
adamc@878 1492 SOME s => string ("\"DELETE FROM " ^ s ^ "\"")
adamc@878 1493 | NONE => box [string "uw_Basis_strcat(ctx, \"DELETE FROM \", ",
adamc@878 1494 seqE,
adamc@878 1495 string ")"],
adamc@878 1496 string ";",
adamc@878 1497 newline,
adamc@878 1498 newline,
adamc@878 1499
adamc@878 1500 string "if (mysql_query(conn->conn, insert)) uw_error(ctx, FATAL, \"'nextval' INSERT failed\");",
adamc@878 1501 newline,
adamc@878 1502 string "n = mysql_insert_id(conn->conn);",
adamc@878 1503 newline,
adamc@878 1504 string "if (mysql_query(conn->conn, delete)) uw_error(ctx, FATAL, \"'nextval' DELETE failed\");",
adamc@878 1505 newline]
adamc@878 1506
adamc@878 1507 fun nextvalPrepared _ = raise Fail "MySQL.nextvalPrepared called"
adamc@867 1508
adamc@1073 1509 fun setval _ = raise Fail "MySQL.setval called"
adamc@1073 1510
adamc@877 1511 fun sqlifyString s = "'" ^ String.translate (fn #"'" => "\\'"
adamc@877 1512 | #"\\" => "\\\\"
adamc@877 1513 | ch =>
adamc@877 1514 if Char.isPrint ch then
adamc@877 1515 str ch
adamc@877 1516 else
adamc@877 1517 (ErrorMsg.error
adamc@877 1518 "Non-printing character found in SQL string literal";
adamc@877 1519 ""))
adam@1285 1520 (String.toCString s) ^ "'"
adamc@874 1521
adamc@877 1522 fun p_cast (s, _) = s
adamc@874 1523
adamc@874 1524 fun p_blank _ = "?"
adamc@874 1525
adamc@866 1526 val () = addDbms {name = "mysql",
adamc@866 1527 header = "mysql/mysql.h",
adamc@866 1528 link = "-lmysqlclient",
adamc@867 1529 init = init,
adamc@873 1530 p_sql_type = p_sql_type,
adamc@867 1531 query = query,
adamc@868 1532 queryPrepared = queryPrepared,
adamc@868 1533 dml = dml,
adamc@869 1534 dmlPrepared = dmlPrepared,
adamc@869 1535 nextval = nextval,
adamc@874 1536 nextvalPrepared = nextvalPrepared,
adamc@1073 1537 setval = setval,
adamc@874 1538 sqlifyString = sqlifyString,
adamc@874 1539 p_cast = p_cast,
adamc@874 1540 p_blank = p_blank,
adamc@877 1541 supportsDeleteAs = false,
adamc@886 1542 supportsUpdateAs = false,
adamc@884 1543 createSequence = fn s => "CREATE TABLE " ^ s ^ " (uw_id INTEGER PRIMARY KEY AUTO_INCREMENT)",
adamc@878 1544 textKeysNeedLengths = true,
adamc@879 1545 supportsNextval = false,
adamc@882 1546 supportsNestedPrepared = false,
adamc@890 1547 sqlPrefix = "SET storage_engine=InnoDB;\n\n",
adamc@1014 1548 supportsOctetLength = true,
adamc@1014 1549 trueString = "TRUE",
adamc@1196 1550 falseString = "FALSE",
adamc@1196 1551 onlyUnion = true,
adamc@1196 1552 nestedRelops = false}
adamc@866 1553
adamc@866 1554 end