Mercurial > urweb

annotate src/mysql.sml @ 1739:c414850f206f

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