Mercurial > urweb

annotate src/mysql.sml @ 873:41971801b62d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
MySQL query gets up to C linking
author Adam Chlipala <adamc@hcoop.net>
date Sun, 12 Jul 2009 13:16:05 -0400
parents 9654bce27cff
children 3c7b48040dcf
rev   line source
adamc@866 1 (* Copyright (c) 2008-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@872 58 fun init {dbstring, prepared = ss, tables, views, sequences} =
adamc@866 59 let
adamc@866 60 val host = ref NONE
adamc@866 61 val user = ref NONE
adamc@866 62 val passwd = ref NONE
adamc@866 63 val db = ref NONE
adamc@866 64 val port = ref NONE
adamc@866 65 val unix_socket = ref NONE
adamc@866 66
adamc@866 67 fun stringOf r = case !r of
adamc@866 68 NONE => string "NULL"
adamc@866 69 | SOME s => box [string "\"",
adamc@866 70 string (String.toString s),
adamc@866 71 string "\""]
adamc@866 72 in
adamc@866 73 app (fn s =>
adamc@866 74 case String.fields (fn ch => ch = #"=") s of
adamc@866 75 [name, value] =>
adamc@866 76 (case name of
adamc@866 77 "host" =>
adamc@866 78 if size value > 0 andalso String.sub (value, 0) = #"/" then
adamc@866 79 unix_socket := SOME value
adamc@866 80 else
adamc@866 81 host := SOME value
adamc@866 82 | "hostaddr" => host := SOME value
adamc@866 83 | "port" => port := Int.fromString value
adamc@866 84 | "dbname" => db := SOME value
adamc@866 85 | "user" => user := SOME value
adamc@866 86 | "password" => passwd := SOME value
adamc@866 87 | _ => ())
adamc@866 88 | _ => ()) (String.tokens Char.isSpace dbstring);
adamc@866 89
adamc@866 90 box [string "typedef struct {",
adamc@866 91 newline,
adamc@866 92 box [string "MYSQL *conn;",
adamc@866 93 newline,
adamc@866 94 p_list_sepi (box [])
adamc@866 95 (fn i => fn _ =>
adamc@866 96 box [string "MYSQL_STMT *p",
adamc@866 97 string (Int.toString i),
adamc@866 98 string ";",
adamc@866 99 newline])
adamc@866 100 ss],
adamc@866 101 string "} uw_conn;",
adamc@866 102 newline,
adamc@866 103 newline,
adamc@866 104
adamc@866 105 if #persistent (currentProtocol ()) then
adamc@866 106 box [string "static void uw_db_prepare(uw_context ctx) {",
adamc@866 107 newline,
adamc@866 108 string "uw_conn *conn = uw_get_db(ctx);",
adamc@866 109 newline,
adamc@866 110 string "MYSQL_STMT *stmt;",
adamc@866 111 newline,
adamc@866 112 newline,
adamc@866 113
adamc@866 114 p_list_sepi newline (fn i => fn (s, n) =>
adamc@866 115 let
adamc@866 116 fun uhoh this s args =
adamc@866 117 box [p_list_sepi (box [])
adamc@866 118 (fn j => fn () =>
adamc@866 119 box [string
adamc@866 120 "mysql_stmt_close(conn->p",
adamc@866 121 string (Int.toString j),
adamc@866 122 string ");",
adamc@866 123 newline])
adamc@866 124 (List.tabulate (i, fn _ => ())),
adamc@866 125 box (if this then
adamc@866 126 [string
adamc@866 127 "mysql_stmt_close(conn->p",
adamc@866 128 string (Int.toString i),
adamc@866 129 string ");",
adamc@866 130 newline]
adamc@866 131 else
adamc@866 132 []),
adamc@866 133 string "mysql_close(conn->conn);",
adamc@866 134 newline,
adamc@866 135 string "uw_error(ctx, FATAL, \"",
adamc@866 136 string s,
adamc@866 137 string "\"",
adamc@866 138 p_list_sep (box []) (fn s => box [string ", ",
adamc@866 139 string s]) args,
adamc@866 140 string ");",
adamc@866 141 newline]
adamc@866 142 in
adamc@866 143 box [string "stmt = mysql_stmt_init(conn->conn);",
adamc@866 144 newline,
adamc@866 145 string "if (stmt == NULL) {",
adamc@866 146 newline,
adamc@866 147 uhoh false "Out of memory allocating prepared statement" [],
adamc@866 148 string "}",
adamc@866 149 newline,
adamc@866 150
adamc@866 151 string "if (mysql_stmt_prepare(stmt, \"",
adamc@866 152 string (String.toString s),
adamc@866 153 string "\", ",
adamc@866 154 string (Int.toString (size s)),
adamc@866 155 string ")) {",
adamc@866 156 newline,
adamc@866 157 box [string "char msg[1024];",
adamc@866 158 newline,
adamc@866 159 string "strncpy(msg, mysql_stmt_error(stmt), 1024);",
adamc@866 160 newline,
adamc@866 161 string "msg[1023] = 0;",
adamc@866 162 newline,
adamc@866 163 uhoh true "Error preparing statement: %s" ["msg"]],
adamc@866 164 string "}",
adamc@873 165 newline,
adamc@873 166 string "conn->p",
adamc@873 167 string (Int.toString i),
adamc@873 168 string " = stmt;",
adamc@866 169 newline]
adamc@866 170 end)
adamc@866 171 ss,
adamc@866 172
adamc@866 173 string "}"]
adamc@866 174 else
adamc@866 175 string "static void uw_db_prepare(uw_context ctx) { }",
adamc@866 176 newline,
adamc@866 177 newline,
adamc@866 178
adamc@866 179 string "void uw_db_init(uw_context ctx) {",
adamc@866 180 newline,
adamc@866 181 string "MYSQL *mysql = mysql_init(NULL);",
adamc@866 182 newline,
adamc@866 183 string "uw_conn *conn;",
adamc@866 184 newline,
adamc@866 185 string "if (mysql == NULL) uw_error(ctx, FATAL, ",
adamc@866 186 string "\"libmysqlclient can't allocate a connection.\");",
adamc@866 187 newline,
adamc@866 188 string "if (mysql_real_connect(mysql, ",
adamc@866 189 stringOf host,
adamc@866 190 string ", ",
adamc@866 191 stringOf user,
adamc@866 192 string ", ",
adamc@866 193 stringOf passwd,
adamc@866 194 string ", ",
adamc@866 195 stringOf db,
adamc@866 196 string ", ",
adamc@866 197 case !port of
adamc@866 198 NONE => string "0"
adamc@866 199 | SOME n => string (Int.toString n),
adamc@866 200 string ", ",
adamc@866 201 stringOf unix_socket,
adamc@866 202 string ", 0)) {",
adamc@866 203 newline,
adamc@866 204 box [string "char msg[1024];",
adamc@866 205 newline,
adamc@866 206 string "strncpy(msg, mysql_error(mysql), 1024);",
adamc@866 207 newline,
adamc@866 208 string "msg[1023] = 0;",
adamc@866 209 newline,
adamc@866 210 string "mysql_close(mysql);",
adamc@866 211 newline,
adamc@866 212 string "uw_error(ctx, BOUNDED_RETRY, ",
adamc@866 213 string "\"Connection to MySQL server failed: %s\", msg);"],
adamc@866 214 newline,
adamc@866 215 string "}",
adamc@866 216 newline,
adamc@867 217 string "conn = calloc(1, sizeof(conn));",
adamc@866 218 newline,
adamc@866 219 string "conn->conn = mysql;",
adamc@866 220 newline,
adamc@866 221 string "uw_set_db(ctx, conn);",
adamc@866 222 newline,
adamc@866 223 string "uw_db_validate(ctx);",
adamc@866 224 newline,
adamc@866 225 string "uw_db_prepare(ctx);",
adamc@866 226 newline,
adamc@866 227 string "}",
adamc@866 228 newline,
adamc@866 229 newline,
adamc@866 230
adamc@866 231 string "void uw_db_close(uw_context ctx) {",
adamc@866 232 newline,
adamc@866 233 string "uw_conn *conn = uw_get_db(ctx);",
adamc@866 234 newline,
adamc@866 235 p_list_sepi (box [])
adamc@866 236 (fn i => fn _ =>
adamc@866 237 box [string "if (conn->p",
adamc@866 238 string (Int.toString i),
adamc@866 239 string ") mysql_stmt_close(conn->p",
adamc@866 240 string (Int.toString i),
adamc@866 241 string ");",
adamc@866 242 newline])
adamc@866 243 ss,
adamc@866 244 string "mysql_close(conn->conn);",
adamc@866 245 newline,
adamc@866 246 string "}",
adamc@866 247 newline,
adamc@866 248 newline,
adamc@866 249
adamc@866 250 string "int uw_db_begin(uw_context ctx) {",
adamc@866 251 newline,
adamc@866 252 string "uw_conn *conn = uw_get_db(ctx);",
adamc@866 253 newline,
adamc@866 254 newline,
adamc@866 255 string "return mysql_query(conn->conn, \"SET TRANSACTION ISOLATION LEVEL SERIALIZABLE\")",
adamc@866 256 newline,
adamc@866 257 string " || mysql_query(conn->conn, \"BEGIN\");",
adamc@866 258 newline,
adamc@866 259 string "}",
adamc@866 260 newline,
adamc@866 261 newline,
adamc@866 262
adamc@866 263 string "int uw_db_commit(uw_context ctx) {",
adamc@866 264 newline,
adamc@866 265 string "uw_conn *conn = uw_get_db(ctx);",
adamc@866 266 newline,
adamc@866 267 string "return mysql_commit(conn->conn);",
adamc@866 268 newline,
adamc@866 269 string "}",
adamc@866 270 newline,
adamc@866 271 newline,
adamc@866 272
adamc@866 273 string "int uw_db_rollback(uw_context ctx) {",
adamc@866 274 newline,
adamc@866 275 string "uw_conn *conn = uw_get_db(ctx);",
adamc@866 276 newline,
adamc@866 277 string "return mysql_rollback(conn->conn);",
adamc@866 278 newline,
adamc@866 279 string "}",
adamc@866 280 newline,
adamc@866 281 newline]
adamc@866 282 end
adamc@866 283
adamc@873 284 fun p_getcol {wontLeakStrings = _, col = i, typ = t} =
adamc@873 285 let
adamc@873 286 fun getter t =
adamc@873 287 case t of
adamc@873 288 String => box [string "({",
adamc@873 289 newline,
adamc@873 290 string "uw_Basis_string s = uw_malloc(ctx, length",
adamc@873 291 string (Int.toString i),
adamc@873 292 string " + 1);",
adamc@873 293 newline,
adamc@873 294 string "out[",
adamc@873 295 string (Int.toString i),
adamc@873 296 string "].buffer = s;",
adamc@873 297 newline,
adamc@873 298 string "out[",
adamc@873 299 string (Int.toString i),
adamc@873 300 string "].buffer_length = length",
adamc@873 301 string (Int.toString i),
adamc@873 302 string " + 1;",
adamc@873 303 newline,
adamc@873 304 string "mysql_stmt_fetch_column(stmt, &out[",
adamc@873 305 string (Int.toString i),
adamc@873 306 string "], ",
adamc@873 307 string (Int.toString i),
adamc@873 308 string ", 0);",
adamc@873 309 newline,
adamc@873 310 string "s[length",
adamc@873 311 string (Int.toString i),
adamc@873 312 string "] = 0;",
adamc@873 313 newline,
adamc@873 314 string "s;",
adamc@873 315 newline,
adamc@873 316 string "})"]
adamc@873 317 | Blob => box [string "({",
adamc@873 318 newline,
adamc@873 319 string "uw_Basis_blob b = {length",
adamc@873 320 string (Int.toString i),
adamc@873 321 string ", uw_malloc(ctx, length",
adamc@873 322 string (Int.toString i),
adamc@873 323 string ")};",
adamc@873 324 newline,
adamc@873 325 string "out[",
adamc@873 326 string (Int.toString i),
adamc@873 327 string "].buffer = b.data;",
adamc@873 328 newline,
adamc@873 329 string "out[",
adamc@873 330 string (Int.toString i),
adamc@873 331 string "].buffer_length = length",
adamc@873 332 string (Int.toString i),
adamc@873 333 string ";",
adamc@873 334 newline,
adamc@873 335 string "mysql_stmt_fetch_column(stmt, &out[",
adamc@873 336 string (Int.toString i),
adamc@873 337 string "], ",
adamc@873 338 string (Int.toString i),
adamc@873 339 string ", 0);",
adamc@873 340 newline,
adamc@873 341 string "b;",
adamc@873 342 newline,
adamc@873 343 string "})"]
adamc@873 344 | Time => box [string "({",
adamc@873 345 string "MYSQL_TIME *mt = buffer",
adamc@873 346 string (Int.toString i),
adamc@873 347 string ";",
adamc@873 348 newline,
adamc@873 349 newline,
adamc@873 350 string "struct tm t = {mt->second, mt->minute, mt->hour, mt->day, mt->month, mt->year, 0, 0, -1};",
adamc@873 351 newline,
adamc@873 352 string "mktime(&tm);",
adamc@873 353 newline,
adamc@873 354 string "})"]
adamc@873 355 | _ => box [string "buffer",
adamc@873 356 string (Int.toString i)]
adamc@873 357 in
adamc@873 358 case t of
adamc@873 359 Nullable t => box [string "(is_null",
adamc@873 360 string (Int.toString i),
adamc@873 361 string " ? NULL : ",
adamc@873 362 case t of
adamc@873 363 String => getter t
adamc@873 364 | _ => box [string "({",
adamc@873 365 newline,
adamc@873 366 string (p_sql_ctype t),
adamc@873 367 space,
adamc@873 368 string "*tmp = uw_malloc(ctx, sizeof(",
adamc@873 369 string (p_sql_ctype t),
adamc@873 370 string "));",
adamc@873 371 newline,
adamc@873 372 string "*tmp = ",
adamc@873 373 getter t,
adamc@873 374 string ";",
adamc@873 375 newline,
adamc@873 376 string "tmp;",
adamc@873 377 newline,
adamc@873 378 string "})"],
adamc@873 379 string ")"]
adamc@873 380 | _ => box [string "(is_null",
adamc@873 381 string (Int.toString i),
adamc@873 382 string " ? ",
adamc@873 383 box [string "({",
adamc@873 384 string (p_sql_ctype t),
adamc@873 385 space,
adamc@873 386 string "tmp;",
adamc@873 387 newline,
adamc@873 388 string "uw_error(ctx, FATAL, \"Unexpectedly NULL field #",
adamc@873 389 string (Int.toString i),
adamc@873 390 string "\");",
adamc@873 391 newline,
adamc@873 392 string "tmp;",
adamc@873 393 newline,
adamc@873 394 string "})"],
adamc@873 395 string " : ",
adamc@873 396 getter t,
adamc@873 397 string ")"]
adamc@873 398 end
adamc@873 399
adamc@873 400 fun queryCommon {loc, query, cols, doCols} =
adamc@873 401 box [string "int n, r;",
adamc@873 402 newline,
adamc@873 403 string "MYSQL_BIND out[",
adamc@873 404 string (Int.toString (length cols)),
adamc@873 405 string "];",
adamc@873 406 newline,
adamc@873 407 p_list_sepi (box []) (fn i => fn t =>
adamc@873 408 let
adamc@873 409 fun buffers t =
adamc@873 410 case t of
adamc@873 411 String => box [string "unsigned long length",
adamc@873 412 string (Int.toString i),
adamc@873 413 string ";",
adamc@873 414 newline]
adamc@873 415 | Blob => box [string "unsigned long length",
adamc@873 416 string (Int.toString i),
adamc@873 417 string ";",
adamc@873 418 newline]
adamc@873 419 | _ => box [string (p_sql_ctype t),
adamc@873 420 space,
adamc@873 421 string "buffer",
adamc@873 422 string (Int.toString i),
adamc@873 423 string ";",
adamc@873 424 newline]
adamc@873 425 in
adamc@873 426 box [string "my_bool is_null",
adamc@873 427 string (Int.toString i),
adamc@873 428 string ";",
adamc@873 429 newline,
adamc@873 430 case t of
adamc@873 431 Nullable t => buffers t
adamc@873 432 | _ => buffers t,
adamc@873 433 newline]
adamc@873 434 end) cols,
adamc@873 435 newline,
adamc@873 436
adamc@873 437 string "memset(out, 0, sizeof out);",
adamc@873 438 newline,
adamc@873 439 p_list_sepi (box []) (fn i => fn t =>
adamc@873 440 let
adamc@873 441 fun buffers t =
adamc@873 442 case t of
adamc@873 443 String => box []
adamc@873 444 | Blob => box []
adamc@873 445 | _ => box [string "out[",
adamc@873 446 string (Int.toString i),
adamc@873 447 string "].buffer = &buffer",
adamc@873 448 string (Int.toString i),
adamc@873 449 string ";",
adamc@873 450 newline]
adamc@873 451 in
adamc@873 452 box [string "out[",
adamc@873 453 string (Int.toString i),
adamc@873 454 string "].buffer_type = ",
adamc@873 455 string (p_buffer_type t),
adamc@873 456 string ";",
adamc@873 457 newline,
adamc@873 458 string "out[",
adamc@873 459 string (Int.toString i),
adamc@873 460 string "].is_null = &is_null",
adamc@873 461 string (Int.toString i),
adamc@873 462 string ";",
adamc@873 463 newline,
adamc@873 464
adamc@873 465 case t of
adamc@873 466 Nullable t => buffers t
adamc@873 467 | _ => buffers t,
adamc@873 468 newline]
adamc@873 469 end) cols,
adamc@873 470 newline,
adamc@873 471
adamc@873 472 string "if (mysql_stmt_execute(stmt)) uw_error(ctx, FATAL, \"",
adamc@873 473 string (ErrorMsg.spanToString loc),
adamc@873 474 string ": Error executing query\");",
adamc@873 475 newline,
adamc@873 476 newline,
adamc@873 477
adamc@873 478 string "if (mysql_stmt_store_result(stmt)) uw_error(ctx, FATAL, \"",
adamc@873 479 string (ErrorMsg.spanToString loc),
adamc@873 480 string ": Error storing query result\");",
adamc@873 481 newline,
adamc@873 482 newline,
adamc@873 483
adamc@873 484 string "if (mysql_stmt_bind_result(stmt, out)) uw_error(ctx, FATAL, \"",
adamc@873 485 string (ErrorMsg.spanToString loc),
adamc@873 486 string ": Error binding query result\");",
adamc@873 487 newline,
adamc@873 488 newline,
adamc@873 489
adamc@873 490 string "uw_end_region(ctx);",
adamc@873 491 newline,
adamc@873 492 string "while ((r = mysql_stmt_fetch(stmt)) == 0) {",
adamc@873 493 newline,
adamc@873 494 doCols p_getcol,
adamc@873 495 string "}",
adamc@873 496 newline,
adamc@873 497 newline,
adamc@873 498
adamc@873 499 string "if (r != MYSQL_NO_DATA) uw_error(ctx, FATAL, \"",
adamc@873 500 string (ErrorMsg.spanToString loc),
adamc@873 501 string ": query result fetching failed\");",
adamc@873 502 newline]
adamc@873 503
adamc@873 504 fun query {loc, cols, doCols} =
adamc@873 505 box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@873 506 newline,
adamc@873 507 string "MYSQL_stmt *stmt = mysql_stmt_init(conn->conn);",
adamc@873 508 newline,
adamc@873 509 string "if (stmt == NULL) uw_error(ctx, \"",
adamc@873 510 string (ErrorMsg.spanToString loc),
adamc@873 511 string ": can't allocate temporary prepared statement\");",
adamc@873 512 newline,
adamc@873 513 string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);",
adamc@873 514 newline,
adamc@873 515 string "if (mysql_stmt_prepare(stmt, query, strlen(query))) uw_error(ctx, FATAL, \"",
adamc@873 516 string (ErrorMsg.spanToString loc),
adamc@873 517 string "\");",
adamc@873 518 newline,
adamc@873 519 newline,
adamc@873 520
adamc@873 521 p_list_sepi (box []) (fn i => fn t =>
adamc@873 522 let
adamc@873 523 fun buffers t =
adamc@873 524 case t of
adamc@873 525 String => box []
adamc@873 526 | Blob => box []
adamc@873 527 | _ => box [string "out[",
adamc@873 528 string (Int.toString i),
adamc@873 529 string "].buffer = &buffer",
adamc@873 530 string (Int.toString i),
adamc@873 531 string ";",
adamc@873 532 newline]
adamc@873 533 in
adamc@873 534 box [string "in[",
adamc@873 535 string (Int.toString i),
adamc@873 536 string "].buffer_type = ",
adamc@873 537 string (p_buffer_type t),
adamc@873 538 string ";",
adamc@873 539 newline,
adamc@873 540
adamc@873 541 case t of
adamc@873 542 Nullable t => box [string "in[",
adamc@873 543 string (Int.toString i),
adamc@873 544 string "].is_null = &is_null",
adamc@873 545 string (Int.toString i),
adamc@873 546 string ";",
adamc@873 547 newline,
adamc@873 548 buffers t]
adamc@873 549 | _ => buffers t,
adamc@873 550 newline]
adamc@873 551 end) cols,
adamc@873 552 newline,
adamc@873 553
adamc@873 554 queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"},
adamc@873 555
adamc@873 556 string "uw_pop_cleanup(ctx);",
adamc@873 557 newline]
adamc@873 558
adamc@873 559 fun p_ensql t e =
adamc@873 560 case t of
adamc@873 561 Int => box [string "uw_Basis_attrifyInt(ctx, ", e, string ")"]
adamc@873 562 | Float => box [string "uw_Basis_attrifyFloat(ctx, ", e, string ")"]
adamc@873 563 | String => e
adamc@873 564 | Bool => box [string "(", e, string " ? \"TRUE\" : \"FALSE\")"]
adamc@873 565 | Time => box [string "uw_Basis_attrifyTime(ctx, ", e, string ")"]
adamc@873 566 | Blob => box [e, string ".data"]
adamc@873 567 | Channel => box [string "uw_Basis_attrifyChannel(ctx, ", e, string ")"]
adamc@873 568 | Client => box [string "uw_Basis_attrifyClient(ctx, ", e, string ")"]
adamc@873 569 | Nullable String => e
adamc@873 570 | Nullable t => box [string "(",
adamc@873 571 e,
adamc@873 572 string " == NULL ? NULL : ",
adamc@873 573 p_ensql t (box [string "(*", e, string ")"]),
adamc@873 574 string ")"]
adamc@873 575
adamc@873 576 fun queryPrepared {loc, id, query, inputs, cols, doCols} =
adamc@873 577 box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@873 578 newline,
adamc@873 579 string "MYSQL_BIND in[",
adamc@873 580 string (Int.toString (length inputs)),
adamc@873 581 string "];",
adamc@873 582 newline,
adamc@873 583 p_list_sepi (box []) (fn i => fn t =>
adamc@873 584 let
adamc@873 585 fun buffers t =
adamc@873 586 case t of
adamc@873 587 String => box [string "unsigned long in_length",
adamc@873 588 string (Int.toString i),
adamc@873 589 string ";",
adamc@873 590 newline]
adamc@873 591 | Blob => box [string "unsigned long in_length",
adamc@873 592 string (Int.toString i),
adamc@873 593 string ";",
adamc@873 594 newline]
adamc@873 595 | Time => box [string (p_sql_ctype t),
adamc@873 596 space,
adamc@873 597 string "in_buffer",
adamc@873 598 string (Int.toString i),
adamc@873 599 string ";",
adamc@873 600 newline]
adamc@873 601 | _ => box []
adamc@873 602 in
adamc@873 603 box [case t of
adamc@873 604 Nullable t => box [string "my_bool in_is_null",
adamc@873 605 string (Int.toString i),
adamc@873 606 string ";",
adamc@873 607 newline,
adamc@873 608 buffers t]
adamc@873 609 | _ => buffers t,
adamc@873 610 newline]
adamc@873 611 end) inputs,
adamc@873 612 string "MYSQL_STMT *stmt = conn->p",
adamc@873 613 string (Int.toString id),
adamc@873 614 string ";",
adamc@873 615 newline,
adamc@873 616 newline,
adamc@873 617
adamc@873 618 string "memset(in, 0, sizeof in);",
adamc@873 619 newline,
adamc@873 620 p_list_sepi (box []) (fn i => fn t =>
adamc@873 621 let
adamc@873 622 fun buffers t =
adamc@873 623 case t of
adamc@873 624 String => box [string "in[",
adamc@873 625 string (Int.toString i),
adamc@873 626 string "].buffer = arg",
adamc@873 627 string (Int.toString (i + 1)),
adamc@873 628 string ";",
adamc@873 629 newline,
adamc@873 630 string "in_length",
adamc@873 631 string (Int.toString i),
adamc@873 632 string "= in[",
adamc@873 633 string (Int.toString i),
adamc@873 634 string "].buffer_length = strlen(arg",
adamc@873 635 string (Int.toString (i + 1)),
adamc@873 636 string ");",
adamc@873 637 newline,
adamc@873 638 string "in[",
adamc@873 639 string (Int.toString i),
adamc@873 640 string "].length = &in_length",
adamc@873 641 string (Int.toString i),
adamc@873 642 string ";",
adamc@873 643 newline]
adamc@873 644 | Blob => box [string "in[",
adamc@873 645 string (Int.toString i),
adamc@873 646 string "].buffer = arg",
adamc@873 647 string (Int.toString (i + 1)),
adamc@873 648 string ".data;",
adamc@873 649 newline,
adamc@873 650 string "in_length",
adamc@873 651 string (Int.toString i),
adamc@873 652 string "= in[",
adamc@873 653 string (Int.toString i),
adamc@873 654 string "].buffer_length = arg",
adamc@873 655 string (Int.toString (i + 1)),
adamc@873 656 string ".size;",
adamc@873 657 newline,
adamc@873 658 string "in[",
adamc@873 659 string (Int.toString i),
adamc@873 660 string "].length = &in_length",
adamc@873 661 string (Int.toString i),
adamc@873 662 string ";",
adamc@873 663 newline]
adamc@873 664 | Time =>
adamc@873 665 let
adamc@873 666 fun oneField dst src =
adamc@873 667 box [string "in_buffer",
adamc@873 668 string (Int.toString i),
adamc@873 669 string ".",
adamc@873 670 string dst,
adamc@873 671 string " = tms.tm_",
adamc@873 672 string src,
adamc@873 673 string ";",
adamc@873 674 newline]
adamc@873 675 in
adamc@873 676 box [string "({",
adamc@873 677 newline,
adamc@873 678 string "struct tm tms;",
adamc@873 679 newline,
adamc@873 680 string "if (localtime_r(&arg",
adamc@873 681 string (Int.toString (i + 1)),
adamc@873 682 string ", &tm) == NULL) uw_error(\"",
adamc@873 683 string (ErrorMsg.spanToString loc),
adamc@873 684 string ": error converting to MySQL time\");",
adamc@873 685 newline,
adamc@873 686 oneField "year" "year",
adamc@873 687 oneField "month" "mon",
adamc@873 688 oneField "day" "mday",
adamc@873 689 oneField "hour" "hour",
adamc@873 690 oneField "minute" "min",
adamc@873 691 oneField "second" "sec",
adamc@873 692 newline,
adamc@873 693 string "in[",
adamc@873 694 string (Int.toString i),
adamc@873 695 string "].buffer = &in_buffer",
adamc@873 696 string (Int.toString i),
adamc@873 697 string ";",
adamc@873 698 newline]
adamc@873 699 end
adamc@873 700
adamc@873 701 | _ => box [string "in[",
adamc@873 702 string (Int.toString i),
adamc@873 703 string "].buffer = &arg",
adamc@873 704 string (Int.toString (i + 1)),
adamc@873 705 string ";",
adamc@873 706 newline]
adamc@873 707 in
adamc@873 708 box [string "in[",
adamc@873 709 string (Int.toString i),
adamc@873 710 string "].buffer_type = ",
adamc@873 711 string (p_buffer_type t),
adamc@873 712 string ";",
adamc@873 713 newline,
adamc@873 714
adamc@873 715 case t of
adamc@873 716 Nullable t => box [string "in[",
adamc@873 717 string (Int.toString i),
adamc@873 718 string "].is_null = &in_is_null",
adamc@873 719 string (Int.toString i),
adamc@873 720 string ";",
adamc@873 721 newline,
adamc@873 722 string "if (arg",
adamc@873 723 string (Int.toString (i + 1)),
adamc@873 724 string " == NULL) {",
adamc@873 725 newline,
adamc@873 726 box [string "in_is_null",
adamc@873 727 string (Int.toString i),
adamc@873 728 string " = 1;",
adamc@873 729 newline],
adamc@873 730 string "} else {",
adamc@873 731 box [case t of
adamc@873 732 String => box []
adamc@873 733 | _ =>
adamc@873 734 box [string (p_sql_ctype t),
adamc@873 735 space,
adamc@873 736 string "arg",
adamc@873 737 string (Int.toString (i + 1)),
adamc@873 738 string " = *arg",
adamc@873 739 string (Int.toString (i + 1)),
adamc@873 740 string ";",
adamc@873 741 newline],
adamc@873 742 string "in_is_null",
adamc@873 743 string (Int.toString i),
adamc@873 744 string " = 0;",
adamc@873 745 newline,
adamc@873 746 buffers t,
adamc@873 747 newline]]
adamc@873 748
adamc@873 749 | _ => buffers t,
adamc@873 750 newline]
adamc@873 751 end) inputs,
adamc@873 752 newline,
adamc@873 753
adamc@873 754 queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
adamc@873 755 string (String.toString query),
adamc@873 756 string "\""]}]
adamc@873 757
adamc@873 758 fun dml _ = box []
adamc@873 759 fun dmlPrepared _ = box []
adamc@873 760 fun nextval _ = box []
adamc@873 761 fun nextvalPrepared _ = box []
adamc@867 762
adamc@866 763 val () = addDbms {name = "mysql",
adamc@866 764 header = "mysql/mysql.h",
adamc@866 765 link = "-lmysqlclient",
adamc@866 766 global_init = box [string "void uw_client_init() {",
adamc@866 767 newline,
adamc@866 768 box [string "if (mysql_library_init(0, NULL, NULL)) {",
adamc@866 769 newline,
adamc@866 770 box [string "fprintf(stderr, \"Could not initialize MySQL library\\n\");",
adamc@866 771 newline,
adamc@866 772 string "exit(1);",
adamc@866 773 newline],
adamc@866 774 string "}",
adamc@866 775 newline],
adamc@866 776 string "}",
adamc@866 777 newline],
adamc@867 778 init = init,
adamc@873 779 p_sql_type = p_sql_type,
adamc@867 780 query = query,
adamc@868 781 queryPrepared = queryPrepared,
adamc@868 782 dml = dml,
adamc@869 783 dmlPrepared = dmlPrepared,
adamc@869 784 nextval = nextval,
adamc@869 785 nextvalPrepared = nextvalPrepared}
adamc@866 786
adamc@866 787 end