Mercurial > urweb

annotate src/mysql.sml @ 882:9c1b7e46eed2

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