adam@2177: (* Copyright (c) 2008-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 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@1011:       | Char => "char"
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@1011:       | Char => "character"
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
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
adamc@871: 
adam@1958:         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 (",
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@1600:                                                                                (case p_sql_type_base t of
adam@1600:                                                                                     "bigint" =>
adam@1953:                                                                                     "' AND data_type IN ('bigint', 'numeric', 'integer')"
adam@1953:                                                                                   | "text" =>
adam@1953:                                                                                     "' AND data_type IN ('text', 'character varying')"                                                                          
adam@1600:                                                                                   | t =>
adam@1600:                                                                                     String.concat ["' AND data_type = '",
adam@1600:                                                                                                    t,
adam@1600:                                                                                                    "'"]),
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@871:                                 ")"]
adamc@871: 
adamc@871:         val q'' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE table_name = '",
adamc@871:                                  sl,
adam@1953:                                  "' AND LOWER(column_name) LIKE '", Settings.mangleSqlCatalog "%'"]
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 '",
adam@1953:                   string sl,
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 '",
adam@1953:                   string sl,
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 '",
adam@1953:                   string sl,
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@1094:              box [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: 
adam@2103:                   p_list_sepi newline (fn i => fn (s, _) =>
adamc@866:                                                   box [string "res = PQprepare(conn, \"uw",
adamc@866:                                                        string (Int.toString i),
adamc@866:                                                        string "\", \"",
adam@1656:                                                        string (Prim.toCString s),
adam@2103:                                                        string "\", 0, 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",
adam@1656:                                                             string (Prim.toCString 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:          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@1094:          string "static void uw_client_init(void) {",
adamc@1094:          newline,
adamc@1094:          box [string "uw_sqlfmtInt = \"%lld::int8%n\";",
adamc@1094:               newline,
adam@1920:               string "uw_sqlfmtFloat = \"%.16g::float8%n\";",
adamc@1094:               newline,
adamc@1094:               string "uw_Estrings = 1;",
adamc@1094:               newline,
adam@1834:               string "uw_sql_type_annotations = 1;",
adam@1834:               newline,
adamc@1094:               string "uw_sqlsuffixString = \"::text\";",
adamc@1094:               newline,
adamc@1094:               string "uw_sqlsuffixChar = \"::char\";",
adamc@1094:               newline,
adamc@1094:               string "uw_sqlsuffixBlob = \"::bytea\";",
adamc@1094:               newline,
adamc@1094:               string "uw_sqlfmtUint4 = \"%u::int4%n\";",
adamc@1094:               newline],
adamc@1094:          string "}",
adamc@866:          newline,
adamc@866:          newline,
adamc@866: 
adamc@1094:          string "static void uw_db_close(uw_context ctx) {",
adamc@1094:          newline,
adamc@1094:          string "PQfinish(uw_get_db(ctx));",
adamc@1094:          newline,
adamc@1094:          string "}",
adamc@1094:          newline,
adamc@1094:          newline,
adamc@1094: 
adam@1936:          string "static int uw_db_begin(uw_context ctx, int could_write) {",
adamc@1094:          newline,
adamc@1094:          string "PGconn *conn = uw_get_db(ctx);",
adamc@1094:          newline,
adam@1936:          string "PGresult *res = PQexec(conn, could_write ? \"BEGIN ISOLATION LEVEL SERIALIZABLE\" : \"BEGIN ISOLATION LEVEL SERIALIZABLE, READ ONLY\");",
adamc@1094:          newline,
adamc@1094:          newline,
adamc@1094:          string "if (res == NULL) return 1;",
adamc@1094:          newline,
adamc@1094:          newline,
adamc@1094:          string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@1094:          box [string "PQclear(res);",
adamc@1094:               newline,
adamc@1094:               string "return 1;",
adamc@1094:               newline],
adamc@1094:          string "}",
adamc@1094:          newline,
adamc@1144:          string "PQclear(res);",
adamc@1144:          newline,
adamc@1094:          string "return 0;",
adamc@1094:          newline,
adamc@1094:          string "}",
adamc@1094:          newline,
adamc@1094:          newline,
adamc@1094: 
adamc@1094:          string "static int uw_db_commit(uw_context ctx) {",
adamc@1094:          newline,
adamc@1094:          string "PGconn *conn = uw_get_db(ctx);",
adamc@1094:          newline,
adamc@1094:          string "PGresult *res = PQexec(conn, \"COMMIT\");",
adamc@1094:          newline,
adamc@1094:          newline,
adamc@1094:          string "if (res == NULL) return 1;",
adamc@1094:          newline,
adamc@1094:          newline,
adamc@1094:          string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adam@1938:          box [string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {",
adam@1938:               box [newline,
adam@1938:                    string "PQclear(res);",
adam@1938:                    newline,
adam@1938:                    string "return -1;",
adam@1938:                    newline],
adam@1938:               string "}",
adam@1938:               newline,
adam@1938:               string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40P01\")) {",
adam@1938:               box [newline,
adam@1938:                    string "PQclear(res);",
adam@1938:                    newline,
adam@1938:                    string "return -1;",
adam@1938:                    newline],
adam@1938:               string "}",
adam@1938:               newline,
adam@1938: 	      string "PQclear(res);",
adamc@1094:               newline,
adamc@1094:               string "return 1;",
adamc@1094:               newline],
adamc@1094:          string "}",
adamc@1094:          newline,
adamc@1144:          string "PQclear(res);",
adamc@1144:          newline,
adamc@1094:          string "return 0;",
adamc@1094:          newline,
adamc@1094:          string "}",
adamc@1094:          newline,
adamc@1094:          newline,
adamc@1094: 
adamc@1094:          string "static int uw_db_rollback(uw_context ctx) {",
adamc@1094:          newline,
adamc@1094:          string "PGconn *conn = uw_get_db(ctx);",
adamc@1094:          newline,
adamc@1094:          string "PGresult *res = PQexec(conn, \"ROLLBACK\");",
adamc@1094:          newline,
adamc@1094:          newline,
adamc@1094:          string "if (res == NULL) return 1;",
adamc@1094:          newline,
adamc@1094:          newline,
adamc@1094:          string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@1094:          box [string "PQclear(res);",
adamc@1094:               newline,
adamc@1094:               string "return 1;",
adamc@1094:               newline],
adamc@1094:          string "}",
adamc@1094:          newline,
adamc@1144:          string "PQclear(res);",
adamc@1144:          newline,
adamc@1094:          string "return 0;",
adamc@1094:          newline,
adamc@1094:          string "}",
adamc@1094: 
adamc@1094:          newline,
adamc@1094:          newline,
adamc@1094: 
adamc@1094:          string "static void uw_db_init(uw_context ctx) {",
adamc@866:          newline,
as@1564:          string "char *env_db_str = getenv(\"URWEB_PQ_CON\");",
as@1564: 	 newline,
as@1564:          string "PGconn *conn = PQconnectdb(env_db_str == NULL ? \"",
adam@1656:          string (Prim.toCString dbstring),
as@1564:          string "\" : env_db_str);",
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,
adam@2177:               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@1011:               | Char => box [e, string "[0]"]
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: 
adam@2177: fun queryCommon {loc, query, cols, doCols} =
adamc@867:     box [string "int n, i;",
adamc@867:          newline,
adamc@867:          newline,
adamc@867: 
adam@2176:          string "if (res == NULL) {",
adam@2176:          box [newline,
adam@2177:               string "uw_try_reconnecting_and_restarting(ctx);",
adam@2176:               newline,
adam@2177:               string "uw_error(ctx, FATAL, \"Can't allocate query result; database server may be down.\");",
adam@2176:               newline],
adam@2176:          string "}",
adamc@867:          newline,
adamc@867:          newline,
adamc@867: 
adamc@867:          string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@867:          newline,
adam@1918:          box [string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {",
adam@1918:               box [newline,
adam@1918:                    string "PQclear(res);",
adam@1918:                    newline,
adam@1918:                    string "uw_error(ctx, UNLIMITED_RETRY, \"Serialization failure\");",
adam@1918:                    newline],
adam@1918:               string "}",
adam@1918:               newline,
adam@1918:               string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40P01\")) {",
adam@1918:               box [newline,
adam@1918:                    string "PQclear(res);",
adam@1918:                    newline,
adam@1918:                    string "uw_error(ctx, UNLIMITED_RETRY, \"Deadlock detected\");",
adam@1918:                    newline],
adam@1918:               string "}",
adam@1918:               newline,
adam@1918:               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);",
adam@1682:          newline]
adamc@867: 
adamc@873: fun query {loc, cols, doCols} =
adam@2177:     box [string "PGconn *conn = uw_get_db(ctx);",
adam@2177:          newline,
adam@2177:          string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
adam@2177:          newline,
adam@2177:          newline,
adam@2177:          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@1011:       | Char => box [string "uw_Basis_attrifyChar(ctx, ", e, string ")"]
adamc@867:       | Bool => box [string "(", e, string " ? \"TRUE\" : \"FALSE\")"]
adam@1364:       | Time => box [string "uw_Basis_ensqlTime(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: 
adam@1431: fun makeParams inputs =
adam@1431:     box [string "static 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,
adam@1431:          if List.exists isBlob inputs then
adam@1650:              box [string "int *paramLengths = uw_malloc(ctx, ",
adam@1431:                   string (Int.toString (length inputs)),
adam@1431:                   string " * sizeof(int));",
adam@1431:                   newline,
adam@1431:                   p_list_sepi (box [])
adam@1431:                               (fn i => fn t =>
adam@1431:                                           box [string "paramLengths[",
adam@1431:                                                string (Int.toString i),
adam@1431:                                                string "] = ",
adam@1431:                                                case t of
adam@1431:                                                    Blob => string ("arg" ^ Int.toString (i + 1) ^ ".size")
adam@1431:                                                  | Nullable Blob => string ("arg" ^ Int.toString (i + 1)
adam@1431:                                                                             ^ "?arg" ^ Int.toString (i + 1) ^ "->size:0")
adam@1431:                                                  | _ => string "0",
adam@1431:                                                string ";",
adam@1431:                                                newline]) inputs,
adam@1431:                   newline]
adam@1431:          else
adam@1431:              box [string "const int *paramLengths = paramFormats;",
adam@1431:                   newline],
adam@1431: 
adam@1431:          string "const char **paramValues = uw_malloc(ctx, ",
adam@1431:          string (Int.toString (length inputs)),
adam@1431:          string " * sizeof(char*));",
adamc@867:          newline,
adam@1431:          p_list_sepi (box [])
adam@1431:                      (fn i => fn t => box [string "paramValues[",
adam@1431:                                            string (Int.toString i),
adam@1431:                                            string "] = ",
adam@1431:                                            p_ensql t (box [string "arg",
adam@1431:                                                            string (Int.toString (i + 1))]),
adam@1431:                                            string ";",
adam@1431:                                            newline])
adamc@867:                      inputs,
adam@1431:          newline]
adam@1431: 
adam@1431: fun queryPrepared {loc, id, query, inputs, cols, doCols, nested = _} =
adam@2177:     box [string "PGconn *conn = uw_get_db(ctx);",
adam@2177:          newline,
adam@1431: 
adam@2177:          makeParams inputs,
adam@2177: 
adam@2177:          newline,
adam@2177:          string "PGresult *res = ",
adam@2177:          if #persistent (Settings.currentProtocol ()) then
adam@2177:              box [string "PQexecPrepared(conn, \"uw",
adam@2177:                   string (Int.toString id),
adam@2177:                   string "\", ",
adam@2177:                   string (Int.toString (length inputs)),
adam@2177:                   string ", paramValues, paramLengths, paramFormats, 0);"]
adam@2177:          else
adam@2177:              box [string "PQexecParams(conn, \"",
adam@2177:                   string (Prim.toCString query),
adam@2177:                   string "\", ",
adam@2177:                   string (Int.toString (length inputs)),
adam@2177:                   string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
adam@2177:          newline,
adam@2177:          newline,
adam@2177:          queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
adam@2177:                                                                             string (Prim.toCString query),
adam@2177:                                                                             string "\""]}]
adam@2177: 
adam@2177: fun dmlCommon {loc, dml, mode} =
adam@2176:     box [string "if (res == NULL) {",
adam@2176:          box [newline,
adam@2177:               string "uw_try_reconnecting_and_restarting(ctx);",
adam@2176:               newline,
adam@2177:               string "uw_error(ctx, FATAL, \"Can't allocate DML result; database server may be down.\");",
adam@2176:               newline],
adam@2176:          string "}",
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,
adam@1550:               string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40P01\")) {",
adam@1550:               box [newline,
adam@1550:                    string "PQclear(res);",
adam@1550:                    newline,
adam@1550:                    string "uw_error(ctx, UNLIMITED_RETRY, \"Deadlock detected\");",
adam@1550:                    newline],
adam@1550:               string "}",
adam@1550:               newline,
adam@1293:               case mode of
adam@1918:                   Settings.Error => box [string "PQclear(res);",
adam@1293:                                          newline,
adam@1293:                                          string "uw_error(ctx, FATAL, \"",
adam@1293:                                          string (ErrorMsg.spanToString loc),
adam@1918:                                          string ": DML failed:\\n%s\\n%s\", ",
adam@1293:                                          dml,
adam@1918:                                          string ", PQerrorMessage(conn));"]
adam@1295:                 | Settings.None => box [string "uw_set_error_message(ctx, PQerrorMessage(conn));",
adam@1295:                                         newline,
adam@1295:                                         newline,
adam@1295: 
adam@1295:                                         string "res = PQexec(conn, \"ROLLBACK TO s\");",
adam@1295:                                         newline,
adam@2176:                                         string "if (res == NULL) {",
adam@2176:                                         box [newline,
adam@2177:                                              string "uw_try_reconnecting_and_restarting(ctx);",
adam@2177:                                              newline,
adam@2177:                                              string "uw_error(ctx, FATAL, \"Can't allocate DML ROLLBACK result; database server may be down.\");",
adam@2176:                                              newline],
adam@2176:                                         string "}",
adam@1295:                                         newline,
adam@1295:                                         newline,
adam@1295: 
adam@1295:                                         string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adam@1295:                                         newline,
adam@1295:                                         box [string "PQclear(res);",
adam@1295:                                              newline,
adam@1295:                                              string "uw_error(ctx, FATAL, \"",
adam@1295:                                              string (ErrorMsg.spanToString loc),
adam@1295:                                              string ": ROLLBACK TO failed:\\n%s\\n%s\", ",
adam@1295:                                              dml,
adam@1295:                                              string ", PQerrorMessage(conn));",
adam@1295:                                              newline,
adam@1295:                                              string "}"],
adam@1295:                                         newline,
adam@1295: 
adam@1295:                                         string "PQclear(res);",
adam@1295:                                         newline],
adamc@868:               newline],
adamc@868:          string "}",
adamc@868: 
adam@1295:          case mode of
adam@1295:              Error => box [newline,
adam@1295:                            newline,
adam@1295:                            string "PQclear(res);",
adam@1295:                            newline]
adam@1295:            | None => box[string " else {",
adam@1295:                          newline,
adam@1295:                          box [string "PQclear(res);",
adam@1295:                               newline,
adam@1295:                               string "res = PQexec(conn, \"RELEASE s\");",
adam@1295:                               newline,
adam@2177:                               string "if (res == NULL) {",
adam@2177:                               box [newline,
adam@2177:                                    string "uw_try_reconnecting_and_restarting(ctx);",
adam@2177:                                    newline,
adam@2177:                                    string "uw_error(ctx, FATAL, \"Can't allocate DML RELEASE result; database server may be down.\");",
adam@2177:                                    newline],
adam@2177:                               string "}",
adam@1295:                               newline,
adam@1295:                               newline,
adam@1295: 
adam@1295:                               string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adam@1295:                               newline,
adam@1295:                               box [string "PQclear(res);",
adam@1295:                                    newline,
adam@1295:                                    string "uw_error(ctx, FATAL, \"",
adam@1295:                                    string (ErrorMsg.spanToString loc),
adam@1295:                                    string ": RELEASE failed:\\n%s\\n%s\", ",
adam@1295:                                    dml,
adam@1295:                                    string ", PQerrorMessage(conn));",
adam@1295:                                    newline],
adam@1295:                               string "}",
adam@1295:                               newline,
adam@1295:                               string "PQclear(res);",
adam@1295:                               newline],
adam@1295:                          string "}",
adam@1295:                          newline]]
adam@1295: 
adam@1295: fun makeSavepoint mode =
adam@1295:     case mode of
adam@1295:         Error => box []
adam@1295:       | None => box [string "res = PQexec(conn, \"SAVEPOINT s\");",
adam@1295:                      newline,
adam@2177:                      string "if (res == NULL) {",
adam@2177:                      box [newline,
adam@2177:                           string "uw_try_reconnecting_and_restarting(ctx);",
adam@2177:                           newline,
adam@2177:                           string "uw_error(ctx, FATAL, \"Can't allocate DML SAVEPOINT result; database server may be down.\");",
adam@2177:                           newline],
adam@2177:                      string "}",
adam@1295:                      newline,
adam@1295:                      newline,
adam@1295:                      string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adam@1295:                      box [newline,
adam@1295:                           string "PQclear(res);",
adam@1295:                           newline,
adam@1295:                           string "uw_error(ctx, FATAL, \"Error creating SAVEPOINT\");",
adam@1295:                           newline],
adam@1295:                      string "}",
adam@1295:                      newline,
adam@1295:                      string "PQclear(res);",
adam@1295:                      newline,
adam@1295:                      newline]
adamc@868: 
adam@1293: fun dml (loc, mode) =
adam@2177:     box [string "PGconn *conn = uw_get_db(ctx);",
adam@2177:          newline,
adam@2177:          string "PGresult *res;",
adam@2177:          newline,
adam@1295: 
adam@2177:          makeSavepoint mode,
adam@1295: 
adam@2177:          string "res = PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);",
adam@2177:          newline,
adam@2177:          newline,
adam@2177:          dmlCommon {loc = loc, dml = string "dml", mode = mode}]
adamc@868: 
adam@1293: fun dmlPrepared {loc, id, dml, inputs, mode} =
adam@2177:     box [string "PGconn *conn = uw_get_db(ctx);",
adam@2177:          newline,
adam@1431: 
adam@2177:          makeParams inputs,
adam@1431: 
adam@2177:          newline,
adam@2177:          string "PGresult *res;",
adam@2177:          newline,
adam@2177:          newline,
adam@1295: 
adam@2177:          makeSavepoint mode,
adam@1295: 
adam@2177:          string "res = ",
adam@2177:          if #persistent (Settings.currentProtocol ()) then
adam@2177:              box [string "PQexecPrepared(conn, \"uw",
adam@2177:                   string (Int.toString id),
adam@2177:                   string "\", ",
adam@2177:                   string (Int.toString (length inputs)),
adam@2177:                   string ", paramValues, paramLengths, paramFormats, 0);"]
adam@2177:          else
adam@2177:              box [string "PQexecParams(conn, \"",
adam@2177:                   string (Prim.toCString dml),
adam@2177:                   string "\", ",
adam@2177:                   string (Int.toString (length inputs)),
adam@2177:                   string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
adam@2177:          newline,
adam@2177:          newline,
adam@2177:          dmlCommon {loc = loc, dml = box [string "\"",
adam@2177:                                           string (Prim.toCString dml),
adam@2177:                                           string "\""], mode = mode}]
adamc@868: 
adam@2177: fun nextvalCommon {loc, query} =
adam@2176:     box [string "if (res == NULL) {",
adam@2176:          box [newline,
adam@2177:               string "uw_try_reconnecting_and_restarting(ctx);",
adam@2176:               newline,
adam@2177:               string "uw_error(ctx, FATAL, \"Can't allocate NEXTVAL result; database server may be down.\");",
adam@2176:               newline],
adam@2176:          string "}",
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,
adam@2177:              string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
adamc@878:              newline,
adamc@878:              newline,
adam@2177:              nextvalCommon {loc = loc, query = string "query"}]
adamc@878:     end
adamc@869: 
adamc@869: fun nextvalPrepared {loc, id, query} =
adam@2177:     box [string "PGconn *conn = uw_get_db(ctx);",
adam@2177:          newline,
adam@2177:          newline,
adam@2177:          string "PGresult *res = ",
adam@2177:          if #persistent (Settings.currentProtocol ()) then
adam@2177:              box [string "PQexecPrepared(conn, \"uw",
adam@2177:                   string (Int.toString id),
adam@2177:                   string "\", 0, NULL, NULL, NULL, 0);"]
adam@2177:          else
adam@2177:              box [string "PQexecParams(conn, \"",
adam@2177:                   string (Prim.toCString query),
adam@2177:                   string "\", 0, NULL, NULL, NULL, NULL, 0);"],
adam@2177:          newline,
adam@2177:          newline,
adam@2177:          nextvalCommon {loc = loc, query = box [string "\"",
adam@2177:                                                 string (Prim.toCString query),
adam@2177:                                                 string "\""]}]
adamc@869: 
adam@2177: fun setvalCommon {loc, query} =
adam@2176:     box [string "if (res == NULL) {",
adam@2176:          box [newline,
adam@2177:               string "uw_try_reconnecting_and_restarting(ctx);",
adam@2176:               newline,
adam@2177:               string "uw_error(ctx, FATAL, \"Can't allocate SETVAL result; database server may be down.\");",
adam@2176:               newline],
adam@2176:          string "}",
adamc@1073:          newline,
adamc@1073:          newline,
adamc@1073: 
adamc@1073:          string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@1073:          newline,
adamc@1073:          box [string "PQclear(res);",
adamc@1073:               newline,
adamc@1073:               string "uw_error(ctx, FATAL, \"",
adamc@1073:               string (ErrorMsg.spanToString loc),
adamc@1073:               string ": Query failed:\\n%s\\n%s\", ",
adamc@1073:               query,
adamc@1073:               string ", PQerrorMessage(conn));",
adamc@1073:               newline],
adamc@1073:          string "}",
adamc@1073:          newline,
adamc@1073:          newline,
adamc@1073: 
adamc@1073:          string "PQclear(res);",
adamc@1073:          newline]
adamc@1073: 
adamc@1073: fun setval {loc, seqE, count} =
adamc@1073:     let
adamc@1073:         val query = box [string "uw_Basis_strcat(ctx, \"SELECT SETVAL('\", uw_Basis_strcat(ctx, ",
adamc@1073:                          seqE,
adamc@1073:                          string ", uw_Basis_strcat(ctx, \"', \", uw_Basis_strcat(ctx, uw_Basis_sqlifyInt(ctx, ",
adamc@1073:                          count,
adamc@1073:                          string "), \")\"))))"]
adamc@1073:     in
adamc@1073:         box [string "char *query = ",
adamc@1073:              query,
adamc@1073:              string ";",
adamc@1073:              newline,
adamc@1073:              string "PGconn *conn = uw_get_db(ctx);",
adamc@1073:              newline,
adam@2177:              string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
adamc@1073:              newline,
adamc@1073:              newline,
adam@2177:              setvalCommon {loc = loc, query = string "query"}]
adamc@1073:     end
adamc@1073: 
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)))
adam@1656:                                              (Prim.toCString 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",
adam@1682:                   randomFunction = "RANDOM",
adam@1464:                   header = Config.pgheader,
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@1073:                   setval = setval,
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@1014:                   supportsOctetLength = true,
adamc@1014:                   trueString = "TRUE",
adamc@1196:                   falseString = "FALSE",
adamc@1196:                   onlyUnion = false,
adam@1777:                   nestedRelops = true,
adam@1777:                   windowFunctions = true}
adamc@874: 
adamc@866: val () = setDbms "postgres"
adamc@866: 
adamc@866: end