Mercurial > urweb

annotate src/mysql.sml @ 1012:32dbb5636ae7

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