adam@1295: (* Copyright (c) 2009-2010, Adam Chlipala adamc@866: * All rights reserved. adamc@866: * adamc@866: * Redistribution and use in source and binary forms, with or without adamc@866: * modification, are permitted provided that the following conditions are met: adamc@866: * adamc@866: * - Redistributions of source code must retain the above copyright notice, adamc@866: * this list of conditions and the following disclaimer. adamc@866: * - Redistributions in binary form must reproduce the above copyright notice, adamc@866: * this list of conditions and the following disclaimer in the documentation adamc@866: * and/or other materials provided with the distribution. adamc@866: * - The names of contributors may not be used to endorse or promote products adamc@866: * derived from this software without specific prior written permission. adamc@866: * adamc@866: * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" adamc@866: * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE adamc@866: * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE adamc@866: * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE adam@1682: * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR adamc@866: * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF adamc@866: * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS adamc@866: * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN adamc@866: * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) adamc@866: * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE adamc@866: * POSSIBILITY OF SUCH DAMAGE. adamc@866: *) adamc@866: adamc@866: structure MySQL :> MYSQL = struct adamc@866: adamc@866: open Settings adamc@866: open Print.PD adamc@866: open Print adamc@866: adamc@873: fun p_sql_type t = adamc@873: case t of adamc@873: Int => "bigint" adamc@873: | Float => "double" adamc@873: | String => "longtext" adamc@1011: | Char => "char" adamc@873: | Bool => "bool" adamc@873: | Time => "timestamp" adamc@873: | Blob => "longblob" adamc@873: | Channel => "bigint" adamc@873: | Client => "int" adamc@873: | Nullable t => p_sql_type t adamc@873: adamc@873: fun p_buffer_type t = adamc@873: case t of adamc@873: Int => "MYSQL_TYPE_LONGLONG" adamc@873: | Float => "MYSQL_TYPE_DOUBLE" adamc@873: | String => "MYSQL_TYPE_STRING" adamc@1013: | Char => "MYSQL_TYPE_STRING" adamc@873: | Bool => "MYSQL_TYPE_LONG" adamc@938: | Time => "MYSQL_TYPE_TIMESTAMP" adamc@873: | Blob => "MYSQL_TYPE_BLOB" adamc@873: | Channel => "MYSQL_TYPE_LONGLONG" adamc@873: | Client => "MYSQL_TYPE_LONG" adamc@873: | Nullable t => p_buffer_type t adamc@873: adamc@874: fun p_sql_type_base t = adamc@874: case t of adamc@874: Int => "bigint" adamc@874: | Float => "double" adamc@874: | String => "longtext" adamc@1011: | Char => "char" adamc@874: | Bool => "tinyint" adamc@874: | Time => "timestamp" adamc@874: | Blob => "longblob" adamc@874: | Channel => "bigint" adamc@874: | Client => "int" adamc@874: | Nullable t => p_sql_type_base t adamc@874: adamc@874: val ident = String.translate (fn #"'" => "PRIME" adamc@874: | ch => str ch) adamc@874: adamc@874: fun checkRel (table, checkNullable) (s, xts) = adamc@874: let adamc@874: val sl = CharVector.map Char.toLower s adam@1953: val sl = if size sl > 1 andalso String.sub (sl, 0) = #"\"" then adam@1953: String.substring (sl, 1, size sl - 2) adam@1953: else adam@1953: sl adam@1953: val both = "LOWER(table_name) = ('" ^ sl ^ "')" adamc@874: adamc@998: val q = "SELECT COUNT(*) FROM information_schema." ^ table ^ " WHERE " ^ both adamc@874: adamc@998: val q' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE ", adamc@998: both, adamc@998: " AND (", adam@1600: case String.concatWith " OR " adam@1600: (map (fn (x, t) => adam@1953: String.concat ["(LOWER(column_name) = '", adam@1953: Settings.mangleSqlCatalog adam@1953: (CharVector.map adam@1953: Char.toLower (ident x)), adam@1953: "' AND data_type ", adam@1953: case p_sql_type_base t of adam@1953: "bigint" => adam@1953: "IN ('bigint', 'int')" adam@1953: | "longtext" => adam@1953: "IN ('longtext', 'varchar')" adam@1953: | s => "= '" ^ s ^ "'", adam@1600: if checkNullable then adam@1600: (" AND is_nullable = '" adam@1600: ^ (if isNotNull t then adam@1600: "NO" adam@1600: else adam@1600: "YES") adam@1600: ^ "'") adam@1600: else adam@1600: "", adam@1600: ")"]) xts) of adam@1600: "" => "FALSE" adam@1600: | s => s, adamc@874: ")"] adamc@874: adamc@998: val q'' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE ", adamc@998: both, adam@1953: " AND LOWER(column_name) LIKE '", Settings.mangleSqlCatalog "%'"] adamc@874: in adamc@874: box [string "if (mysql_query(conn->conn, \"", adamc@874: string q, adamc@874: string "\")) {", adamc@874: newline, adamc@874: box [string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Query failed:\\n", adamc@874: string q, adamc@874: string "\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if ((res = mysql_store_result(conn->conn)) == NULL) {", adamc@874: newline, adamc@874: box [string "mysql_free_result(res);", adamc@874: newline, adamc@874: string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Result store failed:\\n", adamc@874: string q, adamc@874: string "\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if (mysql_num_fields(res) != 1) {", adamc@874: newline, adamc@874: box [string "mysql_free_result(res);", adamc@874: newline, adamc@874: string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Bad column count:\\n", adamc@874: string q, adamc@874: string "\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if ((row = mysql_fetch_row(res)) == NULL) {", adamc@874: newline, adamc@874: box [string "mysql_free_result(res);", adamc@874: newline, adamc@874: string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Row fetch failed:\\n", adamc@874: string q, adamc@874: string "\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if (strcmp(row[0], \"1\")) {", adamc@874: newline, adamc@874: box [string "mysql_free_result(res);", adamc@874: newline, adamc@874: string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Table '", adam@1953: string sl, adamc@874: string "' does not exist.\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: string "mysql_free_result(res);", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if (mysql_query(conn->conn, \"", adamc@874: string q', adamc@874: string "\")) {", adamc@874: newline, adamc@874: box [string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Query failed:\\n", adamc@874: string q', adamc@874: string "\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if ((res = mysql_store_result(conn->conn)) == NULL) {", adamc@874: newline, adamc@874: box [string "mysql_free_result(res);", adamc@874: newline, adamc@874: string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Result store failed:\\n", adamc@874: string q', adamc@874: string "\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if (mysql_num_fields(res) != 1) {", adamc@874: newline, adamc@874: box [string "mysql_free_result(res);", adamc@874: newline, adamc@874: string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Bad column count:\\n", adamc@874: string q', adamc@874: string "\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if ((row = mysql_fetch_row(res)) == NULL) {", adamc@874: newline, adamc@874: box [string "mysql_free_result(res);", adamc@874: newline, adamc@874: string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Row fetch failed:\\n", adamc@874: string q', adamc@874: string "\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if (strcmp(row[0], \"", adamc@874: string (Int.toString (length xts)), adamc@874: string "\")) {", adamc@874: newline, adamc@874: box [string "mysql_free_result(res);", adamc@874: newline, adamc@874: string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Table '", adam@1953: string sl, adamc@874: string "' has the wrong column types.\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: string "mysql_free_result(res);", adamc@874: newline, adamc@874: newline, adam@1682: adamc@874: string "if (mysql_query(conn->conn, \"", adamc@874: string q'', adamc@874: string "\")) {", adamc@874: newline, adamc@874: box [string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Query failed:\\n", adamc@874: string q'', adamc@874: string "\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if ((res = mysql_store_result(conn->conn)) == NULL) {", adamc@874: newline, adamc@874: box [string "mysql_free_result(res);", adamc@874: newline, adamc@874: string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Result store failed:\\n", adamc@874: string q'', adamc@874: string "\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if (mysql_num_fields(res) != 1) {", adamc@874: newline, adamc@874: box [string "mysql_free_result(res);", adamc@874: newline, adamc@874: string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Bad column count:\\n", adamc@874: string q'', adamc@874: string "\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if ((row = mysql_fetch_row(res)) == NULL) {", adamc@874: newline, adamc@874: box [string "mysql_free_result(res);", adamc@874: newline, adamc@874: string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Row fetch failed:\\n", adamc@874: string q'', adamc@874: string "\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "if (strcmp(row[0], \"", adamc@874: string (Int.toString (length xts)), adamc@874: string "\")) {", adamc@874: newline, adamc@874: box [string "mysql_free_result(res);", adamc@874: newline, adamc@874: string "mysql_close(conn->conn);", adamc@874: newline, adamc@874: string "uw_error(ctx, FATAL, \"Table '", adam@1953: string sl, adamc@874: string "' has extra columns.\");", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: string "mysql_free_result(res);", adamc@874: newline] adamc@874: end adamc@874: adamc@872: fun init {dbstring, prepared = ss, tables, views, sequences} = adamc@866: let adamc@866: val host = ref NONE adamc@866: val user = ref NONE adamc@866: val passwd = ref NONE adamc@866: val db = ref NONE adamc@866: val port = ref NONE adamc@866: val unix_socket = ref NONE adamc@866: adamc@866: fun stringOf r = case !r of adamc@866: NONE => string "NULL" adamc@866: | SOME s => box [string "\"", adam@1656: string (Prim.toCString s), adamc@866: string "\""] adamc@866: in adamc@866: app (fn s => adamc@866: case String.fields (fn ch => ch = #"=") s of adamc@866: [name, value] => adamc@866: (case name of adamc@866: "host" => adamc@866: if size value > 0 andalso String.sub (value, 0) = #"/" then adamc@866: unix_socket := SOME value adamc@866: else adamc@866: host := SOME value adamc@866: | "hostaddr" => host := SOME value adamc@866: | "port" => port := Int.fromString value adamc@866: | "dbname" => db := SOME value adamc@866: | "user" => user := SOME value adamc@866: | "password" => passwd := SOME value adamc@866: | _ => ()) adamc@866: | _ => ()) (String.tokens Char.isSpace dbstring); adamc@866: adamc@866: box [string "typedef struct {", adamc@866: newline, adamc@866: box [string "MYSQL *conn;", adamc@866: newline, adamc@866: p_list_sepi (box []) adamc@866: (fn i => fn _ => adamc@866: box [string "MYSQL_STMT *p", adamc@866: string (Int.toString i), adamc@866: string ";", adamc@866: newline]) adamc@866: ss], adamc@866: string "} uw_conn;", adamc@866: newline, adamc@866: newline, adamc@866: adamc@1094: string "static void uw_client_init(void) {", adamc@874: newline, adamc@879: box [string "uw_sqlfmtInt = \"%lld%n\";", adamc@879: newline, adam@1920: string "uw_sqlfmtFloat = \"%.16g%n\";", adamc@879: newline, adamc@879: string "uw_Estrings = 0;", adamc@879: newline, adam@1834: string "uw_sql_type_annotations = 0;", adam@1834: newline, adamc@879: string "uw_sqlsuffixString = \"\";", adamc@879: newline, adamc@1011: string "uw_sqlsuffixChar = \"\";", adamc@1011: newline, adamc@879: string "uw_sqlsuffixBlob = \"\";", adamc@879: newline, adamc@879: string "uw_sqlfmtUint4 = \"%u%n\";", adamc@879: newline, adamc@879: newline, adamc@879: adamc@879: string "if (mysql_library_init(0, NULL, NULL)) {", adamc@874: newline, adamc@874: box [string "fprintf(stderr, \"Could not initialize MySQL library\\n\");", adamc@874: newline, adamc@874: string "exit(1);", adamc@874: newline], adamc@874: string "}", adamc@874: newline], adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@866: if #persistent (currentProtocol ()) then adamc@874: box [string "static void uw_db_validate(uw_context ctx) {", adamc@874: newline, adamc@874: string "uw_conn *conn = uw_get_db(ctx);", adamc@874: newline, adamc@874: string "MYSQL_RES *res;", adamc@874: newline, adamc@874: string "MYSQL_ROW row;", adamc@874: newline, adamc@874: newline, adamc@874: p_list_sep newline (checkRel ("tables", true)) tables, adamc@884: p_list_sep newline (fn name => checkRel ("tables", true) adamc@884: (name, [("id", Settings.Client)])) sequences, adamc@874: p_list_sep newline (checkRel ("views", false)) views, adamc@874: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "static void uw_db_prepare(uw_context ctx) {", adamc@866: newline, adamc@866: string "uw_conn *conn = uw_get_db(ctx);", adamc@866: newline, adamc@866: string "MYSQL_STMT *stmt;", adamc@866: newline, adamc@866: newline, adamc@866: adamc@866: p_list_sepi newline (fn i => fn (s, n) => adamc@866: let adamc@866: fun uhoh this s args = adamc@866: box [p_list_sepi (box []) adamc@866: (fn j => fn () => adamc@866: box [string adamc@866: "mysql_stmt_close(conn->p", adamc@866: string (Int.toString j), adamc@866: string ");", adamc@866: newline]) adamc@866: (List.tabulate (i, fn _ => ())), adamc@866: box (if this then adamc@866: [string adamc@866: "mysql_stmt_close(conn->p", adamc@866: string (Int.toString i), adamc@866: string ");", adamc@866: newline] adamc@866: else adamc@866: []), adamc@866: string "mysql_close(conn->conn);", adamc@866: newline, adamc@866: string "uw_error(ctx, FATAL, \"", adamc@866: string s, adamc@866: string "\"", adamc@866: p_list_sep (box []) (fn s => box [string ", ", adamc@866: string s]) args, adamc@866: string ");", adamc@866: newline] adamc@866: in adamc@866: box [string "stmt = mysql_stmt_init(conn->conn);", adamc@866: newline, adamc@866: string "if (stmt == NULL) {", adamc@866: newline, adamc@866: uhoh false "Out of memory allocating prepared statement" [], adamc@866: string "}", adamc@866: newline, adamc@874: string "conn->p", adamc@874: string (Int.toString i), adamc@874: string " = stmt;", adamc@874: newline, adamc@866: adamc@866: string "if (mysql_stmt_prepare(stmt, \"", adam@1656: string (Prim.toCString s), adamc@866: string "\", ", adamc@866: string (Int.toString (size s)), adamc@866: string ")) {", adamc@866: newline, adamc@866: box [string "char msg[1024];", adamc@866: newline, adamc@866: string "strncpy(msg, mysql_stmt_error(stmt), 1024);", adamc@866: newline, adamc@866: string "msg[1023] = 0;", adamc@866: newline, adamc@866: uhoh true "Error preparing statement: %s" ["msg"]], adamc@866: string "}", adamc@866: newline] adamc@866: end) adamc@866: ss, adamc@866: adamc@866: string "}"] adamc@866: else adamc@882: box [string "static void uw_db_prepare(uw_context ctx) { }", adamc@882: newline, adamc@882: string "static void uw_db_validate(uw_context ctx) { }"], adamc@866: newline, adamc@866: newline, adam@1682: adamc@1094: string "static void uw_db_init(uw_context ctx) {", adamc@866: newline, adamc@866: string "MYSQL *mysql = mysql_init(NULL);", adamc@866: newline, adamc@866: string "uw_conn *conn;", adamc@866: newline, adamc@866: string "if (mysql == NULL) uw_error(ctx, FATAL, ", adamc@866: string "\"libmysqlclient can't allocate a connection.\");", adamc@866: newline, adamc@866: string "if (mysql_real_connect(mysql, ", adamc@866: stringOf host, adamc@866: string ", ", adamc@866: stringOf user, adamc@866: string ", ", adamc@866: stringOf passwd, adamc@866: string ", ", adamc@866: stringOf db, adamc@866: string ", ", adamc@866: case !port of adamc@866: NONE => string "0" adamc@866: | SOME n => string (Int.toString n), adamc@866: string ", ", adamc@866: stringOf unix_socket, adamc@874: string ", 0) == NULL) {", adamc@866: newline, adamc@866: box [string "char msg[1024];", adamc@866: newline, adamc@866: string "strncpy(msg, mysql_error(mysql), 1024);", adamc@866: newline, adamc@866: string "msg[1023] = 0;", adamc@866: newline, adamc@866: string "mysql_close(mysql);", adamc@866: newline, adamc@866: string "uw_error(ctx, BOUNDED_RETRY, ", adamc@866: string "\"Connection to MySQL server failed: %s\", msg);"], adamc@866: newline, adamc@866: string "}", adamc@866: newline, adamc@874: string "conn = calloc(1, sizeof(uw_conn));", adamc@866: newline, adamc@866: string "conn->conn = mysql;", adamc@866: newline, adamc@866: string "uw_set_db(ctx, conn);", adamc@866: newline, adamc@866: string "uw_db_validate(ctx);", adamc@866: newline, adamc@866: string "uw_db_prepare(ctx);", adamc@866: newline, adamc@866: string "}", adamc@866: newline, adamc@866: newline, adamc@866: adamc@1094: string "static void uw_db_close(uw_context ctx) {", adamc@866: newline, adamc@866: string "uw_conn *conn = uw_get_db(ctx);", adamc@866: newline, adamc@866: p_list_sepi (box []) adamc@866: (fn i => fn _ => adamc@866: box [string "if (conn->p", adamc@866: string (Int.toString i), adamc@866: string ") mysql_stmt_close(conn->p", adamc@866: string (Int.toString i), adamc@866: string ");", adamc@866: newline]) adamc@866: ss, adamc@866: string "mysql_close(conn->conn);", adamc@866: newline, adamc@866: string "}", adamc@866: newline, adamc@866: newline, adamc@866: adam@1936: string "static int uw_db_begin(uw_context ctx, int could_write) {", adamc@866: newline, adamc@866: string "uw_conn *conn = uw_get_db(ctx);", adamc@866: newline, adamc@866: newline, adamc@866: string "return mysql_query(conn->conn, \"SET TRANSACTION ISOLATION LEVEL SERIALIZABLE\")", adamc@866: newline, adamc@866: string " || mysql_query(conn->conn, \"BEGIN\");", adamc@866: newline, adamc@866: string "}", adamc@866: newline, adamc@866: newline, adamc@866: adamc@1094: string "static int uw_db_commit(uw_context ctx) {", adamc@866: newline, adamc@866: string "uw_conn *conn = uw_get_db(ctx);", adamc@866: newline, adamc@866: string "return mysql_commit(conn->conn);", adamc@866: newline, adamc@866: string "}", adamc@866: newline, adamc@866: newline, adamc@866: adamc@1094: string "static int uw_db_rollback(uw_context ctx) {", adamc@866: newline, adamc@866: string "uw_conn *conn = uw_get_db(ctx);", adamc@866: newline, adamc@866: string "return mysql_rollback(conn->conn);", adamc@866: newline, adamc@866: string "}", adamc@866: newline, adamc@866: newline] adamc@866: end adamc@866: adamc@880: fun p_getcol {loc, wontLeakStrings = _, col = i, typ = t} = adamc@873: let adamc@873: fun getter t = adamc@873: case t of adamc@873: String => box [string "({", adamc@873: newline, adamc@873: string "uw_Basis_string s = uw_malloc(ctx, length", adamc@873: string (Int.toString i), adamc@873: string " + 1);", adamc@873: newline, adamc@873: string "out[", adamc@873: string (Int.toString i), adamc@873: string "].buffer = s;", adamc@873: newline, adamc@873: string "out[", adamc@873: string (Int.toString i), adamc@873: string "].buffer_length = length", adamc@873: string (Int.toString i), adamc@873: string " + 1;", adamc@873: newline, adamc@873: string "mysql_stmt_fetch_column(stmt, &out[", adamc@873: string (Int.toString i), adamc@873: string "], ", adamc@873: string (Int.toString i), adamc@873: string ", 0);", adamc@873: newline, adamc@873: string "s[length", adamc@873: string (Int.toString i), adamc@873: string "] = 0;", adamc@873: newline, adamc@873: string "s;", adamc@873: newline, adamc@873: string "})"] adamc@873: | Blob => box [string "({", adamc@873: newline, adamc@873: string "uw_Basis_blob b = {length", adamc@873: string (Int.toString i), adamc@873: string ", uw_malloc(ctx, length", adamc@873: string (Int.toString i), adamc@873: string ")};", adamc@873: newline, adamc@873: string "out[", adamc@873: string (Int.toString i), adamc@873: string "].buffer = b.data;", adamc@873: newline, adamc@873: string "out[", adamc@873: string (Int.toString i), adamc@873: string "].buffer_length = length", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline, adamc@873: string "mysql_stmt_fetch_column(stmt, &out[", adamc@873: string (Int.toString i), adamc@873: string "], ", adamc@873: string (Int.toString i), adamc@873: string ", 0);", adamc@873: newline, adamc@873: string "b;", adamc@873: newline, adamc@873: string "})"] adamc@873: | Time => box [string "({", adamc@876: string "MYSQL_TIME *mt = &buffer", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline, adamc@873: newline, adamc@938: string "struct tm t = {mt->second, mt->minute, mt->hour, mt->day, mt->month-1, mt->year - 1900, 0, 0, -1};", adamc@873: newline, adam@1443: string "uw_Basis_time res = {mktime(&t), 0};", adam@1443: newline, adam@1443: string "res;", adamc@873: newline, adamc@873: string "})"] adamc@889: | Channel => box [string "({", adamc@889: string "uw_Basis_channel ch = {buffer", adamc@889: string (Int.toString i), adamc@889: string " >> 32, buffer", adamc@889: string (Int.toString i), adamc@889: string " & 0xFFFFFFFF};", adamc@889: newline, adamc@889: string "ch;", adamc@889: newline, adamc@889: string "})"] adamc@873: | _ => box [string "buffer", adamc@873: string (Int.toString i)] adamc@873: in adamc@873: case t of adamc@873: Nullable t => box [string "(is_null", adamc@873: string (Int.toString i), adamc@873: string " ? NULL : ", adamc@873: case t of adamc@873: String => getter t adamc@873: | _ => box [string "({", adamc@873: newline, adamc@873: string (p_sql_ctype t), adamc@873: space, adamc@873: string "*tmp = uw_malloc(ctx, sizeof(", adamc@873: string (p_sql_ctype t), adamc@873: string "));", adamc@873: newline, adamc@873: string "*tmp = ", adamc@873: getter t, adamc@873: string ";", adamc@873: newline, adamc@873: string "tmp;", adamc@873: newline, adamc@873: string "})"], adamc@873: string ")"] adamc@873: | _ => box [string "(is_null", adamc@873: string (Int.toString i), adamc@873: string " ? ", adamc@873: box [string "({", adamc@873: string (p_sql_ctype t), adamc@873: space, adamc@873: string "tmp;", adamc@873: newline, adamc@873: string "uw_error(ctx, FATAL, \"Unexpectedly NULL field #", adamc@873: string (Int.toString i), adamc@873: string "\");", adamc@873: newline, adamc@873: string "tmp;", adamc@873: newline, adamc@873: string "})"], adamc@873: string " : ", adamc@873: getter t, adamc@873: string ")"] adamc@873: end adamc@873: adamc@873: fun queryCommon {loc, query, cols, doCols} = adamc@873: box [string "int n, r;", adamc@873: newline, adamc@873: string "MYSQL_BIND out[", adamc@873: string (Int.toString (length cols)), adamc@873: string "];", adamc@873: newline, adamc@873: p_list_sepi (box []) (fn i => fn t => adamc@873: let adamc@873: fun buffers t = adamc@873: case t of adamc@873: String => box [string "unsigned long length", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline] adamc@873: | Blob => box [string "unsigned long length", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline] adamc@876: | Time => box [string "MYSQL_TIME buffer", adamc@876: string (Int.toString i), adamc@876: string ";", adamc@876: newline] adamc@889: | Channel => box [string "unsigned long long buffer", adamc@889: string (Int.toString i), adamc@889: string ";", adamc@889: newline] adamc@873: | _ => box [string (p_sql_ctype t), adamc@873: space, adamc@873: string "buffer", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline] adamc@873: in adamc@873: box [string "my_bool is_null", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline, adamc@873: case t of adamc@873: Nullable t => buffers t adamc@873: | _ => buffers t, adamc@873: newline] adamc@873: end) cols, adamc@873: newline, adamc@873: adamc@873: string "memset(out, 0, sizeof out);", adamc@873: newline, adamc@873: p_list_sepi (box []) (fn i => fn t => adamc@873: let adamc@873: fun buffers t = adamc@873: case t of adamc@875: String => box [string "out[", adamc@875: string (Int.toString i), adamc@875: string "].length = &length", adamc@875: string (Int.toString i), adamc@875: string ";", adamc@875: newline] adamc@1013: | Char => box [string "out[", adamc@1013: string (Int.toString i), adamc@1013: string "].buffer_length = 1;", adamc@1013: newline, adamc@1013: string "out[", adamc@1013: string (Int.toString i), adamc@1013: string "].buffer = &buffer", adamc@1013: string (Int.toString i), adamc@1013: string ";", adamc@1013: newline] adamc@875: | Blob => box [string "out[", adamc@875: string (Int.toString i), adamc@875: string "].length = &length", adamc@875: string (Int.toString i), adamc@875: string ";", adamc@875: newline] adamc@873: | _ => box [string "out[", adamc@873: string (Int.toString i), adamc@873: string "].buffer = &buffer", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline] adamc@873: in adamc@873: box [string "out[", adamc@873: string (Int.toString i), adamc@873: string "].buffer_type = ", adamc@873: string (p_buffer_type t), adamc@873: string ";", adamc@873: newline, adamc@873: string "out[", adamc@873: string (Int.toString i), adamc@873: string "].is_null = &is_null", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline, adam@1682: adamc@873: case t of adamc@873: Nullable t => buffers t adamc@873: | _ => buffers t, adamc@873: newline] adamc@873: end) cols, adamc@873: newline, adamc@873: adamc@875: string "if (mysql_stmt_reset(stmt)) uw_error(ctx, FATAL, \"", adamc@875: string (ErrorMsg.spanToString loc), adamc@875: string ": Error reseting statement: %s\\n%s\", ", adamc@875: query, adamc@875: string ", mysql_error(conn->conn));", adamc@875: newline, adamc@875: newline, adamc@875: adam@1954: string "if (mysql_stmt_execute(stmt)) {", adam@1954: newline, adam@1954: box [string "if (mysql_errno(conn->conn) == 1213)", adam@1954: newline, adam@1954: box [string "uw_error(ctx, UNLIMITED_RETRY, \"Deadlock detected\");", adam@1954: newline], adam@1954: newline, adam@1954: string "uw_error(ctx, FATAL, \"", adam@1954: string (ErrorMsg.spanToString loc), adam@1954: string ": Error executing query: %s\\n%s\", ", adam@1954: query, adam@1954: string ", mysql_error(conn->conn));", adam@1954: newline], adam@1954: string "}", adamc@875: newline, adamc@875: newline, adamc@875: adamc@875: string "if (mysql_stmt_bind_result(stmt, out)) uw_error(ctx, FATAL, \"", adamc@875: string (ErrorMsg.spanToString loc), adamc@875: string ": Error binding query result: %s\\n%s\", ", adamc@875: query, adamc@875: string ", mysql_error(conn->conn));", adamc@873: newline, adamc@873: newline, adamc@873: adamc@873: string "if (mysql_stmt_store_result(stmt)) uw_error(ctx, FATAL, \"", adamc@873: string (ErrorMsg.spanToString loc), adamc@875: string ": Error storing query result: %s\\n%s\", ", adamc@875: query, adamc@875: string ", mysql_error(conn->conn));", adamc@873: newline, adamc@873: newline, adamc@873: adamc@873: string "uw_end_region(ctx);", adamc@873: newline, adamc@875: string "while (1) {", adamc@875: newline, adamc@875: string "r = mysql_stmt_fetch(stmt);", adamc@875: newline, adamc@875: string "if (r != 0 && r != MYSQL_DATA_TRUNCATED) break;", adamc@873: newline, adamc@873: doCols p_getcol, adamc@873: string "}", adamc@873: newline, adamc@873: newline, adamc@873: adamc@874: string "if (r == 1) uw_error(ctx, FATAL, \"", adamc@873: string (ErrorMsg.spanToString loc), adamc@875: string ": query result fetching failed: %s\\n%s\", ", adamc@875: query, adamc@875: string ", mysql_error(conn->conn));", adamc@875: newline, adamc@875: newline, adamc@875: adamc@875: string "if (mysql_stmt_reset(stmt)) uw_error(ctx, FATAL, \"", adamc@875: string (ErrorMsg.spanToString loc), adamc@875: string ": Error reseting statement: %s\\n%s\", ", adamc@875: query, adamc@875: string ", mysql_error(conn->conn));", adamc@875: newline, adamc@875: newline] adamc@873: adamc@873: fun query {loc, cols, doCols} = adamc@873: box [string "uw_conn *conn = uw_get_db(ctx);", adamc@873: newline, adamc@876: string "MYSQL_STMT *stmt = mysql_stmt_init(conn->conn);", adamc@873: newline, adamc@875: string "if (stmt == NULL) uw_error(ctx, FATAL, \"", adamc@873: string (ErrorMsg.spanToString loc), adamc@873: string ": can't allocate temporary prepared statement\");", adamc@873: newline, adamc@873: string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);", adamc@873: newline, adamc@873: string "if (mysql_stmt_prepare(stmt, query, strlen(query))) uw_error(ctx, FATAL, \"", adamc@873: string (ErrorMsg.spanToString loc), adamc@875: string ": error preparing statement: %s\\n%s\", query, mysql_error(conn->conn));", adamc@873: newline, adamc@873: newline, adamc@873: adamc@873: queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"}, adamc@873: adamc@873: string "uw_pop_cleanup(ctx);", adamc@873: newline] adamc@873: adamc@879: fun queryPrepared {loc, id, query, inputs, cols, doCols, nested} = adamc@873: box [string "uw_conn *conn = uw_get_db(ctx);", adamc@873: newline, adamc@873: string "MYSQL_BIND in[", adamc@873: string (Int.toString (length inputs)), adamc@873: string "];", adamc@873: newline, adamc@873: p_list_sepi (box []) (fn i => fn t => adamc@873: let adamc@873: fun buffers t = adamc@873: case t of adamc@873: String => box [string "unsigned long in_length", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline] adamc@873: | Blob => box [string "unsigned long in_length", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline] adamc@876: | Time => box [string "MYSQL_TIME in_buffer", adamc@873: string (Int.toString i), adamc@1013: string ";", adamc@1013: newline] adamc@873: | _ => box [] adamc@873: in adamc@873: box [case t of adamc@873: Nullable t => box [string "my_bool in_is_null", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline, adamc@873: buffers t] adamc@873: | _ => buffers t, adamc@873: newline] adamc@873: end) inputs, adamc@873: adamc@879: if nested then adamc@879: box [string "MYSQL_STMT *stmt;", adamc@879: newline] adamc@879: else adamc@879: box [string "MYSQL_STMT *stmt = conn->p", adamc@879: string (Int.toString id), adamc@879: string ";", adamc@879: newline, adamc@879: newline, adamc@879: adamc@879: string "if (stmt == NULL) {", adamc@879: newline], adamc@879: adamc@878: box [string "stmt = mysql_stmt_init(conn->conn);", adamc@878: newline, adamc@878: string "if (stmt == NULL) uw_error(ctx, FATAL, \"Out of memory allocating prepared statement\");", adamc@878: newline, adamc@880: if nested then adamc@880: box [string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);", adamc@880: newline] adamc@880: else adamc@880: box [], adamc@878: string "if (mysql_stmt_prepare(stmt, \"", adam@1656: string (Prim.toCString query), adamc@878: string "\", ", adamc@878: string (Int.toString (size query)), adamc@878: string ")) {", adamc@878: newline, adamc@878: box [string "char msg[1024];", adamc@878: newline, adamc@878: string "strncpy(msg, mysql_stmt_error(stmt), 1024);", adamc@878: newline, adamc@878: string "msg[1023] = 0;", adamc@878: newline, adamc@880: if nested then adamc@880: box [] adamc@880: else adamc@880: box [string "mysql_stmt_close(stmt);", adamc@880: newline], adamc@878: string "uw_error(ctx, FATAL, \"Error preparing statement: %s\", msg);", adamc@878: newline], adamc@878: string "}", adamc@878: newline, adamc@879: if nested then adamc@879: box [] adamc@879: else adamc@879: box [string "conn->p", adamc@879: string (Int.toString id), adamc@879: string " = stmt;", adamc@879: newline]], adamc@879: if nested then adamc@879: box [] adamc@879: else adamc@879: box [string "}", adamc@879: newline], adamc@878: newline, adamc@878: adamc@873: string "memset(in, 0, sizeof in);", adamc@873: newline, adamc@873: p_list_sepi (box []) (fn i => fn t => adamc@873: let adamc@873: fun buffers t = adamc@873: case t of adamc@873: String => box [string "in[", adamc@873: string (Int.toString i), adamc@873: string "].buffer = arg", adamc@873: string (Int.toString (i + 1)), adamc@873: string ";", adamc@873: newline, adamc@873: string "in_length", adamc@873: string (Int.toString i), adamc@873: string "= in[", adamc@873: string (Int.toString i), adamc@873: string "].buffer_length = strlen(arg", adamc@873: string (Int.toString (i + 1)), adamc@873: string ");", adamc@873: newline, adamc@873: string "in[", adamc@873: string (Int.toString i), adamc@873: string "].length = &in_length", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline] adamc@1013: | Char => box [string "in[", adamc@1013: string (Int.toString i), adamc@1013: string "].buffer = &arg", adamc@1013: string (Int.toString (i + 1)), adamc@1013: string ";", adamc@1013: newline, adamc@1013: string "in[", adamc@1013: string (Int.toString i), adamc@1013: string "].buffer_length = 1;", adamc@1013: newline] adamc@873: | Blob => box [string "in[", adamc@873: string (Int.toString i), adamc@873: string "].buffer = arg", adamc@873: string (Int.toString (i + 1)), adamc@873: string ".data;", adamc@873: newline, adamc@873: string "in_length", adamc@873: string (Int.toString i), adamc@873: string "= in[", adamc@873: string (Int.toString i), adamc@873: string "].buffer_length = arg", adamc@873: string (Int.toString (i + 1)), adamc@873: string ".size;", adamc@873: newline, adamc@873: string "in[", adamc@873: string (Int.toString i), adamc@873: string "].length = &in_length", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline] adamc@873: | Time => adamc@873: let adamc@873: fun oneField dst src = adamc@873: box [string "in_buffer", adamc@873: string (Int.toString i), adamc@873: string ".", adamc@873: string dst, adamc@873: string " = tms.tm_", adamc@873: string src, adamc@873: string ";", adamc@873: newline] adamc@873: in adamc@873: box [string "({", adamc@873: newline, adamc@873: string "struct tm tms;", adamc@873: newline, adamc@873: string "if (localtime_r(&arg", adamc@873: string (Int.toString (i + 1)), adam@1443: string ".seconds, &tms) == NULL) uw_error(ctx, FATAL, \"", adamc@873: string (ErrorMsg.spanToString loc), adamc@873: string ": error converting to MySQL time\");", adamc@873: newline, adamc@938: oneField "year" "year + 1900", adamc@888: box [string "in_buffer", adamc@888: string (Int.toString i), adamc@888: string ".month = tms.tm_mon + 1;", adamc@888: newline], adamc@873: oneField "day" "mday", adam@1839: oneField "hour" "hour", adamc@873: oneField "minute" "min", adamc@873: oneField "second" "sec", adamc@873: newline, adamc@873: string "in[", adamc@873: string (Int.toString i), adamc@873: string "].buffer = &in_buffer", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@933: newline, adamc@933: string "});", adamc@873: newline] adamc@873: end adamc@889: | Channel => box [string "in_buffer", adamc@889: string (Int.toString i), adamc@889: string " = ((unsigned long long)arg", adamc@889: string (Int.toString (i + 1)), adamc@889: string ".cli << 32) | arg", adamc@889: string (Int.toString (i + 1)), adamc@889: string ".chn;", adamc@889: newline, adamc@889: string "in[", adamc@889: string (Int.toString i), adamc@889: string "].buffer = &in_buffer", adamc@889: string (Int.toString i), adamc@889: string ";", adamc@889: newline] adam@1682: adamc@873: | _ => box [string "in[", adamc@873: string (Int.toString i), adamc@873: string "].buffer = &arg", adamc@873: string (Int.toString (i + 1)), adamc@873: string ";", adamc@873: newline] adamc@873: in adamc@873: box [string "in[", adamc@873: string (Int.toString i), adamc@873: string "].buffer_type = ", adamc@873: string (p_buffer_type t), adamc@873: string ";", adamc@873: newline, adam@1682: adamc@873: case t of adamc@873: Nullable t => box [string "in[", adamc@873: string (Int.toString i), adamc@873: string "].is_null = &in_is_null", adamc@873: string (Int.toString i), adamc@873: string ";", adamc@873: newline, adamc@873: string "if (arg", adamc@873: string (Int.toString (i + 1)), adamc@873: string " == NULL) {", adamc@873: newline, adamc@873: box [string "in_is_null", adamc@873: string (Int.toString i), adamc@873: string " = 1;", adamc@873: newline], adamc@873: string "} else {", adamc@873: box [case t of adamc@873: String => box [] adamc@873: | _ => adamc@873: box [string (p_sql_ctype t), adamc@873: space, adamc@876: string "tmp = *arg", adamc@876: string (Int.toString (i + 1)), adamc@876: string ";", adamc@876: newline, adamc@876: string (p_sql_ctype t), adamc@876: space, adamc@873: string "arg", adamc@873: string (Int.toString (i + 1)), adamc@876: string " = tmp;", adamc@873: newline], adamc@873: string "in_is_null", adamc@873: string (Int.toString i), adamc@873: string " = 0;", adamc@873: newline, adamc@873: buffers t, adamc@876: newline], adamc@876: string "}", adamc@876: newline] adam@1682: adamc@873: | _ => buffers t, adamc@873: newline] adamc@873: end) inputs, adamc@873: newline, adamc@873: adamc@875: string "if (mysql_stmt_bind_param(stmt, in)) uw_error(ctx, FATAL, \"", adamc@875: string (ErrorMsg.spanToString loc), adamc@875: string ": error binding parameters\");", adamc@875: newline, adamc@875: adamc@873: queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"", adam@1656: string (Prim.toCString query), adamc@879: string "\""]}, adamc@879: adamc@879: if nested then adamc@879: box [string "uw_pop_cleanup(ctx);", adamc@879: newline] adamc@879: else adamc@879: box []] adamc@873: adam@1293: fun dmlCommon {loc, dml, mode} = adam@1953: box [string "if (mysql_stmt_execute(stmt)) {", adam@1953: box [string "if (mysql_errno(conn->conn) == 1213)", adam@1953: newline, adam@1953: box [string "uw_error(ctx, UNLIMITED_RETRY, \"Deadlock detected\");", adam@1953: newline], adam@1953: newline, adam@1953: case mode of adam@1953: Settings.Error => box [string "uw_error(ctx, FATAL, \"", adam@1953: string (ErrorMsg.spanToString loc), adam@1953: string ": Error executing DML: %s\\n%s\", ", adam@1953: dml, adam@1953: string ", mysql_error(conn->conn));"] adam@1953: | Settings.None => string "uw_set_error_message(ctx, mysql_error(conn->conn));", adam@1953: newline], adam@1953: string "}", adamc@875: newline] adamc@875: adam@1293: fun dml (loc, mode) = adamc@875: box [string "uw_conn *conn = uw_get_db(ctx);", adamc@875: newline, adamc@1013: string "MYSQL_STMT *stmt = mysql_stmt_init(conn->conn);", adamc@875: newline, adamc@933: string "if (stmt == NULL) uw_error(ctx, FATAL, \"", adamc@875: string (ErrorMsg.spanToString loc), adamc@875: string ": can't allocate temporary prepared statement\");", adamc@875: newline, adamc@875: string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);", adamc@875: newline, adamc@875: string "if (mysql_stmt_prepare(stmt, dml, strlen(dml))) uw_error(ctx, FATAL, \"", adamc@875: string (ErrorMsg.spanToString loc), adamc@875: string ": error preparing statement: %s\\n%s\", dml, mysql_error(conn->conn));", adamc@875: newline, adamc@875: newline, adamc@875: adam@1293: dmlCommon {loc = loc, dml = string "dml", mode = mode}, adamc@875: adamc@875: string "uw_pop_cleanup(ctx);", adamc@875: newline] adamc@875: adam@1293: fun dmlPrepared {loc, id, dml, inputs, mode} = adamc@875: box [string "uw_conn *conn = uw_get_db(ctx);", adamc@875: newline, adamc@875: string "MYSQL_BIND in[", adamc@875: string (Int.toString (length inputs)), adamc@875: string "];", adamc@875: newline, adamc@875: p_list_sepi (box []) (fn i => fn t => adamc@875: let adamc@875: fun buffers t = adamc@875: case t of adamc@875: String => box [string "unsigned long in_length", adamc@875: string (Int.toString i), adamc@875: string ";", adamc@875: newline] adamc@875: | Blob => box [string "unsigned long in_length", adamc@875: string (Int.toString i), adamc@875: string ";", adamc@875: newline] adamc@876: | Time => box [string "MYSQL_TIME in_buffer", adamc@875: string (Int.toString i), adamc@875: string ";", adamc@875: newline] adamc@889: | Channel => box [string "unsigned long long in_buffer", adamc@889: string (Int.toString i), adamc@889: string ";", adamc@889: newline] adamc@875: | _ => box [] adamc@875: in adamc@875: box [case t of adamc@875: Nullable t => box [string "my_bool in_is_null", adamc@875: string (Int.toString i), adamc@875: string ";", adamc@875: newline, adamc@875: buffers t] adamc@875: | _ => buffers t, adamc@875: newline] adamc@875: end) inputs, adamc@875: string "MYSQL_STMT *stmt = conn->p", adamc@875: string (Int.toString id), adamc@875: string ";", adamc@875: newline, adamc@875: newline, adamc@875: adamc@878: string "if (stmt == NULL) {", adamc@878: newline, adamc@878: box [string "stmt = mysql_stmt_init(conn->conn);", adamc@878: newline, adamc@878: string "if (stmt == NULL) uw_error(ctx, FATAL, \"Out of memory allocating prepared statement\");", adamc@878: newline, adamc@878: string "if (mysql_stmt_prepare(stmt, \"", adam@1656: string (Prim.toCString dml), adamc@878: string "\", ", adamc@878: string (Int.toString (size dml)), adamc@878: string ")) {", adamc@878: newline, adamc@878: box [string "char msg[1024];", adamc@878: newline, adamc@878: string "strncpy(msg, mysql_stmt_error(stmt), 1024);", adamc@878: newline, adamc@878: string "msg[1023] = 0;", adamc@878: newline, adamc@878: string "uw_error(ctx, FATAL, \"Error preparing statement: %s\", msg);", adamc@878: newline], adamc@878: string "}", adamc@878: newline, adamc@878: string "conn->p", adamc@878: string (Int.toString id), adamc@878: string " = stmt;", adamc@878: newline], adamc@878: string "}", adamc@878: newline, adamc@878: newline, adamc@878: adamc@875: string "memset(in, 0, sizeof in);", adamc@875: newline, adamc@875: p_list_sepi (box []) (fn i => fn t => adamc@875: let adamc@875: fun buffers t = adamc@875: case t of adamc@875: String => box [string "in[", adamc@875: string (Int.toString i), adamc@875: string "].buffer = arg", adamc@875: string (Int.toString (i + 1)), adamc@875: string ";", adamc@875: newline, adamc@875: string "in_length", adamc@875: string (Int.toString i), adamc@875: string "= in[", adamc@875: string (Int.toString i), adamc@875: string "].buffer_length = strlen(arg", adamc@875: string (Int.toString (i + 1)), adamc@875: string ");", adamc@875: newline, adamc@875: string "in[", adamc@875: string (Int.toString i), adamc@875: string "].length = &in_length", adamc@875: string (Int.toString i), adamc@875: string ";", adamc@875: newline] adamc@875: | Blob => box [string "in[", adamc@875: string (Int.toString i), adamc@875: string "].buffer = arg", adamc@875: string (Int.toString (i + 1)), adamc@875: string ".data;", adamc@875: newline, adamc@875: string "in_length", adamc@875: string (Int.toString i), adamc@875: string "= in[", adamc@875: string (Int.toString i), adamc@875: string "].buffer_length = arg", adamc@875: string (Int.toString (i + 1)), adamc@875: string ".size;", adamc@875: newline, adamc@875: string "in[", adamc@875: string (Int.toString i), adamc@875: string "].length = &in_length", adamc@875: string (Int.toString i), adamc@875: string ";", adamc@875: newline] adamc@875: | Time => adamc@875: let adamc@875: fun oneField dst src = adamc@875: box [string "in_buffer", adamc@875: string (Int.toString i), adamc@875: string ".", adamc@875: string dst, adamc@875: string " = tms.tm_", adamc@875: string src, adamc@875: string ";", adamc@875: newline] adamc@875: in adamc@875: box [string "({", adamc@875: newline, adamc@875: string "struct tm tms;", adamc@875: newline, adamc@875: string "if (localtime_r(&arg", adamc@875: string (Int.toString (i + 1)), adam@1443: string ".seconds, &tms) == NULL) uw_error(ctx, FATAL, \"", adamc@875: string (ErrorMsg.spanToString loc), adamc@875: string ": error converting to MySQL time\");", adamc@875: newline, adamc@938: oneField "year" "year + 1900", adamc@938: oneField "month" "mon + 1", adamc@875: oneField "day" "mday", adam@1839: oneField "hour" "hour", adamc@875: oneField "minute" "min", adamc@875: oneField "second" "sec", adamc@875: newline, adamc@875: string "in[", adamc@875: string (Int.toString i), adamc@875: string "].buffer = &in_buffer", adamc@875: string (Int.toString i), adamc@875: string ";", adamc@933: newline, adamc@933: string "});", adamc@875: newline] adamc@875: end adamc@889: | Channel => box [string "in_buffer", adamc@889: string (Int.toString i), adamc@889: string " = ((unsigned long long)arg", adamc@889: string (Int.toString (i + 1)), adamc@889: string ".cli << 32) | arg", adamc@889: string (Int.toString (i + 1)), adamc@889: string ".chn;", adamc@889: newline, adamc@889: string "in[", adamc@889: string (Int.toString i), adamc@889: string "].buffer = &in_buffer", adamc@889: string (Int.toString i), adamc@889: string ";", adamc@889: newline] adam@1682: adamc@875: | _ => box [string "in[", adamc@875: string (Int.toString i), adamc@875: string "].buffer = &arg", adamc@875: string (Int.toString (i + 1)), adamc@875: string ";", adamc@875: newline] adamc@875: in adamc@875: box [string "in[", adamc@875: string (Int.toString i), adamc@875: string "].buffer_type = ", adamc@875: string (p_buffer_type t), adamc@875: string ";", adamc@875: newline, adamc@889: adamc@889: case t of adamc@889: Channel => box [string "in[", adamc@889: string (Int.toString i), adamc@889: string "].is_unsigned = 1;", adamc@889: newline] adamc@889: | _ => box [], adam@1682: adamc@875: case t of adamc@875: Nullable t => box [string "in[", adamc@875: string (Int.toString i), adamc@875: string "].is_null = &in_is_null", adamc@875: string (Int.toString i), adamc@875: string ";", adamc@875: newline, adamc@875: string "if (arg", adamc@875: string (Int.toString (i + 1)), adamc@875: string " == NULL) {", adamc@875: newline, adamc@875: box [string "in_is_null", adamc@875: string (Int.toString i), adamc@875: string " = 1;", adamc@875: newline], adamc@875: string "} else {", adamc@875: box [case t of adamc@875: String => box [] adamc@875: | _ => adamc@875: box [string (p_sql_ctype t), adamc@875: space, adamc@876: string "tmp = *arg", adamc@876: string (Int.toString (i + 1)), adamc@876: string ";", adamc@876: newline, adamc@876: string (p_sql_ctype t), adamc@876: space, adamc@875: string "arg", adamc@875: string (Int.toString (i + 1)), adamc@876: string " = tmp;", adamc@875: newline], adamc@875: string "in_is_null", adamc@875: string (Int.toString i), adamc@875: string " = 0;", adamc@875: newline, adamc@875: buffers t, adamc@876: newline], adamc@876: string "}", adamc@876: newline] adam@1682: adamc@875: | _ => buffers t, adamc@875: newline] adamc@875: end) inputs, adamc@875: newline, adamc@875: adamc@875: string "if (mysql_stmt_bind_param(stmt, in)) uw_error(ctx, FATAL, \"", adamc@875: string (ErrorMsg.spanToString loc), adamc@875: string ": error binding parameters\");", adamc@875: newline, adamc@875: adamc@875: dmlCommon {loc = loc, dml = box [string "\"", adam@1656: string (Prim.toCString dml), adam@1293: string "\""], mode = mode}] adamc@875: adamc@878: fun nextval {loc, seqE, seqName} = adamc@878: box [string "uw_conn *conn = uw_get_db(ctx);", adamc@878: newline, adamc@878: string "char *insert = ", adamc@878: case seqName of adamc@878: SOME s => string ("\"INSERT INTO " ^ s ^ " VALUES ()\"") adamc@878: | NONE => box [string "uw_Basis_strcat(ctx, \"INSERT INTO \", uw_Basis_strcat(ctx, ", adamc@878: seqE, adamc@878: string ", \" VALUES ()\"))"], adamc@878: string ";", adamc@878: newline, adamc@878: string "char *delete = ", adamc@878: case seqName of adamc@878: SOME s => string ("\"DELETE FROM " ^ s ^ "\"") adamc@878: | NONE => box [string "uw_Basis_strcat(ctx, \"DELETE FROM \", ", adamc@878: seqE, adamc@878: string ")"], adamc@878: string ";", adamc@878: newline, adamc@878: newline, adamc@878: adamc@878: string "if (mysql_query(conn->conn, insert)) uw_error(ctx, FATAL, \"'nextval' INSERT failed\");", adamc@878: newline, adamc@878: string "n = mysql_insert_id(conn->conn);", adamc@878: newline, adamc@878: string "if (mysql_query(conn->conn, delete)) uw_error(ctx, FATAL, \"'nextval' DELETE failed\");", adamc@878: newline] adamc@878: adamc@878: fun nextvalPrepared _ = raise Fail "MySQL.nextvalPrepared called" adamc@867: adamc@1073: fun setval _ = raise Fail "MySQL.setval called" adamc@1073: adamc@877: fun sqlifyString s = "'" ^ String.translate (fn #"'" => "\\'" adamc@877: | #"\\" => "\\\\" adamc@877: | ch => adamc@877: if Char.isPrint ch then adamc@877: str ch adamc@877: else adamc@877: (ErrorMsg.error adamc@877: "Non-printing character found in SQL string literal"; adamc@877: "")) adam@1656: (Prim.toCString s) ^ "'" adamc@874: adamc@877: fun p_cast (s, _) = s adamc@874: adamc@874: fun p_blank _ = "?" adamc@874: adamc@866: val () = addDbms {name = "mysql", adam@1464: header = Config.msheader, adam@1682: randomFunction = "RAND", adamc@866: link = "-lmysqlclient", adamc@867: init = init, adamc@873: p_sql_type = p_sql_type, adamc@867: query = query, adamc@868: queryPrepared = queryPrepared, adamc@868: dml = dml, adamc@869: dmlPrepared = dmlPrepared, adamc@869: nextval = nextval, adamc@874: nextvalPrepared = nextvalPrepared, adamc@1073: setval = setval, adamc@874: sqlifyString = sqlifyString, adamc@874: p_cast = p_cast, adamc@874: p_blank = p_blank, adamc@877: supportsDeleteAs = false, adamc@886: supportsUpdateAs = false, adamc@884: createSequence = fn s => "CREATE TABLE " ^ s ^ " (uw_id INTEGER PRIMARY KEY AUTO_INCREMENT)", adamc@878: textKeysNeedLengths = true, adamc@879: supportsNextval = false, adamc@882: supportsNestedPrepared = false, adamc@890: sqlPrefix = "SET storage_engine=InnoDB;\n\n", adamc@1014: supportsOctetLength = true, adamc@1014: trueString = "TRUE", adamc@1196: falseString = "FALSE", adamc@1196: onlyUnion = true, adam@1777: nestedRelops = false, adam@1777: windowFunctions = false} adamc@866: adamc@866: end