Mercurial > urweb

annotate src/mysql.sml @ 1007:d3af9e54c828

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