Mercurial > urweb

annotate src/postgres.sml @ 1936:6745eafff617

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Start SQL transactions as read-only when possible, based on conservative program analysis
author Adam Chlipala <adam@chlipala.net>
date Thu, 12 Dec 2013 17:42:48 -0500
parents 2f33d9a51765
children d02c1a0d8082
rev   line source
adam@1295 1 (* Copyright (c) 2008-2010, Adam Chlipala
adamc@866 2 * All rights reserved.
adamc@866 3 *
adamc@866 4 * Redistribution and use in source and binary forms, with or without
adamc@866 5 * modification, are permitted provided that the following conditions are met:
adamc@866 6 *
adamc@866 7 * - Redistributions of source code must retain the above copyright notice,
adamc@866 8 * this list of conditions and the following disclaimer.
adamc@866 9 * - Redistributions in binary form must reproduce the above copyright notice,
adamc@866 10 * this list of conditions and the following disclaimer in the documentation
adamc@866 11 * and/or other materials provided with the distribution.
adamc@866 12 * - The names of contributors may not be used to endorse or promote products
adamc@866 13 * derived from this software without specific prior written permission.
adamc@866 14 *
adamc@866 15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
adamc@866 16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
adamc@866 17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
adamc@866 18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
adam@1682 19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
adamc@866 20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
adamc@866 21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
adamc@866 22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
adamc@866 23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
adamc@866 24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
adamc@866 25 * POSSIBILITY OF SUCH DAMAGE.
adamc@866 26 *)
adamc@866 27
adamc@866 28 structure Postgres :> POSTGRES = struct
adamc@866 29
adamc@866 30 open Settings
adamc@866 31 open Print.PD
adamc@866 32 open Print
adamc@866 33
adamc@870 34 val ident = String.translate (fn #"'" => "PRIME"
adamc@870 35 | ch => str ch)
adamc@870 36
adamc@873 37 fun p_sql_type t =
adamc@873 38 case t of
adamc@873 39 Int => "int8"
adamc@873 40 | Float => "float8"
adamc@873 41 | String => "text"
adamc@1011 42 | Char => "char"
adamc@873 43 | Bool => "bool"
adamc@873 44 | Time => "timestamp"
adamc@873 45 | Blob => "bytea"
adamc@873 46 | Channel => "int8"
adamc@873 47 | Client => "int4"
adamc@873 48 | Nullable t => p_sql_type t
adamc@873 49
adamc@870 50 fun p_sql_type_base t =
adamc@870 51 case t of
adamc@871 52 Int => "bigint"
adamc@871 53 | Float => "double precision"
adamc@870 54 | String => "text"
adamc@1011 55 | Char => "character"
adamc@871 56 | Bool => "boolean"
adamc@871 57 | Time => "timestamp without time zone"
adamc@870 58 | Blob => "bytea"
adamc@871 59 | Channel => "bigint"
adamc@871 60 | Client => "integer"
adamc@870 61 | Nullable t => p_sql_type_base t
adamc@870 62
adamc@872 63 fun checkRel (table, checkNullable) (s, xts) =
adamc@871 64 let
adamc@871 65 val sl = CharVector.map Char.toLower s
adamc@871 66
adamc@872 67 val q = "SELECT COUNT(*) FROM information_schema." ^ table ^ " WHERE table_name = '"
adamc@871 68 ^ sl ^ "'"
adamc@871 69
adamc@871 70 val q' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE table_name = '",
adamc@871 71 sl,
adamc@871 72 "' AND (",
adam@1600 73 case String.concatWith " OR "
adam@1600 74 (map (fn (x, t) =>
adam@1600 75 String.concat ["(column_name = 'uw_",
adam@1600 76 CharVector.map
adam@1600 77 Char.toLower (ident x),
adam@1600 78 (case p_sql_type_base t of
adam@1600 79 "bigint" =>
adam@1600 80 "' AND data_type IN ('bigint', 'numeric')"
adam@1600 81 | t =>
adam@1600 82 String.concat ["' AND data_type = '",
adam@1600 83 t,
adam@1600 84 "'"]),
adam@1600 85 if checkNullable then
adam@1600 86 (" AND is_nullable = '"
adam@1600 87 ^ (if isNotNull t then
adam@1600 88 "NO"
adam@1600 89 else
adam@1600 90 "YES")
adam@1600 91 ^ "'")
adam@1600 92 else
adam@1600 93 "",
adam@1600 94 ")"]) xts) of
adam@1600 95 "" => "FALSE"
adam@1600 96 | s => s,
adamc@871 97 ")"]
adamc@871 98
adamc@871 99 val q'' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE table_name = '",
adamc@871 100 sl,
adamc@871 101 "' AND column_name LIKE 'uw_%'"]
adamc@871 102 in
adamc@871 103 box [string "res = PQexec(conn, \"",
adamc@871 104 string q,
adamc@871 105 string "\");",
adamc@871 106 newline,
adamc@871 107 newline,
adamc@871 108 string "if (res == NULL) {",
adamc@871 109 newline,
adamc@871 110 box [string "PQfinish(conn);",
adamc@871 111 newline,
adamc@871 112 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
adamc@871 113 newline],
adamc@871 114 string "}",
adamc@871 115 newline,
adamc@871 116 newline,
adamc@871 117 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@871 118 newline,
adamc@871 119 box [string "char msg[1024];",
adamc@871 120 newline,
adamc@871 121 string "strncpy(msg, PQerrorMessage(conn), 1024);",
adamc@871 122 newline,
adamc@871 123 string "msg[1023] = 0;",
adamc@871 124 newline,
adamc@871 125 string "PQclear(res);",
adamc@871 126 newline,
adamc@871 127 string "PQfinish(conn);",
adamc@871 128 newline,
adamc@871 129 string "uw_error(ctx, FATAL, \"Query failed:\\n",
adamc@871 130 string q,
adamc@871 131 string "\\n%s\", msg);",
adamc@871 132 newline],
adamc@871 133 string "}",
adamc@871 134 newline,
adamc@871 135 newline,
adamc@871 136 string "if (strcmp(PQgetvalue(res, 0, 0), \"1\")) {",
adamc@871 137 newline,
adamc@871 138 box [string "PQclear(res);",
adamc@871 139 newline,
adamc@871 140 string "PQfinish(conn);",
adamc@871 141 newline,
adamc@871 142 string "uw_error(ctx, FATAL, \"Table '",
adamc@871 143 string s,
adamc@871 144 string "' does not exist.\");",
adamc@871 145 newline],
adamc@871 146 string "}",
adamc@871 147 newline,
adamc@871 148 newline,
adamc@871 149 string "PQclear(res);",
adamc@871 150 newline,
adamc@871 151
adamc@871 152 string "res = PQexec(conn, \"",
adamc@871 153 string q',
adamc@871 154 string "\");",
adamc@871 155 newline,
adamc@871 156 newline,
adamc@871 157 string "if (res == NULL) {",
adamc@871 158 newline,
adamc@871 159 box [string "PQfinish(conn);",
adamc@871 160 newline,
adamc@871 161 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
adamc@871 162 newline],
adamc@871 163 string "}",
adamc@871 164 newline,
adamc@871 165 newline,
adamc@871 166 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@871 167 newline,
adamc@871 168 box [string "char msg[1024];",
adamc@871 169 newline,
adamc@871 170 string "strncpy(msg, PQerrorMessage(conn), 1024);",
adamc@871 171 newline,
adamc@871 172 string "msg[1023] = 0;",
adamc@871 173 newline,
adamc@871 174 string "PQclear(res);",
adamc@871 175 newline,
adamc@871 176 string "PQfinish(conn);",
adamc@871 177 newline,
adamc@871 178 string "uw_error(ctx, FATAL, \"Query failed:\\n",
adamc@871 179 string q',
adamc@871 180 string "\\n%s\", msg);",
adamc@871 181 newline],
adamc@871 182 string "}",
adamc@871 183 newline,
adamc@871 184 newline,
adamc@871 185 string "if (strcmp(PQgetvalue(res, 0, 0), \"",
adamc@871 186 string (Int.toString (length xts)),
adamc@871 187 string "\")) {",
adamc@871 188 newline,
adamc@871 189 box [string "PQclear(res);",
adamc@871 190 newline,
adamc@871 191 string "PQfinish(conn);",
adamc@871 192 newline,
adamc@871 193 string "uw_error(ctx, FATAL, \"Table '",
adamc@871 194 string s,
adamc@871 195 string "' has the wrong column types.\");",
adamc@871 196 newline],
adamc@871 197 string "}",
adamc@871 198 newline,
adamc@871 199 newline,
adamc@871 200 string "PQclear(res);",
adamc@871 201 newline,
adamc@871 202 newline,
adamc@871 203
adamc@871 204 string "res = PQexec(conn, \"",
adamc@871 205 string q'',
adamc@871 206 string "\");",
adamc@871 207 newline,
adamc@871 208 newline,
adamc@871 209 string "if (res == NULL) {",
adamc@871 210 newline,
adamc@871 211 box [string "PQfinish(conn);",
adamc@871 212 newline,
adamc@871 213 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
adamc@871 214 newline],
adamc@871 215 string "}",
adamc@871 216 newline,
adamc@871 217 newline,
adamc@871 218 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@871 219 newline,
adamc@871 220 box [string "char msg[1024];",
adamc@871 221 newline,
adamc@871 222 string "strncpy(msg, PQerrorMessage(conn), 1024);",
adamc@871 223 newline,
adamc@871 224 string "msg[1023] = 0;",
adamc@871 225 newline,
adamc@871 226 string "PQclear(res);",
adamc@871 227 newline,
adamc@871 228 string "PQfinish(conn);",
adamc@871 229 newline,
adamc@871 230 string "uw_error(ctx, FATAL, \"Query failed:\\n",
adamc@871 231 string q'',
adamc@871 232 string "\\n%s\", msg);",
adamc@871 233 newline],
adamc@871 234 string "}",
adamc@871 235 newline,
adamc@871 236 newline,
adamc@871 237 string "if (strcmp(PQgetvalue(res, 0, 0), \"",
adamc@871 238 string (Int.toString (length xts)),
adamc@871 239 string "\")) {",
adamc@871 240 newline,
adamc@871 241 box [string "PQclear(res);",
adamc@871 242 newline,
adamc@871 243 string "PQfinish(conn);",
adamc@871 244 newline,
adamc@871 245 string "uw_error(ctx, FATAL, \"Table '",
adamc@871 246 string s,
adamc@871 247 string "' has extra columns.\");",
adamc@871 248 newline],
adamc@871 249 string "}",
adamc@871 250 newline,
adamc@871 251 newline,
adamc@871 252 string "PQclear(res);",
adamc@871 253 newline]
adamc@871 254 end
adamc@871 255
adamc@872 256 fun init {dbstring, prepared = ss, tables, views, sequences} =
adamc@866 257 box [if #persistent (currentProtocol ()) then
adamc@1094 258 box [string "static void uw_db_validate(uw_context ctx) {",
adamc@870 259 newline,
adamc@870 260 string "PGconn *conn = uw_get_db(ctx);",
adamc@870 261 newline,
adamc@870 262 string "PGresult *res;",
adamc@870 263 newline,
adamc@870 264 newline,
adamc@872 265 p_list_sep newline (checkRel ("tables", true)) tables,
adamc@872 266 p_list_sep newline (checkRel ("views", false)) views,
adamc@870 267
adamc@870 268 p_list_sep newline
adamc@870 269 (fn s =>
adamc@870 270 let
adamc@870 271 val sl = CharVector.map Char.toLower s
adamc@870 272
adamc@870 273 val q = "SELECT COUNT(*) FROM pg_class WHERE relname = '"
adamc@870 274 ^ sl ^ "' AND relkind = 'S'"
adamc@870 275 in
adamc@870 276 box [string "res = PQexec(conn, \"",
adamc@870 277 string q,
adamc@870 278 string "\");",
adamc@870 279 newline,
adamc@870 280 newline,
adamc@870 281 string "if (res == NULL) {",
adamc@870 282 newline,
adamc@870 283 box [string "PQfinish(conn);",
adamc@870 284 newline,
adamc@870 285 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
adamc@870 286 newline],
adamc@870 287 string "}",
adamc@870 288 newline,
adamc@870 289 newline,
adamc@870 290 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@870 291 newline,
adamc@870 292 box [string "char msg[1024];",
adamc@870 293 newline,
adamc@870 294 string "strncpy(msg, PQerrorMessage(conn), 1024);",
adamc@870 295 newline,
adamc@870 296 string "msg[1023] = 0;",
adamc@870 297 newline,
adamc@870 298 string "PQclear(res);",
adamc@870 299 newline,
adamc@870 300 string "PQfinish(conn);",
adamc@870 301 newline,
adamc@870 302 string "uw_error(ctx, FATAL, \"Query failed:\\n",
adamc@870 303 string q,
adamc@870 304 string "\\n%s\", msg);",
adamc@870 305 newline],
adamc@870 306 string "}",
adamc@870 307 newline,
adamc@870 308 newline,
adamc@870 309 string "if (strcmp(PQgetvalue(res, 0, 0), \"1\")) {",
adamc@870 310 newline,
adamc@870 311 box [string "PQclear(res);",
adamc@870 312 newline,
adamc@870 313 string "PQfinish(conn);",
adamc@870 314 newline,
adamc@870 315 string "uw_error(ctx, FATAL, \"Sequence '",
adamc@870 316 string s,
adamc@870 317 string "' does not exist.\");",
adamc@870 318 newline],
adamc@870 319 string "}",
adamc@870 320 newline,
adamc@870 321 newline,
adamc@870 322 string "PQclear(res);",
adamc@870 323 newline]
adamc@870 324 end) sequences,
adamc@870 325
adamc@870 326 string "}",
adamc@870 327
adamc@870 328 string "static void uw_db_prepare(uw_context ctx) {",
adamc@866 329 newline,
adamc@866 330 string "PGconn *conn = uw_get_db(ctx);",
adamc@866 331 newline,
adamc@866 332 string "PGresult *res;",
adamc@866 333 newline,
adamc@866 334 newline,
adamc@866 335
adamc@866 336 p_list_sepi newline (fn i => fn (s, n) =>
adamc@866 337 box [string "res = PQprepare(conn, \"uw",
adamc@866 338 string (Int.toString i),
adamc@866 339 string "\", \"",
adam@1656 340 string (Prim.toCString s),
adamc@866 341 string "\", ",
adamc@866 342 string (Int.toString n),
adamc@866 343 string ", NULL);",
adamc@866 344 newline,
adamc@866 345 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@866 346 newline,
adamc@866 347 box [string "char msg[1024];",
adamc@866 348 newline,
adamc@866 349 string "strncpy(msg, PQerrorMessage(conn), 1024);",
adamc@866 350 newline,
adamc@866 351 string "msg[1023] = 0;",
adamc@866 352 newline,
adamc@866 353 string "PQclear(res);",
adamc@866 354 newline,
adamc@866 355 string "PQfinish(conn);",
adamc@866 356 newline,
adamc@866 357 string "uw_error(ctx, FATAL, \"Unable to create prepared statement:\\n",
adam@1656 358 string (Prim.toCString s),
adamc@866 359 string "\\n%s\", msg);",
adamc@866 360 newline],
adamc@866 361 string "}",
adamc@866 362 newline,
adamc@866 363 string "PQclear(res);",
adamc@866 364 newline])
adamc@866 365 ss,
adamc@866 366
adamc@866 367 string "}",
adamc@866 368 newline,
adamc@866 369 newline]
adamc@866 370 else
adamc@870 371 box [string "static void uw_db_validate(uw_context ctx) { }",
adamc@870 372 newline,
adamc@870 373 string "static void uw_db_prepare(uw_context ctx) { }"],
adamc@870 374
adamc@1094 375 string "static void uw_client_init(void) {",
adamc@1094 376 newline,
adamc@1094 377 box [string "uw_sqlfmtInt = \"%lld::int8%n\";",
adamc@1094 378 newline,
adam@1920 379 string "uw_sqlfmtFloat = \"%.16g::float8%n\";",
adamc@1094 380 newline,
adamc@1094 381 string "uw_Estrings = 1;",
adamc@1094 382 newline,
adam@1834 383 string "uw_sql_type_annotations = 1;",
adam@1834 384 newline,
adamc@1094 385 string "uw_sqlsuffixString = \"::text\";",
adamc@1094 386 newline,
adamc@1094 387 string "uw_sqlsuffixChar = \"::char\";",
adamc@1094 388 newline,
adamc@1094 389 string "uw_sqlsuffixBlob = \"::bytea\";",
adamc@1094 390 newline,
adamc@1094 391 string "uw_sqlfmtUint4 = \"%u::int4%n\";",
adamc@1094 392 newline],
adamc@1094 393 string "}",
adamc@866 394 newline,
adamc@866 395 newline,
adamc@866 396
adamc@1094 397 string "static void uw_db_close(uw_context ctx) {",
adamc@1094 398 newline,
adamc@1094 399 string "PQfinish(uw_get_db(ctx));",
adamc@1094 400 newline,
adamc@1094 401 string "}",
adamc@1094 402 newline,
adamc@1094 403 newline,
adamc@1094 404
adam@1936 405 string "static int uw_db_begin(uw_context ctx, int could_write) {",
adamc@1094 406 newline,
adamc@1094 407 string "PGconn *conn = uw_get_db(ctx);",
adamc@1094 408 newline,
adam@1936 409 string "PGresult *res = PQexec(conn, could_write ? \"BEGIN ISOLATION LEVEL SERIALIZABLE\" : \"BEGIN ISOLATION LEVEL SERIALIZABLE, READ ONLY\");",
adamc@1094 410 newline,
adamc@1094 411 newline,
adamc@1094 412 string "if (res == NULL) return 1;",
adamc@1094 413 newline,
adamc@1094 414 newline,
adamc@1094 415 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@1094 416 box [string "PQclear(res);",
adamc@1094 417 newline,
adamc@1094 418 string "return 1;",
adamc@1094 419 newline],
adamc@1094 420 string "}",
adamc@1094 421 newline,
adamc@1144 422 string "PQclear(res);",
adamc@1144 423 newline,
adamc@1094 424 string "return 0;",
adamc@1094 425 newline,
adamc@1094 426 string "}",
adamc@1094 427 newline,
adamc@1094 428 newline,
adamc@1094 429
adamc@1094 430 string "static int uw_db_commit(uw_context ctx) {",
adamc@1094 431 newline,
adamc@1094 432 string "PGconn *conn = uw_get_db(ctx);",
adamc@1094 433 newline,
adamc@1094 434 string "PGresult *res = PQexec(conn, \"COMMIT\");",
adamc@1094 435 newline,
adamc@1094 436 newline,
adamc@1094 437 string "if (res == NULL) return 1;",
adamc@1094 438 newline,
adamc@1094 439 newline,
adamc@1094 440 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@1094 441 box [string "PQclear(res);",
adamc@1094 442 newline,
adamc@1094 443 string "return 1;",
adamc@1094 444 newline],
adamc@1094 445 string "}",
adamc@1094 446 newline,
adamc@1144 447 string "PQclear(res);",
adamc@1144 448 newline,
adamc@1094 449 string "return 0;",
adamc@1094 450 newline,
adamc@1094 451 string "}",
adamc@1094 452 newline,
adamc@1094 453 newline,
adamc@1094 454
adamc@1094 455 string "static int uw_db_rollback(uw_context ctx) {",
adamc@1094 456 newline,
adamc@1094 457 string "PGconn *conn = uw_get_db(ctx);",
adamc@1094 458 newline,
adamc@1094 459 string "PGresult *res = PQexec(conn, \"ROLLBACK\");",
adamc@1094 460 newline,
adamc@1094 461 newline,
adamc@1094 462 string "if (res == NULL) return 1;",
adamc@1094 463 newline,
adamc@1094 464 newline,
adamc@1094 465 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@1094 466 box [string "PQclear(res);",
adamc@1094 467 newline,
adamc@1094 468 string "return 1;",
adamc@1094 469 newline],
adamc@1094 470 string "}",
adamc@1094 471 newline,
adamc@1144 472 string "PQclear(res);",
adamc@1144 473 newline,
adamc@1094 474 string "return 0;",
adamc@1094 475 newline,
adamc@1094 476 string "}",
adamc@1094 477
adamc@1094 478 newline,
adamc@1094 479 newline,
adamc@1094 480
adamc@1094 481 string "static void uw_db_init(uw_context ctx) {",
adamc@866 482 newline,
as@1564 483 string "char *env_db_str = getenv(\"URWEB_PQ_CON\");",
as@1564 484 newline,
as@1564 485 string "PGconn *conn = PQconnectdb(env_db_str == NULL ? \"",
adam@1656 486 string (Prim.toCString dbstring),
as@1564 487 string "\" : env_db_str);",
adamc@866 488 newline,
adamc@866 489 string "if (conn == NULL) uw_error(ctx, FATAL, ",
adamc@866 490 string "\"libpq can't allocate a connection.\");",
adamc@866 491 newline,
adamc@866 492 string "if (PQstatus(conn) != CONNECTION_OK) {",
adamc@866 493 newline,
adamc@866 494 box [string "char msg[1024];",
adamc@866 495 newline,
adamc@866 496 string "strncpy(msg, PQerrorMessage(conn), 1024);",
adamc@866 497 newline,
adamc@866 498 string "msg[1023] = 0;",
adamc@866 499 newline,
adamc@866 500 string "PQfinish(conn);",
adamc@866 501 newline,
adamc@866 502 string "uw_error(ctx, BOUNDED_RETRY, ",
adamc@866 503 string "\"Connection to Postgres server failed: %s\", msg);"],
adamc@866 504 newline,
adamc@866 505 string "}",
adamc@866 506 newline,
adamc@866 507 string "uw_set_db(ctx, conn);",
adamc@866 508 newline,
adamc@866 509 string "uw_db_validate(ctx);",
adamc@866 510 newline,
adamc@866 511 string "uw_db_prepare(ctx);",
adamc@866 512 newline,
adamc@866 513 string "}"]
adamc@866 514
adamc@880 515 fun p_getcol {loc, wontLeakStrings, col = i, typ = t} =
adamc@867 516 let
adamc@867 517 fun p_unsql t e eLen =
adamc@867 518 case t of
adamc@867 519 Int => box [string "uw_Basis_stringToInt_error(ctx, ", e, string ")"]
adamc@867 520 | Float => box [string "uw_Basis_stringToFloat_error(ctx, ", e, string ")"]
adamc@867 521 | String =>
adamc@867 522 if wontLeakStrings then
adamc@867 523 e
adamc@867 524 else
adamc@867 525 box [string "uw_strdup(ctx, ", e, string ")"]
adamc@1011 526 | Char => box [e, string "[0]"]
adamc@867 527 | Bool => box [string "uw_Basis_stringToBool_error(ctx, ", e, string ")"]
adamc@939 528 | Time => box [string "uw_Basis_unsqlTime(ctx, ", e, string ")"]
adamc@867 529 | Blob => box [string "uw_Basis_stringToBlob_error(ctx, ",
adamc@867 530 e,
adamc@867 531 string ", ",
adamc@867 532 eLen,
adamc@867 533 string ")"]
adamc@867 534 | Channel => box [string "uw_Basis_stringToChannel_error(ctx, ", e, string ")"]
adamc@867 535 | Client => box [string "uw_Basis_stringToClient_error(ctx, ", e, string ")"]
adamc@867 536
adamc@867 537 | Nullable _ => raise Fail "Postgres: Recursive Nullable"
adamc@867 538
adamc@867 539 fun getter t =
adamc@867 540 case t of
adamc@867 541 Nullable t =>
adamc@867 542 box [string "(PQgetisnull(res, i, ",
adamc@867 543 string (Int.toString i),
adamc@867 544 string ") ? NULL : ",
adamc@867 545 case t of
adamc@867 546 String => getter t
adamc@867 547 | _ => box [string "({",
adamc@867 548 newline,
adamc@874 549 string (p_sql_ctype t),
adamc@867 550 space,
adamc@867 551 string "*tmp = uw_malloc(ctx, sizeof(",
adamc@874 552 string (p_sql_ctype t),
adamc@867 553 string "));",
adamc@867 554 newline,
adamc@867 555 string "*tmp = ",
adamc@867 556 getter t,
adamc@867 557 string ";",
adamc@867 558 newline,
adamc@867 559 string "tmp;",
adamc@867 560 newline,
adamc@867 561 string "})"],
adamc@867 562 string ")"]
adamc@867 563 | _ =>
adamc@867 564 box [string "(PQgetisnull(res, i, ",
adamc@867 565 string (Int.toString i),
adamc@867 566 string ") ? ",
adamc@867 567 box [string "({",
adamc@874 568 string (p_sql_ctype t),
adamc@867 569 space,
adamc@867 570 string "tmp;",
adamc@867 571 newline,
adamc@880 572 string "uw_error(ctx, FATAL, \"",
adamc@880 573 string (ErrorMsg.spanToString loc),
adamc@880 574 string ": Unexpectedly NULL field #",
adamc@867 575 string (Int.toString i),
adamc@867 576 string "\");",
adamc@867 577 newline,
adamc@867 578 string "tmp;",
adamc@867 579 newline,
adamc@867 580 string "})"],
adamc@867 581 string " : ",
adamc@867 582 p_unsql t
adamc@867 583 (box [string "PQgetvalue(res, i, ",
adamc@867 584 string (Int.toString i),
adamc@867 585 string ")"])
adamc@867 586 (box [string "PQgetlength(res, i, ",
adamc@867 587 string (Int.toString i),
adamc@867 588 string ")"]),
adamc@867 589 string ")"]
adamc@867 590 in
adamc@867 591 getter t
adamc@867 592 end
adamc@867 593
adamc@873 594 fun queryCommon {loc, query, cols, doCols} =
adamc@867 595 box [string "int n, i;",
adamc@867 596 newline,
adamc@867 597 newline,
adamc@867 598
adamc@867 599 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
adamc@867 600 newline,
adamc@867 601 newline,
adamc@867 602
adamc@867 603 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@867 604 newline,
adam@1918 605 box [string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {",
adam@1918 606 box [newline,
adam@1918 607 string "PQclear(res);",
adam@1918 608 newline,
adam@1918 609 string "uw_error(ctx, UNLIMITED_RETRY, \"Serialization failure\");",
adam@1918 610 newline],
adam@1918 611 string "}",
adam@1918 612 newline,
adam@1918 613 string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40P01\")) {",
adam@1918 614 box [newline,
adam@1918 615 string "PQclear(res);",
adam@1918 616 newline,
adam@1918 617 string "uw_error(ctx, UNLIMITED_RETRY, \"Deadlock detected\");",
adam@1918 618 newline],
adam@1918 619 string "}",
adam@1918 620 newline,
adam@1918 621 string "PQclear(res);",
adamc@867 622 newline,
adamc@867 623 string "uw_error(ctx, FATAL, \"",
adamc@867 624 string (ErrorMsg.spanToString loc),
adamc@867 625 string ": Query failed:\\n%s\\n%s\", ",
adamc@867 626 query,
adamc@867 627 string ", PQerrorMessage(conn));",
adamc@867 628 newline],
adamc@867 629 string "}",
adamc@867 630 newline,
adamc@867 631 newline,
adamc@867 632
adamc@867 633 string "if (PQnfields(res) != ",
adamc@873 634 string (Int.toString (length cols)),
adamc@867 635 string ") {",
adamc@867 636 newline,
adamc@867 637 box [string "int nf = PQnfields(res);",
adamc@867 638 newline,
adamc@867 639 string "PQclear(res);",
adamc@867 640 newline,
adamc@867 641 string "uw_error(ctx, FATAL, \"",
adamc@867 642 string (ErrorMsg.spanToString loc),
adamc@867 643 string ": Query returned %d columns instead of ",
adamc@873 644 string (Int.toString (length cols)),
adamc@867 645 string ":\\n%s\\n%s\", nf, ",
adamc@867 646 query,
adamc@867 647 string ", PQerrorMessage(conn));",
adamc@867 648 newline],
adamc@867 649 string "}",
adamc@867 650 newline,
adamc@867 651 newline,
adamc@867 652
adamc@867 653 string "uw_end_region(ctx);",
adamc@867 654 newline,
adamc@867 655 string "uw_push_cleanup(ctx, (void (*)(void *))PQclear, res);",
adamc@867 656 newline,
adamc@867 657 string "n = PQntuples(res);",
adamc@867 658 newline,
adamc@867 659 string "for (i = 0; i < n; ++i) {",
adamc@867 660 newline,
adamc@867 661 doCols p_getcol,
adamc@867 662 string "}",
adamc@867 663 newline,
adamc@867 664 newline,
adamc@867 665 string "uw_pop_cleanup(ctx);",
adam@1682 666 newline]
adamc@867 667
adamc@873 668 fun query {loc, cols, doCols} =
adamc@867 669 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@867 670 newline,
adamc@867 671 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
adamc@867 672 newline,
adamc@867 673 newline,
adamc@873 674 queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"}]
adamc@867 675
adamc@867 676 fun p_ensql t e =
adamc@867 677 case t of
adamc@867 678 Int => box [string "uw_Basis_attrifyInt(ctx, ", e, string ")"]
adamc@867 679 | Float => box [string "uw_Basis_attrifyFloat(ctx, ", e, string ")"]
adamc@867 680 | String => e
adamc@1011 681 | Char => box [string "uw_Basis_attrifyChar(ctx, ", e, string ")"]
adamc@867 682 | Bool => box [string "(", e, string " ? \"TRUE\" : \"FALSE\")"]
adam@1364 683 | Time => box [string "uw_Basis_ensqlTime(ctx, ", e, string ")"]
adamc@867 684 | Blob => box [e, string ".data"]
adamc@867 685 | Channel => box [string "uw_Basis_attrifyChannel(ctx, ", e, string ")"]
adamc@867 686 | Client => box [string "uw_Basis_attrifyClient(ctx, ", e, string ")"]
adamc@867 687 | Nullable String => e
adamc@867 688 | Nullable t => box [string "(",
adamc@867 689 e,
adamc@867 690 string " == NULL ? NULL : ",
adamc@867 691 p_ensql t (box [string "(*", e, string ")"]),
adamc@867 692 string ")"]
adamc@867 693
adam@1431 694 fun makeParams inputs =
adam@1431 695 box [string "static const int paramFormats[] = { ",
adamc@867 696 p_list_sep (box [string ",", space])
adamc@867 697 (fn t => if isBlob t then string "1" else string "0") inputs,
adamc@867 698 string " };",
adamc@867 699 newline,
adam@1431 700 if List.exists isBlob inputs then
adam@1650 701 box [string "int *paramLengths = uw_malloc(ctx, ",
adam@1431 702 string (Int.toString (length inputs)),
adam@1431 703 string " * sizeof(int));",
adam@1431 704 newline,
adam@1431 705 p_list_sepi (box [])
adam@1431 706 (fn i => fn t =>
adam@1431 707 box [string "paramLengths[",
adam@1431 708 string (Int.toString i),
adam@1431 709 string "] = ",
adam@1431 710 case t of
adam@1431 711 Blob => string ("arg" ^ Int.toString (i + 1) ^ ".size")
adam@1431 712 | Nullable Blob => string ("arg" ^ Int.toString (i + 1)
adam@1431 713 ^ "?arg" ^ Int.toString (i + 1) ^ "->size:0")
adam@1431 714 | _ => string "0",
adam@1431 715 string ";",
adam@1431 716 newline]) inputs,
adam@1431 717 newline]
adam@1431 718 else
adam@1431 719 box [string "const int *paramLengths = paramFormats;",
adam@1431 720 newline],
adam@1431 721
adam@1431 722 string "const char **paramValues = uw_malloc(ctx, ",
adam@1431 723 string (Int.toString (length inputs)),
adam@1431 724 string " * sizeof(char*));",
adamc@867 725 newline,
adam@1431 726 p_list_sepi (box [])
adam@1431 727 (fn i => fn t => box [string "paramValues[",
adam@1431 728 string (Int.toString i),
adam@1431 729 string "] = ",
adam@1431 730 p_ensql t (box [string "arg",
adam@1431 731 string (Int.toString (i + 1))]),
adam@1431 732 string ";",
adam@1431 733 newline])
adamc@867 734 inputs,
adam@1431 735 newline]
adam@1431 736
adam@1431 737 fun queryPrepared {loc, id, query, inputs, cols, doCols, nested = _} =
adam@1431 738 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@867 739 newline,
adam@1431 740
adam@1431 741 makeParams inputs,
adam@1431 742
adamc@867 743 newline,
adamc@867 744 string "PGresult *res = ",
adamc@867 745 if #persistent (Settings.currentProtocol ()) then
adamc@867 746 box [string "PQexecPrepared(conn, \"uw",
adamc@867 747 string (Int.toString id),
adamc@867 748 string "\", ",
adamc@867 749 string (Int.toString (length inputs)),
adamc@867 750 string ", paramValues, paramLengths, paramFormats, 0);"]
adamc@867 751 else
adamc@867 752 box [string "PQexecParams(conn, \"",
adam@1656 753 string (Prim.toCString query),
adamc@867 754 string "\", ",
adamc@867 755 string (Int.toString (length inputs)),
adamc@867 756 string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
adamc@867 757 newline,
adamc@867 758 newline,
adamc@873 759 queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
adam@1656 760 string (Prim.toCString query),
adamc@873 761 string "\""]}]
adamc@867 762
adam@1293 763 fun dmlCommon {loc, dml, mode} =
adamc@868 764 box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
adamc@868 765 newline,
adamc@868 766 newline,
adamc@868 767
adamc@868 768 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@868 769 newline,
adamc@868 770 box [string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {",
adamc@868 771 box [newline,
adamc@868 772 string "PQclear(res);",
adamc@868 773 newline,
adamc@868 774 string "uw_error(ctx, UNLIMITED_RETRY, \"Serialization failure\");",
adamc@868 775 newline],
adamc@868 776 string "}",
adamc@868 777 newline,
adam@1550 778 string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40P01\")) {",
adam@1550 779 box [newline,
adam@1550 780 string "PQclear(res);",
adam@1550 781 newline,
adam@1550 782 string "uw_error(ctx, UNLIMITED_RETRY, \"Deadlock detected\");",
adam@1550 783 newline],
adam@1550 784 string "}",
adam@1550 785 newline,
adam@1293 786 case mode of
adam@1918 787 Settings.Error => box [string "PQclear(res);",
adam@1293 788 newline,
adam@1293 789 string "uw_error(ctx, FATAL, \"",
adam@1293 790 string (ErrorMsg.spanToString loc),
adam@1918 791 string ": DML failed:\\n%s\\n%s\", ",
adam@1293 792 dml,
adam@1918 793 string ", PQerrorMessage(conn));"]
adam@1295 794 | Settings.None => box [string "uw_set_error_message(ctx, PQerrorMessage(conn));",
adam@1295 795 newline,
adam@1295 796 newline,
adam@1295 797
adam@1295 798 string "res = PQexec(conn, \"ROLLBACK TO s\");",
adam@1295 799 newline,
adam@1295 800 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
adam@1295 801 newline,
adam@1295 802 newline,
adam@1295 803
adam@1295 804 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adam@1295 805 newline,
adam@1295 806 box [string "PQclear(res);",
adam@1295 807 newline,
adam@1295 808 string "uw_error(ctx, FATAL, \"",
adam@1295 809 string (ErrorMsg.spanToString loc),
adam@1295 810 string ": ROLLBACK TO failed:\\n%s\\n%s\", ",
adam@1295 811 dml,
adam@1295 812 string ", PQerrorMessage(conn));",
adam@1295 813 newline,
adam@1295 814 string "}"],
adam@1295 815 newline,
adam@1295 816
adam@1295 817 string "PQclear(res);",
adam@1295 818 newline],
adamc@868 819 newline],
adamc@868 820 string "}",
adamc@868 821
adam@1295 822 case mode of
adam@1295 823 Error => box [newline,
adam@1295 824 newline,
adam@1295 825 string "PQclear(res);",
adam@1295 826 newline]
adam@1295 827 | None => box[string " else {",
adam@1295 828 newline,
adam@1295 829 box [string "PQclear(res);",
adam@1295 830 newline,
adam@1295 831 string "res = PQexec(conn, \"RELEASE s\");",
adam@1295 832 newline,
adam@1295 833 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
adam@1295 834 newline,
adam@1295 835 newline,
adam@1295 836
adam@1295 837 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adam@1295 838 newline,
adam@1295 839 box [string "PQclear(res);",
adam@1295 840 newline,
adam@1295 841 string "uw_error(ctx, FATAL, \"",
adam@1295 842 string (ErrorMsg.spanToString loc),
adam@1295 843 string ": RELEASE failed:\\n%s\\n%s\", ",
adam@1295 844 dml,
adam@1295 845 string ", PQerrorMessage(conn));",
adam@1295 846 newline],
adam@1295 847 string "}",
adam@1295 848 newline,
adam@1295 849 string "PQclear(res);",
adam@1295 850 newline],
adam@1295 851 string "}",
adam@1295 852 newline]]
adam@1295 853
adam@1295 854 fun makeSavepoint mode =
adam@1295 855 case mode of
adam@1295 856 Error => box []
adam@1295 857 | None => box [string "res = PQexec(conn, \"SAVEPOINT s\");",
adam@1295 858 newline,
adam@1295 859 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
adam@1295 860 newline,
adam@1295 861 newline,
adam@1295 862 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adam@1295 863 box [newline,
adam@1295 864 string "PQclear(res);",
adam@1295 865 newline,
adam@1295 866 string "uw_error(ctx, FATAL, \"Error creating SAVEPOINT\");",
adam@1295 867 newline],
adam@1295 868 string "}",
adam@1295 869 newline,
adam@1295 870 string "PQclear(res);",
adam@1295 871 newline,
adam@1295 872 newline]
adamc@868 873
adam@1293 874 fun dml (loc, mode) =
adamc@868 875 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@868 876 newline,
adam@1295 877 string "PGresult *res;",
adam@1295 878 newline,
adam@1295 879
adam@1295 880 makeSavepoint mode,
adam@1295 881
adam@1295 882 string "res = PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);",
adamc@868 883 newline,
adamc@868 884 newline,
adam@1293 885 dmlCommon {loc = loc, dml = string "dml", mode = mode}]
adamc@868 886
adam@1293 887 fun dmlPrepared {loc, id, dml, inputs, mode} =
adamc@868 888 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@868 889 newline,
adam@1431 890
adam@1431 891 makeParams inputs,
adam@1431 892
adamc@868 893 newline,
adam@1295 894 string "PGresult *res;",
adam@1295 895 newline,
adam@1295 896 newline,
adam@1295 897
adam@1295 898 makeSavepoint mode,
adam@1295 899
adam@1295 900 string "res = ",
adamc@868 901 if #persistent (Settings.currentProtocol ()) then
adamc@868 902 box [string "PQexecPrepared(conn, \"uw",
adamc@868 903 string (Int.toString id),
adamc@868 904 string "\", ",
adamc@868 905 string (Int.toString (length inputs)),
adamc@868 906 string ", paramValues, paramLengths, paramFormats, 0);"]
adamc@868 907 else
adamc@868 908 box [string "PQexecParams(conn, \"",
adam@1656 909 string (Prim.toCString dml),
adamc@868 910 string "\", ",
adamc@868 911 string (Int.toString (length inputs)),
adamc@868 912 string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
adamc@868 913 newline,
adamc@868 914 newline,
adamc@868 915 dmlCommon {loc = loc, dml = box [string "\"",
adam@1656 916 string (Prim.toCString dml),
adam@1293 917 string "\""], mode = mode}]
adamc@868 918
adamc@869 919 fun nextvalCommon {loc, query} =
adamc@869 920 box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating nextval result.\");",
adamc@869 921 newline,
adamc@869 922 newline,
adamc@869 923
adamc@869 924 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@869 925 newline,
adamc@869 926 box [string "PQclear(res);",
adamc@869 927 newline,
adamc@869 928 string "uw_error(ctx, FATAL, \"",
adamc@869 929 string (ErrorMsg.spanToString loc),
adamc@869 930 string ": Query failed:\\n%s\\n%s\", ",
adamc@869 931 query,
adamc@869 932 string ", PQerrorMessage(conn));",
adamc@869 933 newline],
adamc@869 934 string "}",
adamc@869 935 newline,
adamc@869 936 newline,
adamc@869 937
adamc@869 938 string "n = PQntuples(res);",
adamc@869 939 newline,
adamc@869 940 string "if (n != 1) {",
adamc@869 941 newline,
adamc@869 942 box [string "PQclear(res);",
adamc@869 943 newline,
adamc@869 944 string "uw_error(ctx, FATAL, \"",
adamc@869 945 string (ErrorMsg.spanToString loc),
adamc@869 946 string ": Wrong number of result rows:\\n%s\\n%s\", ",
adamc@869 947 query,
adamc@869 948 string ", PQerrorMessage(conn));",
adamc@869 949 newline],
adamc@869 950 string "}",
adamc@869 951 newline,
adamc@869 952 newline,
adamc@869 953
adamc@869 954 string "n = uw_Basis_stringToInt_error(ctx, PQgetvalue(res, 0, 0));",
adamc@869 955 newline,
adamc@869 956 string "PQclear(res);",
adamc@869 957 newline]
adamc@869 958
adamc@878 959 open Cjr
adamc@878 960
adamc@878 961 fun nextval {loc, seqE, seqName} =
adamc@878 962 let
adamc@878 963 val query = case seqName of
adamc@878 964 SOME s =>
adamc@879 965 string ("\"SELECT NEXTVAL('" ^ s ^ "')\"")
adamc@878 966 | _ => box [string "uw_Basis_strcat(ctx, \"SELECT NEXTVAL('\", uw_Basis_strcat(ctx, ",
adamc@878 967 seqE,
adamc@878 968 string ", \"')\"))"]
adamc@878 969 in
adamc@878 970 box [string "char *query = ",
adamc@878 971 query,
adamc@878 972 string ";",
adamc@878 973 newline,
adamc@878 974 string "PGconn *conn = uw_get_db(ctx);",
adamc@878 975 newline,
adamc@878 976 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
adamc@878 977 newline,
adamc@878 978 newline,
adamc@878 979 nextvalCommon {loc = loc, query = string "query"}]
adamc@878 980 end
adamc@869 981
adamc@869 982 fun nextvalPrepared {loc, id, query} =
adamc@869 983 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@869 984 newline,
adamc@869 985 newline,
adamc@869 986 string "PGresult *res = ",
adamc@869 987 if #persistent (Settings.currentProtocol ()) then
adamc@869 988 box [string "PQexecPrepared(conn, \"uw",
adamc@869 989 string (Int.toString id),
adamc@869 990 string "\", 0, NULL, NULL, NULL, 0);"]
adamc@869 991 else
adamc@869 992 box [string "PQexecParams(conn, \"",
adam@1656 993 string (Prim.toCString query),
adamc@869 994 string "\", 0, NULL, NULL, NULL, NULL, 0);"],
adamc@869 995 newline,
adamc@869 996 newline,
adamc@869 997 nextvalCommon {loc = loc, query = box [string "\"",
adam@1656 998 string (Prim.toCString query),
adamc@869 999 string "\""]}]
adamc@869 1000
adamc@1073 1001 fun setvalCommon {loc, query} =
adamc@1073 1002 box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating setval result.\");",
adamc@1073 1003 newline,
adamc@1073 1004 newline,
adamc@1073 1005
adamc@1073 1006 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@1073 1007 newline,
adamc@1073 1008 box [string "PQclear(res);",
adamc@1073 1009 newline,
adamc@1073 1010 string "uw_error(ctx, FATAL, \"",
adamc@1073 1011 string (ErrorMsg.spanToString loc),
adamc@1073 1012 string ": Query failed:\\n%s\\n%s\", ",
adamc@1073 1013 query,
adamc@1073 1014 string ", PQerrorMessage(conn));",
adamc@1073 1015 newline],
adamc@1073 1016 string "}",
adamc@1073 1017 newline,
adamc@1073 1018 newline,
adamc@1073 1019
adamc@1073 1020 string "PQclear(res);",
adamc@1073 1021 newline]
adamc@1073 1022
adamc@1073 1023 fun setval {loc, seqE, count} =
adamc@1073 1024 let
adamc@1073 1025 val query = box [string "uw_Basis_strcat(ctx, \"SELECT SETVAL('\", uw_Basis_strcat(ctx, ",
adamc@1073 1026 seqE,
adamc@1073 1027 string ", uw_Basis_strcat(ctx, \"', \", uw_Basis_strcat(ctx, uw_Basis_sqlifyInt(ctx, ",
adamc@1073 1028 count,
adamc@1073 1029 string "), \")\"))))"]
adamc@1073 1030 in
adamc@1073 1031 box [string "char *query = ",
adamc@1073 1032 query,
adamc@1073 1033 string ";",
adamc@1073 1034 newline,
adamc@1073 1035 string "PGconn *conn = uw_get_db(ctx);",
adamc@1073 1036 newline,
adamc@1073 1037 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
adamc@1073 1038 newline,
adamc@1073 1039 newline,
adamc@1073 1040 setvalCommon {loc = loc, query = string "query"}]
adamc@1073 1041 end
adamc@1073 1042
adamc@874 1043 fun sqlifyString s = "E'" ^ String.translate (fn #"'" => "\\'"
adamc@874 1044 | #"\\" => "\\\\"
adamc@874 1045 | ch =>
adamc@874 1046 if Char.isPrint ch then
adamc@874 1047 str ch
adamc@874 1048 else
adamc@874 1049 "\\" ^ StringCvt.padLeft #"0" 3
adamc@874 1050 (Int.fmt StringCvt.OCT (ord ch)))
adam@1656 1051 (Prim.toCString s) ^ "'::text"
adamc@874 1052
adamc@874 1053 fun p_cast (s, t) = s ^ "::" ^ p_sql_type t
adamc@874 1054
adamc@874 1055 fun p_blank (n, t) = p_cast ("$" ^ Int.toString n, t)
adamc@874 1056
adamc@866 1057 val () = addDbms {name = "postgres",
adam@1682 1058 randomFunction = "RANDOM",
adam@1464 1059 header = Config.pgheader,
adamc@866 1060 link = "-lpq",
adamc@873 1061 p_sql_type = p_sql_type,
adamc@867 1062 init = init,
adamc@867 1063 query = query,
adamc@868 1064 queryPrepared = queryPrepared,
adamc@868 1065 dml = dml,
adamc@869 1066 dmlPrepared = dmlPrepared,
adamc@869 1067 nextval = nextval,
adamc@874 1068 nextvalPrepared = nextvalPrepared,
adamc@1073 1069 setval = setval,
adamc@874 1070 sqlifyString = sqlifyString,
adamc@874 1071 p_cast = p_cast,
adamc@874 1072 p_blank = p_blank,
adamc@877 1073 supportsDeleteAs = true,
adamc@886 1074 supportsUpdateAs = true,
adamc@877 1075 createSequence = fn s => "CREATE SEQUENCE " ^ s,
adamc@878 1076 textKeysNeedLengths = false,
adamc@879 1077 supportsNextval = true,
adamc@882 1078 supportsNestedPrepared = true,
adamc@890 1079 sqlPrefix = "",
adamc@1014 1080 supportsOctetLength = true,
adamc@1014 1081 trueString = "TRUE",
adamc@1196 1082 falseString = "FALSE",
adamc@1196 1083 onlyUnion = false,
adam@1777 1084 nestedRelops = true,
adam@1777 1085 windowFunctions = true}
adamc@874 1086
adamc@866 1087 val () = setDbms "postgres"
adamc@866 1088
adamc@866 1089 end