adamc@866: (* Copyright (c) 2008-2009, 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 adamc@866: * 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 Postgres :> POSTGRES = struct adamc@866: adamc@866: open Settings adamc@866: open Print.PD adamc@866: open Print adamc@866: adamc@870: val ident = String.translate (fn #"'" => "PRIME" adamc@870: | ch => str ch) adamc@870: adamc@873: fun p_sql_type t = adamc@873: case t of adamc@873: Int => "int8" adamc@873: | Float => "float8" adamc@873: | String => "text" adamc@873: | Bool => "bool" adamc@873: | Time => "timestamp" adamc@873: | Blob => "bytea" adamc@873: | Channel => "int8" adamc@873: | Client => "int4" adamc@873: | Nullable t => p_sql_type t adamc@873: adamc@870: fun p_sql_type_base t = adamc@870: case t of adamc@871: Int => "bigint" adamc@871: | Float => "double precision" adamc@870: | String => "text" adamc@871: | Bool => "boolean" adamc@871: | Time => "timestamp without time zone" adamc@870: | Blob => "bytea" adamc@871: | Channel => "bigint" adamc@871: | Client => "integer" adamc@870: | Nullable t => p_sql_type_base t adamc@870: adamc@872: fun checkRel (table, checkNullable) (s, xts) = adamc@871: let adamc@871: val sl = CharVector.map Char.toLower s adamc@871: adamc@872: val q = "SELECT COUNT(*) FROM information_schema." ^ table ^ " WHERE table_name = '" adamc@871: ^ sl ^ "'" adamc@871: adamc@871: val q' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE table_name = '", adamc@871: sl, adamc@871: "' AND (", adamc@871: String.concatWith " OR " adamc@871: (map (fn (x, t) => adamc@871: String.concat ["(column_name = 'uw_", adamc@871: CharVector.map adamc@871: Char.toLower (ident x), adamc@871: "' AND data_type = '", adamc@871: p_sql_type_base t, adamc@872: "'", adamc@872: if checkNullable then adamc@872: (" AND is_nullable = '" adamc@872: ^ (if isNotNull t then adamc@872: "NO" adamc@872: else adamc@872: "YES") adamc@872: ^ "'") adamc@871: else adamc@872: "", adamc@872: ")"]) xts), adamc@871: ")"] adamc@871: adamc@871: val q'' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE table_name = '", adamc@871: sl, adamc@871: "' AND column_name LIKE 'uw_%'"] adamc@871: in adamc@871: box [string "res = PQexec(conn, \"", adamc@871: string q, adamc@871: string "\");", adamc@871: newline, adamc@871: newline, adamc@871: string "if (res == NULL) {", adamc@871: newline, adamc@871: box [string "PQfinish(conn);", adamc@871: newline, adamc@871: string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");", adamc@871: newline], adamc@871: string "}", adamc@871: newline, adamc@871: newline, adamc@871: string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {", adamc@871: newline, adamc@871: box [string "char msg[1024];", adamc@871: newline, adamc@871: string "strncpy(msg, PQerrorMessage(conn), 1024);", adamc@871: newline, adamc@871: string "msg[1023] = 0;", adamc@871: newline, adamc@871: string "PQclear(res);", adamc@871: newline, adamc@871: string "PQfinish(conn);", adamc@871: newline, adamc@871: string "uw_error(ctx, FATAL, \"Query failed:\\n", adamc@871: string q, adamc@871: string "\\n%s\", msg);", adamc@871: newline], adamc@871: string "}", adamc@871: newline, adamc@871: newline, adamc@871: string "if (strcmp(PQgetvalue(res, 0, 0), \"1\")) {", adamc@871: newline, adamc@871: box [string "PQclear(res);", adamc@871: newline, adamc@871: string "PQfinish(conn);", adamc@871: newline, adamc@871: string "uw_error(ctx, FATAL, \"Table '", adamc@871: string s, adamc@871: string "' does not exist.\");", adamc@871: newline], adamc@871: string "}", adamc@871: newline, adamc@871: newline, adamc@871: string "PQclear(res);", adamc@871: newline, adamc@871: adamc@871: string "res = PQexec(conn, \"", adamc@871: string q', adamc@871: string "\");", adamc@871: newline, adamc@871: newline, adamc@871: string "if (res == NULL) {", adamc@871: newline, adamc@871: box [string "PQfinish(conn);", adamc@871: newline, adamc@871: string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");", adamc@871: newline], adamc@871: string "}", adamc@871: newline, adamc@871: newline, adamc@871: string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {", adamc@871: newline, adamc@871: box [string "char msg[1024];", adamc@871: newline, adamc@871: string "strncpy(msg, PQerrorMessage(conn), 1024);", adamc@871: newline, adamc@871: string "msg[1023] = 0;", adamc@871: newline, adamc@871: string "PQclear(res);", adamc@871: newline, adamc@871: string "PQfinish(conn);", adamc@871: newline, adamc@871: string "uw_error(ctx, FATAL, \"Query failed:\\n", adamc@871: string q', adamc@871: string "\\n%s\", msg);", adamc@871: newline], adamc@871: string "}", adamc@871: newline, adamc@871: newline, adamc@871: string "if (strcmp(PQgetvalue(res, 0, 0), \"", adamc@871: string (Int.toString (length xts)), adamc@871: string "\")) {", adamc@871: newline, adamc@871: box [string "PQclear(res);", adamc@871: newline, adamc@871: string "PQfinish(conn);", adamc@871: newline, adamc@871: string "uw_error(ctx, FATAL, \"Table '", adamc@871: string s, adamc@871: string "' has the wrong column types.\");", adamc@871: newline], adamc@871: string "}", adamc@871: newline, adamc@871: newline, adamc@871: string "PQclear(res);", adamc@871: newline, adamc@871: newline, adamc@871: adamc@871: string "res = PQexec(conn, \"", adamc@871: string q'', adamc@871: string "\");", adamc@871: newline, adamc@871: newline, adamc@871: string "if (res == NULL) {", adamc@871: newline, adamc@871: box [string "PQfinish(conn);", adamc@871: newline, adamc@871: string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");", adamc@871: newline], adamc@871: string "}", adamc@871: newline, adamc@871: newline, adamc@871: string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {", adamc@871: newline, adamc@871: box [string "char msg[1024];", adamc@871: newline, adamc@871: string "strncpy(msg, PQerrorMessage(conn), 1024);", adamc@871: newline, adamc@871: string "msg[1023] = 0;", adamc@871: newline, adamc@871: string "PQclear(res);", adamc@871: newline, adamc@871: string "PQfinish(conn);", adamc@871: newline, adamc@871: string "uw_error(ctx, FATAL, \"Query failed:\\n", adamc@871: string q'', adamc@871: string "\\n%s\", msg);", adamc@871: newline], adamc@871: string "}", adamc@871: newline, adamc@871: newline, adamc@871: string "if (strcmp(PQgetvalue(res, 0, 0), \"", adamc@871: string (Int.toString (length xts)), adamc@871: string "\")) {", adamc@871: newline, adamc@871: box [string "PQclear(res);", adamc@871: newline, adamc@871: string "PQfinish(conn);", adamc@871: newline, adamc@871: string "uw_error(ctx, FATAL, \"Table '", adamc@871: string s, adamc@871: string "' has extra columns.\");", adamc@871: newline], adamc@871: string "}", adamc@871: newline, adamc@871: newline, adamc@871: string "PQclear(res);", adamc@871: newline] adamc@871: end adamc@871: adamc@872: fun init {dbstring, prepared = ss, tables, views, sequences} = adamc@866: box [if #persistent (currentProtocol ()) then adamc@879: box [string "void uw_client_init(void) {", adamc@879: newline, adamc@879: box [string "uw_sqlfmtInt = \"%lld::int8%n\";", adamc@879: newline, adamc@879: string "uw_sqlfmtFloat = \"%g::float8%n\";", adamc@879: newline, adamc@879: string "uw_Estrings = 1;", adamc@879: newline, adamc@879: string "uw_sqlsuffixString = \"::text\";", adamc@879: newline, adamc@879: string "uw_sqlsuffixBlob = \"::bytea\";", adamc@879: newline, adamc@879: string "uw_sqlfmtUint4 = \"%u::int4%n\";", adamc@879: newline], adamc@879: string "}", adamc@874: newline, adamc@874: newline, adamc@874: adamc@874: string "static void uw_db_validate(uw_context ctx) {", adamc@870: newline, adamc@870: string "PGconn *conn = uw_get_db(ctx);", adamc@870: newline, adamc@870: string "PGresult *res;", adamc@870: newline, adamc@870: newline, adamc@872: p_list_sep newline (checkRel ("tables", true)) tables, adamc@872: p_list_sep newline (checkRel ("views", false)) views, adamc@870: adamc@870: p_list_sep newline adamc@870: (fn s => adamc@870: let adamc@870: val sl = CharVector.map Char.toLower s adamc@870: adamc@870: val q = "SELECT COUNT(*) FROM pg_class WHERE relname = '" adamc@870: ^ sl ^ "' AND relkind = 'S'" adamc@870: in adamc@870: box [string "res = PQexec(conn, \"", adamc@870: string q, adamc@870: string "\");", adamc@870: newline, adamc@870: newline, adamc@870: string "if (res == NULL) {", adamc@870: newline, adamc@870: box [string "PQfinish(conn);", adamc@870: newline, adamc@870: string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");", adamc@870: newline], adamc@870: string "}", adamc@870: newline, adamc@870: newline, adamc@870: string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {", adamc@870: newline, adamc@870: box [string "char msg[1024];", adamc@870: newline, adamc@870: string "strncpy(msg, PQerrorMessage(conn), 1024);", adamc@870: newline, adamc@870: string "msg[1023] = 0;", adamc@870: newline, adamc@870: string "PQclear(res);", adamc@870: newline, adamc@870: string "PQfinish(conn);", adamc@870: newline, adamc@870: string "uw_error(ctx, FATAL, \"Query failed:\\n", adamc@870: string q, adamc@870: string "\\n%s\", msg);", adamc@870: newline], adamc@870: string "}", adamc@870: newline, adamc@870: newline, adamc@870: string "if (strcmp(PQgetvalue(res, 0, 0), \"1\")) {", adamc@870: newline, adamc@870: box [string "PQclear(res);", adamc@870: newline, adamc@870: string "PQfinish(conn);", adamc@870: newline, adamc@870: string "uw_error(ctx, FATAL, \"Sequence '", adamc@870: string s, adamc@870: string "' does not exist.\");", adamc@870: newline], adamc@870: string "}", adamc@870: newline, adamc@870: newline, adamc@870: string "PQclear(res);", adamc@870: newline] adamc@870: end) sequences, adamc@870: adamc@870: string "}", adamc@870: adamc@870: string "static void uw_db_prepare(uw_context ctx) {", adamc@866: newline, adamc@866: string "PGconn *conn = uw_get_db(ctx);", adamc@866: newline, adamc@866: string "PGresult *res;", adamc@866: newline, adamc@866: newline, adamc@866: adamc@866: p_list_sepi newline (fn i => fn (s, n) => adamc@866: box [string "res = PQprepare(conn, \"uw", adamc@866: string (Int.toString i), adamc@866: string "\", \"", adamc@866: string (String.toString s), adamc@866: string "\", ", adamc@866: string (Int.toString n), adamc@866: string ", NULL);", adamc@866: newline, adamc@866: string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {", adamc@866: newline, adamc@866: box [string "char msg[1024];", adamc@866: newline, adamc@866: string "strncpy(msg, PQerrorMessage(conn), 1024);", adamc@866: newline, adamc@866: string "msg[1023] = 0;", adamc@866: newline, adamc@866: string "PQclear(res);", adamc@866: newline, adamc@866: string "PQfinish(conn);", adamc@866: newline, adamc@866: string "uw_error(ctx, FATAL, \"Unable to create prepared statement:\\n", adamc@866: string (String.toString s), adamc@866: string "\\n%s\", msg);", adamc@866: newline], adamc@866: string "}", adamc@866: newline, adamc@866: string "PQclear(res);", adamc@866: newline]) adamc@866: ss, adamc@866: adamc@866: string "}", adamc@866: newline, adamc@866: newline, adamc@866: adamc@866: string "void uw_db_close(uw_context ctx) {", adamc@866: newline, adamc@866: string "PQfinish(uw_get_db(ctx));", adamc@866: newline, adamc@866: string "}", adamc@866: newline, adamc@866: newline, adamc@866: adamc@866: string "int uw_db_begin(uw_context ctx) {", adamc@866: newline, adamc@866: string "PGconn *conn = uw_get_db(ctx);", adamc@866: newline, adamc@866: string "PGresult *res = PQexec(conn, \"BEGIN ISOLATION LEVEL SERIALIZABLE\");", adamc@866: newline, adamc@866: newline, adamc@866: string "if (res == NULL) return 1;", adamc@866: newline, adamc@866: newline, adamc@866: string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {", adamc@866: box [string "PQclear(res);", adamc@866: newline, adamc@866: string "return 1;", adamc@866: newline], adamc@866: string "}", adamc@866: newline, adamc@866: string "return 0;", adamc@866: newline, adamc@866: string "}", adamc@866: newline, adamc@866: newline, adamc@866: adamc@866: string "int uw_db_commit(uw_context ctx) {", adamc@866: newline, adamc@866: string "PGconn *conn = uw_get_db(ctx);", adamc@866: newline, adamc@866: string "PGresult *res = PQexec(conn, \"COMMIT\");", adamc@866: newline, adamc@866: newline, adamc@866: string "if (res == NULL) return 1;", adamc@866: newline, adamc@866: newline, adamc@866: string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {", adamc@866: box [string "PQclear(res);", adamc@866: newline, adamc@866: string "return 1;", adamc@866: newline], adamc@866: string "}", adamc@866: newline, adamc@866: string "return 0;", adamc@866: newline, adamc@866: string "}", adamc@866: newline, adamc@866: newline, adamc@866: adamc@866: string "int uw_db_rollback(uw_context ctx) {", adamc@866: newline, adamc@866: string "PGconn *conn = uw_get_db(ctx);", adamc@866: newline, adamc@866: string "PGresult *res = PQexec(conn, \"ROLLBACK\");", adamc@866: newline, adamc@866: newline, adamc@866: string "if (res == NULL) return 1;", adamc@866: newline, adamc@866: newline, adamc@866: string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {", adamc@866: box [string "PQclear(res);", adamc@866: newline, adamc@866: string "return 1;", adamc@866: newline], adamc@866: string "}", adamc@866: newline, adamc@866: string "return 0;", adamc@866: newline, adamc@866: string "}", adamc@866: newline, adamc@866: newline] adamc@866: else adamc@870: box [string "static void uw_db_validate(uw_context ctx) { }", adamc@870: newline, adamc@870: string "static void uw_db_prepare(uw_context ctx) { }"], adamc@870: adamc@866: newline, adamc@866: newline, adamc@866: adamc@866: string "void uw_db_init(uw_context ctx) {", adamc@866: newline, adamc@866: string "PGconn *conn = PQconnectdb(\"", adamc@866: string (String.toString dbstring), adamc@866: string "\");", adamc@866: newline, adamc@866: string "if (conn == NULL) uw_error(ctx, FATAL, ", adamc@866: string "\"libpq can't allocate a connection.\");", adamc@866: newline, adamc@866: string "if (PQstatus(conn) != CONNECTION_OK) {", adamc@866: newline, adamc@866: box [string "char msg[1024];", adamc@866: newline, adamc@866: string "strncpy(msg, PQerrorMessage(conn), 1024);", adamc@866: newline, adamc@866: string "msg[1023] = 0;", adamc@866: newline, adamc@866: string "PQfinish(conn);", adamc@866: newline, adamc@866: string "uw_error(ctx, BOUNDED_RETRY, ", adamc@866: string "\"Connection to Postgres server failed: %s\", msg);"], adamc@866: newline, adamc@866: string "}", 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: adamc@880: fun p_getcol {loc, wontLeakStrings, col = i, typ = t} = adamc@867: let adamc@867: fun p_unsql t e eLen = adamc@867: case t of adamc@867: Int => box [string "uw_Basis_stringToInt_error(ctx, ", e, string ")"] adamc@867: | Float => box [string "uw_Basis_stringToFloat_error(ctx, ", e, string ")"] adamc@867: | String => adamc@867: if wontLeakStrings then adamc@867: e adamc@867: else adamc@867: box [string "uw_strdup(ctx, ", e, string ")"] adamc@867: | Bool => box [string "uw_Basis_stringToBool_error(ctx, ", e, string ")"] adamc@939: | Time => box [string "uw_Basis_unsqlTime(ctx, ", e, string ")"] adamc@867: | Blob => box [string "uw_Basis_stringToBlob_error(ctx, ", adamc@867: e, adamc@867: string ", ", adamc@867: eLen, adamc@867: string ")"] adamc@867: | Channel => box [string "uw_Basis_stringToChannel_error(ctx, ", e, string ")"] adamc@867: | Client => box [string "uw_Basis_stringToClient_error(ctx, ", e, string ")"] adamc@867: adamc@867: | Nullable _ => raise Fail "Postgres: Recursive Nullable" adamc@867: adamc@867: fun getter t = adamc@867: case t of adamc@867: Nullable t => adamc@867: box [string "(PQgetisnull(res, i, ", adamc@867: string (Int.toString i), adamc@867: string ") ? NULL : ", adamc@867: case t of adamc@867: String => getter t adamc@867: | _ => box [string "({", adamc@867: newline, adamc@874: string (p_sql_ctype t), adamc@867: space, adamc@867: string "*tmp = uw_malloc(ctx, sizeof(", adamc@874: string (p_sql_ctype t), adamc@867: string "));", adamc@867: newline, adamc@867: string "*tmp = ", adamc@867: getter t, adamc@867: string ";", adamc@867: newline, adamc@867: string "tmp;", adamc@867: newline, adamc@867: string "})"], adamc@867: string ")"] adamc@867: | _ => adamc@867: box [string "(PQgetisnull(res, i, ", adamc@867: string (Int.toString i), adamc@867: string ") ? ", adamc@867: box [string "({", adamc@874: string (p_sql_ctype t), adamc@867: space, adamc@867: string "tmp;", adamc@867: newline, adamc@880: string "uw_error(ctx, FATAL, \"", adamc@880: string (ErrorMsg.spanToString loc), adamc@880: string ": Unexpectedly NULL field #", adamc@867: string (Int.toString i), adamc@867: string "\");", adamc@867: newline, adamc@867: string "tmp;", adamc@867: newline, adamc@867: string "})"], adamc@867: string " : ", adamc@867: p_unsql t adamc@867: (box [string "PQgetvalue(res, i, ", adamc@867: string (Int.toString i), adamc@867: string ")"]) adamc@867: (box [string "PQgetlength(res, i, ", adamc@867: string (Int.toString i), adamc@867: string ")"]), adamc@867: string ")"] adamc@867: in adamc@867: getter t adamc@867: end adamc@867: adamc@873: fun queryCommon {loc, query, cols, doCols} = adamc@867: box [string "int n, i;", adamc@867: newline, adamc@867: newline, adamc@867: adamc@867: string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating query result.\");", adamc@867: newline, adamc@867: newline, adamc@867: adamc@867: string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {", adamc@867: newline, adamc@867: box [string "PQclear(res);", adamc@867: newline, adamc@867: string "uw_error(ctx, FATAL, \"", adamc@867: string (ErrorMsg.spanToString loc), adamc@867: string ": Query failed:\\n%s\\n%s\", ", adamc@867: query, adamc@867: string ", PQerrorMessage(conn));", adamc@867: newline], adamc@867: string "}", adamc@867: newline, adamc@867: newline, adamc@867: adamc@867: string "if (PQnfields(res) != ", adamc@873: string (Int.toString (length cols)), adamc@867: string ") {", adamc@867: newline, adamc@867: box [string "int nf = PQnfields(res);", adamc@867: newline, adamc@867: string "PQclear(res);", adamc@867: newline, adamc@867: string "uw_error(ctx, FATAL, \"", adamc@867: string (ErrorMsg.spanToString loc), adamc@867: string ": Query returned %d columns instead of ", adamc@873: string (Int.toString (length cols)), adamc@867: string ":\\n%s\\n%s\", nf, ", adamc@867: query, adamc@867: string ", PQerrorMessage(conn));", adamc@867: newline], adamc@867: string "}", adamc@867: newline, adamc@867: newline, adamc@867: adamc@867: string "uw_end_region(ctx);", adamc@867: newline, adamc@867: string "uw_push_cleanup(ctx, (void (*)(void *))PQclear, res);", adamc@867: newline, adamc@867: string "n = PQntuples(res);", adamc@867: newline, adamc@867: string "for (i = 0; i < n; ++i) {", adamc@867: newline, adamc@867: doCols p_getcol, adamc@867: string "}", adamc@867: newline, adamc@867: newline, adamc@867: string "uw_pop_cleanup(ctx);", adamc@867: newline] adamc@867: adamc@873: fun query {loc, cols, doCols} = adamc@867: box [string "PGconn *conn = uw_get_db(ctx);", adamc@867: newline, adamc@867: string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);", adamc@867: newline, adamc@867: newline, adamc@873: queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"}] adamc@867: adamc@867: fun p_ensql t e = adamc@867: case t of adamc@867: Int => box [string "uw_Basis_attrifyInt(ctx, ", e, string ")"] adamc@867: | Float => box [string "uw_Basis_attrifyFloat(ctx, ", e, string ")"] adamc@867: | String => e adamc@867: | Bool => box [string "(", e, string " ? \"TRUE\" : \"FALSE\")"] adamc@867: | Time => box [string "uw_Basis_attrifyTime(ctx, ", e, string ")"] adamc@867: | Blob => box [e, string ".data"] adamc@867: | Channel => box [string "uw_Basis_attrifyChannel(ctx, ", e, string ")"] adamc@867: | Client => box [string "uw_Basis_attrifyClient(ctx, ", e, string ")"] adamc@867: | Nullable String => e adamc@867: | Nullable t => box [string "(", adamc@867: e, adamc@867: string " == NULL ? NULL : ", adamc@867: p_ensql t (box [string "(*", e, string ")"]), adamc@867: string ")"] adamc@867: adamc@879: fun queryPrepared {loc, id, query, inputs, cols, doCols, nested = _} = adamc@867: box [string "PGconn *conn = uw_get_db(ctx);", adamc@867: newline, adamc@867: string "const int paramFormats[] = { ", adamc@867: p_list_sep (box [string ",", space]) adamc@867: (fn t => if isBlob t then string "1" else string "0") inputs, adamc@867: string " };", adamc@867: newline, adamc@867: string "const int paramLengths[] = { ", adamc@867: p_list_sepi (box [string ",", space]) adamc@867: (fn i => fn Blob => string ("arg" ^ Int.toString (i + 1) ^ ".size") adamc@867: | Nullable Blob => string ("arg" ^ Int.toString (i + 1) adamc@867: ^ "?arg" ^ Int.toString (i + 1) ^ "->size:0") adamc@867: | _ => string "0") inputs, adamc@867: string " };", adamc@867: newline, adamc@867: string "const char *paramValues[] = { ", adamc@867: p_list_sepi (box [string ",", space]) adamc@867: (fn i => fn t => p_ensql t (box [string "arg", adamc@867: string (Int.toString (i + 1))])) adamc@867: inputs, adamc@867: string " };", adamc@867: newline, adamc@867: newline, adamc@867: string "PGresult *res = ", adamc@867: if #persistent (Settings.currentProtocol ()) then adamc@867: box [string "PQexecPrepared(conn, \"uw", adamc@867: string (Int.toString id), adamc@867: string "\", ", adamc@867: string (Int.toString (length inputs)), adamc@867: string ", paramValues, paramLengths, paramFormats, 0);"] adamc@867: else adamc@867: box [string "PQexecParams(conn, \"", adamc@867: string (String.toString query), adamc@867: string "\", ", adamc@867: string (Int.toString (length inputs)), adamc@867: string ", NULL, paramValues, paramLengths, paramFormats, 0);"], adamc@867: newline, adamc@867: newline, adamc@873: queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"", adamc@873: string (String.toString query), adamc@873: string "\""]}] adamc@867: adamc@868: fun dmlCommon {loc, dml} = adamc@868: box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");", adamc@868: newline, adamc@868: newline, adamc@868: adamc@868: string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {", adamc@868: newline, adamc@868: box [string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {", adamc@868: box [newline, adamc@868: string "PQclear(res);", adamc@868: newline, adamc@868: string "uw_error(ctx, UNLIMITED_RETRY, \"Serialization failure\");", adamc@868: newline], adamc@868: string "}", adamc@868: newline, adamc@868: string "PQclear(res);", adamc@868: newline, adamc@868: string "uw_error(ctx, FATAL, \"", adamc@868: string (ErrorMsg.spanToString loc), adamc@868: string ": DML failed:\\n%s\\n%s\", ", adamc@868: dml, adamc@868: string ", PQerrorMessage(conn));", adamc@868: newline], adamc@868: string "}", adamc@868: newline, adamc@868: newline, adamc@868: adamc@868: string "PQclear(res);", adamc@868: newline] adamc@868: adamc@868: fun dml loc = adamc@868: box [string "PGconn *conn = uw_get_db(ctx);", adamc@868: newline, adamc@868: string "PGresult *res = PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);", adamc@868: newline, adamc@868: newline, adamc@868: dmlCommon {loc = loc, dml = string "dml"}] adamc@868: adamc@868: fun dmlPrepared {loc, id, dml, inputs} = adamc@868: box [string "PGconn *conn = uw_get_db(ctx);", adamc@868: newline, adamc@868: string "const int paramFormats[] = { ", adamc@868: p_list_sep (box [string ",", space]) adamc@868: (fn t => if isBlob t then string "1" else string "0") inputs, adamc@868: string " };", adamc@868: newline, adamc@868: string "const int paramLengths[] = { ", adamc@868: p_list_sepi (box [string ",", space]) adamc@868: (fn i => fn Blob => string ("arg" ^ Int.toString (i + 1) ^ ".size") adamc@868: | Nullable Blob => string ("arg" ^ Int.toString (i + 1) adamc@868: ^ "?arg" ^ Int.toString (i + 1) ^ "->size:0") adamc@868: | _ => string "0") inputs, adamc@868: string " };", adamc@868: newline, adamc@868: string "const char *paramValues[] = { ", adamc@868: p_list_sepi (box [string ",", space]) adamc@868: (fn i => fn t => p_ensql t (box [string "arg", adamc@868: string (Int.toString (i + 1))])) adamc@868: inputs, adamc@868: string " };", adamc@868: newline, adamc@868: newline, adamc@868: string "PGresult *res = ", adamc@868: if #persistent (Settings.currentProtocol ()) then adamc@868: box [string "PQexecPrepared(conn, \"uw", adamc@868: string (Int.toString id), adamc@868: string "\", ", adamc@868: string (Int.toString (length inputs)), adamc@868: string ", paramValues, paramLengths, paramFormats, 0);"] adamc@868: else adamc@868: box [string "PQexecParams(conn, \"", adamc@868: string (String.toString dml), adamc@868: string "\", ", adamc@868: string (Int.toString (length inputs)), adamc@868: string ", NULL, paramValues, paramLengths, paramFormats, 0);"], adamc@868: newline, adamc@868: newline, adamc@868: dmlCommon {loc = loc, dml = box [string "\"", adamc@868: string (String.toString dml), adamc@868: string "\""]}] adamc@868: adamc@869: fun nextvalCommon {loc, query} = adamc@869: box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating nextval result.\");", adamc@869: newline, adamc@869: newline, adamc@869: adamc@869: string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {", adamc@869: newline, adamc@869: box [string "PQclear(res);", adamc@869: newline, adamc@869: string "uw_error(ctx, FATAL, \"", adamc@869: string (ErrorMsg.spanToString loc), adamc@869: string ": Query failed:\\n%s\\n%s\", ", adamc@869: query, adamc@869: string ", PQerrorMessage(conn));", adamc@869: newline], adamc@869: string "}", adamc@869: newline, adamc@869: newline, adamc@869: adamc@869: string "n = PQntuples(res);", adamc@869: newline, adamc@869: string "if (n != 1) {", adamc@869: newline, adamc@869: box [string "PQclear(res);", adamc@869: newline, adamc@869: string "uw_error(ctx, FATAL, \"", adamc@869: string (ErrorMsg.spanToString loc), adamc@869: string ": Wrong number of result rows:\\n%s\\n%s\", ", adamc@869: query, adamc@869: string ", PQerrorMessage(conn));", adamc@869: newline], adamc@869: string "}", adamc@869: newline, adamc@869: newline, adamc@869: adamc@869: string "n = uw_Basis_stringToInt_error(ctx, PQgetvalue(res, 0, 0));", adamc@869: newline, adamc@869: string "PQclear(res);", adamc@869: newline] adamc@869: adamc@878: open Cjr adamc@878: adamc@878: fun nextval {loc, seqE, seqName} = adamc@878: let adamc@878: val query = case seqName of adamc@878: SOME s => adamc@879: string ("\"SELECT NEXTVAL('" ^ s ^ "')\"") adamc@878: | _ => box [string "uw_Basis_strcat(ctx, \"SELECT NEXTVAL('\", uw_Basis_strcat(ctx, ", adamc@878: seqE, adamc@878: string ", \"')\"))"] adamc@878: in adamc@878: box [string "char *query = ", adamc@878: query, adamc@878: string ";", adamc@878: newline, adamc@878: string "PGconn *conn = uw_get_db(ctx);", adamc@878: newline, adamc@878: string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);", adamc@878: newline, adamc@878: newline, adamc@878: nextvalCommon {loc = loc, query = string "query"}] adamc@878: end adamc@869: adamc@869: fun nextvalPrepared {loc, id, query} = adamc@869: box [string "PGconn *conn = uw_get_db(ctx);", adamc@869: newline, adamc@869: newline, adamc@869: string "PGresult *res = ", adamc@869: if #persistent (Settings.currentProtocol ()) then adamc@869: box [string "PQexecPrepared(conn, \"uw", adamc@869: string (Int.toString id), adamc@869: string "\", 0, NULL, NULL, NULL, 0);"] adamc@869: else adamc@869: box [string "PQexecParams(conn, \"", adamc@869: string (String.toString query), adamc@869: string "\", 0, NULL, NULL, NULL, NULL, 0);"], adamc@869: newline, adamc@869: newline, adamc@869: nextvalCommon {loc = loc, query = box [string "\"", adamc@869: string (String.toString query), adamc@869: string "\""]}] adamc@869: adamc@874: fun sqlifyString s = "E'" ^ String.translate (fn #"'" => "\\'" adamc@874: | #"\\" => "\\\\" adamc@874: | ch => adamc@874: if Char.isPrint ch then adamc@874: str ch adamc@874: else adamc@874: "\\" ^ StringCvt.padLeft #"0" 3 adamc@874: (Int.fmt StringCvt.OCT (ord ch))) adamc@874: (String.toString s) ^ "'::text" adamc@874: adamc@874: fun p_cast (s, t) = s ^ "::" ^ p_sql_type t adamc@874: adamc@874: fun p_blank (n, t) = p_cast ("$" ^ Int.toString n, t) adamc@874: adamc@866: val () = addDbms {name = "postgres", adamc@866: header = "postgresql/libpq-fe.h", adamc@866: link = "-lpq", adamc@873: p_sql_type = p_sql_type, adamc@867: init = init, 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@874: sqlifyString = sqlifyString, adamc@874: p_cast = p_cast, adamc@874: p_blank = p_blank, adamc@877: supportsDeleteAs = true, adamc@886: supportsUpdateAs = true, adamc@877: createSequence = fn s => "CREATE SEQUENCE " ^ s, adamc@878: textKeysNeedLengths = false, adamc@879: supportsNextval = true, adamc@882: supportsNestedPrepared = true, adamc@890: sqlPrefix = "", adamc@890: supportsOctetLength = true} adamc@874: adamc@866: val () = setDbms "postgres" adamc@866: adamc@866: end