Mercurial > urweb

annotate src/postgres.sml @ 1856:3683d1a8c1c8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add Sigcheck phase to avoid issues with signatures in global initializers
author Adam Chlipala <adam@chlipala.net>
date Sat, 15 Jun 2013 08:18:47 -0400
parents 690638bd9fef
children e2345c438f08
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,
adamc@1094 379 string "uw_sqlfmtFloat = \"%g::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
adamc@1094 405 string "static int uw_db_begin(uw_context ctx) {",
adamc@1094 406 newline,
adamc@1094 407 string "PGconn *conn = uw_get_db(ctx);",
adamc@1094 408 newline,
adamc@1094 409 string "PGresult *res = PQexec(conn, \"BEGIN ISOLATION LEVEL SERIALIZABLE\");",
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,
adamc@867 605 box [string "PQclear(res);",
adamc@867 606 newline,
adamc@867 607 string "uw_error(ctx, FATAL, \"",
adamc@867 608 string (ErrorMsg.spanToString loc),
adamc@867 609 string ": Query failed:\\n%s\\n%s\", ",
adamc@867 610 query,
adamc@867 611 string ", PQerrorMessage(conn));",
adamc@867 612 newline],
adamc@867 613 string "}",
adamc@867 614 newline,
adamc@867 615 newline,
adamc@867 616
adamc@867 617 string "if (PQnfields(res) != ",
adamc@873 618 string (Int.toString (length cols)),
adamc@867 619 string ") {",
adamc@867 620 newline,
adamc@867 621 box [string "int nf = PQnfields(res);",
adamc@867 622 newline,
adamc@867 623 string "PQclear(res);",
adamc@867 624 newline,
adamc@867 625 string "uw_error(ctx, FATAL, \"",
adamc@867 626 string (ErrorMsg.spanToString loc),
adamc@867 627 string ": Query returned %d columns instead of ",
adamc@873 628 string (Int.toString (length cols)),
adamc@867 629 string ":\\n%s\\n%s\", nf, ",
adamc@867 630 query,
adamc@867 631 string ", PQerrorMessage(conn));",
adamc@867 632 newline],
adamc@867 633 string "}",
adamc@867 634 newline,
adamc@867 635 newline,
adamc@867 636
adamc@867 637 string "uw_end_region(ctx);",
adamc@867 638 newline,
adamc@867 639 string "uw_push_cleanup(ctx, (void (*)(void *))PQclear, res);",
adamc@867 640 newline,
adamc@867 641 string "n = PQntuples(res);",
adamc@867 642 newline,
adamc@867 643 string "for (i = 0; i < n; ++i) {",
adamc@867 644 newline,
adamc@867 645 doCols p_getcol,
adamc@867 646 string "}",
adamc@867 647 newline,
adamc@867 648 newline,
adamc@867 649 string "uw_pop_cleanup(ctx);",
adam@1682 650 newline]
adamc@867 651
adamc@873 652 fun query {loc, cols, doCols} =
adamc@867 653 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@867 654 newline,
adamc@867 655 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
adamc@867 656 newline,
adamc@867 657 newline,
adamc@873 658 queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"}]
adamc@867 659
adamc@867 660 fun p_ensql t e =
adamc@867 661 case t of
adamc@867 662 Int => box [string "uw_Basis_attrifyInt(ctx, ", e, string ")"]
adamc@867 663 | Float => box [string "uw_Basis_attrifyFloat(ctx, ", e, string ")"]
adamc@867 664 | String => e
adamc@1011 665 | Char => box [string "uw_Basis_attrifyChar(ctx, ", e, string ")"]
adamc@867 666 | Bool => box [string "(", e, string " ? \"TRUE\" : \"FALSE\")"]
adam@1364 667 | Time => box [string "uw_Basis_ensqlTime(ctx, ", e, string ")"]
adamc@867 668 | Blob => box [e, string ".data"]
adamc@867 669 | Channel => box [string "uw_Basis_attrifyChannel(ctx, ", e, string ")"]
adamc@867 670 | Client => box [string "uw_Basis_attrifyClient(ctx, ", e, string ")"]
adamc@867 671 | Nullable String => e
adamc@867 672 | Nullable t => box [string "(",
adamc@867 673 e,
adamc@867 674 string " == NULL ? NULL : ",
adamc@867 675 p_ensql t (box [string "(*", e, string ")"]),
adamc@867 676 string ")"]
adamc@867 677
adam@1431 678 fun makeParams inputs =
adam@1431 679 box [string "static const int paramFormats[] = { ",
adamc@867 680 p_list_sep (box [string ",", space])
adamc@867 681 (fn t => if isBlob t then string "1" else string "0") inputs,
adamc@867 682 string " };",
adamc@867 683 newline,
adam@1431 684 if List.exists isBlob inputs then
adam@1650 685 box [string "int *paramLengths = uw_malloc(ctx, ",
adam@1431 686 string (Int.toString (length inputs)),
adam@1431 687 string " * sizeof(int));",
adam@1431 688 newline,
adam@1431 689 p_list_sepi (box [])
adam@1431 690 (fn i => fn t =>
adam@1431 691 box [string "paramLengths[",
adam@1431 692 string (Int.toString i),
adam@1431 693 string "] = ",
adam@1431 694 case t of
adam@1431 695 Blob => string ("arg" ^ Int.toString (i + 1) ^ ".size")
adam@1431 696 | Nullable Blob => string ("arg" ^ Int.toString (i + 1)
adam@1431 697 ^ "?arg" ^ Int.toString (i + 1) ^ "->size:0")
adam@1431 698 | _ => string "0",
adam@1431 699 string ";",
adam@1431 700 newline]) inputs,
adam@1431 701 newline]
adam@1431 702 else
adam@1431 703 box [string "const int *paramLengths = paramFormats;",
adam@1431 704 newline],
adam@1431 705
adam@1431 706 string "const char **paramValues = uw_malloc(ctx, ",
adam@1431 707 string (Int.toString (length inputs)),
adam@1431 708 string " * sizeof(char*));",
adamc@867 709 newline,
adam@1431 710 p_list_sepi (box [])
adam@1431 711 (fn i => fn t => box [string "paramValues[",
adam@1431 712 string (Int.toString i),
adam@1431 713 string "] = ",
adam@1431 714 p_ensql t (box [string "arg",
adam@1431 715 string (Int.toString (i + 1))]),
adam@1431 716 string ";",
adam@1431 717 newline])
adamc@867 718 inputs,
adam@1431 719 newline]
adam@1431 720
adam@1431 721 fun queryPrepared {loc, id, query, inputs, cols, doCols, nested = _} =
adam@1431 722 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@867 723 newline,
adam@1431 724
adam@1431 725 makeParams inputs,
adam@1431 726
adamc@867 727 newline,
adamc@867 728 string "PGresult *res = ",
adamc@867 729 if #persistent (Settings.currentProtocol ()) then
adamc@867 730 box [string "PQexecPrepared(conn, \"uw",
adamc@867 731 string (Int.toString id),
adamc@867 732 string "\", ",
adamc@867 733 string (Int.toString (length inputs)),
adamc@867 734 string ", paramValues, paramLengths, paramFormats, 0);"]
adamc@867 735 else
adamc@867 736 box [string "PQexecParams(conn, \"",
adam@1656 737 string (Prim.toCString query),
adamc@867 738 string "\", ",
adamc@867 739 string (Int.toString (length inputs)),
adamc@867 740 string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
adamc@867 741 newline,
adamc@867 742 newline,
adamc@873 743 queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
adam@1656 744 string (Prim.toCString query),
adamc@873 745 string "\""]}]
adamc@867 746
adam@1293 747 fun dmlCommon {loc, dml, mode} =
adamc@868 748 box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
adamc@868 749 newline,
adamc@868 750 newline,
adamc@868 751
adamc@868 752 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@868 753 newline,
adamc@868 754 box [string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {",
adamc@868 755 box [newline,
adamc@868 756 string "PQclear(res);",
adamc@868 757 newline,
adamc@868 758 string "uw_error(ctx, UNLIMITED_RETRY, \"Serialization failure\");",
adamc@868 759 newline],
adamc@868 760 string "}",
adamc@868 761 newline,
adam@1550 762 string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40P01\")) {",
adam@1550 763 box [newline,
adam@1550 764 string "PQclear(res);",
adam@1550 765 newline,
adam@1550 766 string "uw_error(ctx, UNLIMITED_RETRY, \"Deadlock detected\");",
adam@1550 767 newline],
adam@1550 768 string "}",
adam@1550 769 newline,
adam@1293 770 case mode of
adam@1293 771 Settings.Error => box [string "PQclear(res);",
adam@1293 772 newline,
adam@1293 773 string "uw_error(ctx, FATAL, \"",
adam@1293 774 string (ErrorMsg.spanToString loc),
adam@1293 775 string ": DML failed:\\n%s\\n%s\", ",
adam@1293 776 dml,
adam@1293 777 string ", PQerrorMessage(conn));"]
adam@1295 778 | Settings.None => box [string "uw_set_error_message(ctx, PQerrorMessage(conn));",
adam@1295 779 newline,
adam@1295 780 newline,
adam@1295 781
adam@1295 782 string "res = PQexec(conn, \"ROLLBACK TO s\");",
adam@1295 783 newline,
adam@1295 784 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
adam@1295 785 newline,
adam@1295 786 newline,
adam@1295 787
adam@1295 788 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adam@1295 789 newline,
adam@1295 790 box [string "PQclear(res);",
adam@1295 791 newline,
adam@1295 792 string "uw_error(ctx, FATAL, \"",
adam@1295 793 string (ErrorMsg.spanToString loc),
adam@1295 794 string ": ROLLBACK TO failed:\\n%s\\n%s\", ",
adam@1295 795 dml,
adam@1295 796 string ", PQerrorMessage(conn));",
adam@1295 797 newline,
adam@1295 798 string "}"],
adam@1295 799 newline,
adam@1295 800
adam@1295 801 string "PQclear(res);",
adam@1295 802 newline],
adamc@868 803 newline],
adamc@868 804 string "}",
adamc@868 805
adam@1295 806 case mode of
adam@1295 807 Error => box [newline,
adam@1295 808 newline,
adam@1295 809 string "PQclear(res);",
adam@1295 810 newline]
adam@1295 811 | None => box[string " else {",
adam@1295 812 newline,
adam@1295 813 box [string "PQclear(res);",
adam@1295 814 newline,
adam@1295 815 string "res = PQexec(conn, \"RELEASE s\");",
adam@1295 816 newline,
adam@1295 817 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
adam@1295 818 newline,
adam@1295 819 newline,
adam@1295 820
adam@1295 821 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adam@1295 822 newline,
adam@1295 823 box [string "PQclear(res);",
adam@1295 824 newline,
adam@1295 825 string "uw_error(ctx, FATAL, \"",
adam@1295 826 string (ErrorMsg.spanToString loc),
adam@1295 827 string ": RELEASE failed:\\n%s\\n%s\", ",
adam@1295 828 dml,
adam@1295 829 string ", PQerrorMessage(conn));",
adam@1295 830 newline],
adam@1295 831 string "}",
adam@1295 832 newline,
adam@1295 833 string "PQclear(res);",
adam@1295 834 newline],
adam@1295 835 string "}",
adam@1295 836 newline]]
adam@1295 837
adam@1295 838 fun makeSavepoint mode =
adam@1295 839 case mode of
adam@1295 840 Error => box []
adam@1295 841 | None => box [string "res = PQexec(conn, \"SAVEPOINT s\");",
adam@1295 842 newline,
adam@1295 843 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
adam@1295 844 newline,
adam@1295 845 newline,
adam@1295 846 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adam@1295 847 box [newline,
adam@1295 848 string "PQclear(res);",
adam@1295 849 newline,
adam@1295 850 string "uw_error(ctx, FATAL, \"Error creating SAVEPOINT\");",
adam@1295 851 newline],
adam@1295 852 string "}",
adam@1295 853 newline,
adam@1295 854 string "PQclear(res);",
adam@1295 855 newline,
adam@1295 856 newline]
adamc@868 857
adam@1293 858 fun dml (loc, mode) =
adamc@868 859 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@868 860 newline,
adam@1295 861 string "PGresult *res;",
adam@1295 862 newline,
adam@1295 863
adam@1295 864 makeSavepoint mode,
adam@1295 865
adam@1295 866 string "res = PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);",
adamc@868 867 newline,
adamc@868 868 newline,
adam@1293 869 dmlCommon {loc = loc, dml = string "dml", mode = mode}]
adamc@868 870
adam@1293 871 fun dmlPrepared {loc, id, dml, inputs, mode} =
adamc@868 872 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@868 873 newline,
adam@1431 874
adam@1431 875 makeParams inputs,
adam@1431 876
adamc@868 877 newline,
adam@1295 878 string "PGresult *res;",
adam@1295 879 newline,
adam@1295 880 newline,
adam@1295 881
adam@1295 882 makeSavepoint mode,
adam@1295 883
adam@1295 884 string "res = ",
adamc@868 885 if #persistent (Settings.currentProtocol ()) then
adamc@868 886 box [string "PQexecPrepared(conn, \"uw",
adamc@868 887 string (Int.toString id),
adamc@868 888 string "\", ",
adamc@868 889 string (Int.toString (length inputs)),
adamc@868 890 string ", paramValues, paramLengths, paramFormats, 0);"]
adamc@868 891 else
adamc@868 892 box [string "PQexecParams(conn, \"",
adam@1656 893 string (Prim.toCString dml),
adamc@868 894 string "\", ",
adamc@868 895 string (Int.toString (length inputs)),
adamc@868 896 string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
adamc@868 897 newline,
adamc@868 898 newline,
adamc@868 899 dmlCommon {loc = loc, dml = box [string "\"",
adam@1656 900 string (Prim.toCString dml),
adam@1293 901 string "\""], mode = mode}]
adamc@868 902
adamc@869 903 fun nextvalCommon {loc, query} =
adamc@869 904 box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating nextval result.\");",
adamc@869 905 newline,
adamc@869 906 newline,
adamc@869 907
adamc@869 908 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@869 909 newline,
adamc@869 910 box [string "PQclear(res);",
adamc@869 911 newline,
adamc@869 912 string "uw_error(ctx, FATAL, \"",
adamc@869 913 string (ErrorMsg.spanToString loc),
adamc@869 914 string ": Query failed:\\n%s\\n%s\", ",
adamc@869 915 query,
adamc@869 916 string ", PQerrorMessage(conn));",
adamc@869 917 newline],
adamc@869 918 string "}",
adamc@869 919 newline,
adamc@869 920 newline,
adamc@869 921
adamc@869 922 string "n = PQntuples(res);",
adamc@869 923 newline,
adamc@869 924 string "if (n != 1) {",
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 ": Wrong number of result rows:\\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 = uw_Basis_stringToInt_error(ctx, PQgetvalue(res, 0, 0));",
adamc@869 939 newline,
adamc@869 940 string "PQclear(res);",
adamc@869 941 newline]
adamc@869 942
adamc@878 943 open Cjr
adamc@878 944
adamc@878 945 fun nextval {loc, seqE, seqName} =
adamc@878 946 let
adamc@878 947 val query = case seqName of
adamc@878 948 SOME s =>
adamc@879 949 string ("\"SELECT NEXTVAL('" ^ s ^ "')\"")
adamc@878 950 | _ => box [string "uw_Basis_strcat(ctx, \"SELECT NEXTVAL('\", uw_Basis_strcat(ctx, ",
adamc@878 951 seqE,
adamc@878 952 string ", \"')\"))"]
adamc@878 953 in
adamc@878 954 box [string "char *query = ",
adamc@878 955 query,
adamc@878 956 string ";",
adamc@878 957 newline,
adamc@878 958 string "PGconn *conn = uw_get_db(ctx);",
adamc@878 959 newline,
adamc@878 960 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
adamc@878 961 newline,
adamc@878 962 newline,
adamc@878 963 nextvalCommon {loc = loc, query = string "query"}]
adamc@878 964 end
adamc@869 965
adamc@869 966 fun nextvalPrepared {loc, id, query} =
adamc@869 967 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@869 968 newline,
adamc@869 969 newline,
adamc@869 970 string "PGresult *res = ",
adamc@869 971 if #persistent (Settings.currentProtocol ()) then
adamc@869 972 box [string "PQexecPrepared(conn, \"uw",
adamc@869 973 string (Int.toString id),
adamc@869 974 string "\", 0, NULL, NULL, NULL, 0);"]
adamc@869 975 else
adamc@869 976 box [string "PQexecParams(conn, \"",
adam@1656 977 string (Prim.toCString query),
adamc@869 978 string "\", 0, NULL, NULL, NULL, NULL, 0);"],
adamc@869 979 newline,
adamc@869 980 newline,
adamc@869 981 nextvalCommon {loc = loc, query = box [string "\"",
adam@1656 982 string (Prim.toCString query),
adamc@869 983 string "\""]}]
adamc@869 984
adamc@1073 985 fun setvalCommon {loc, query} =
adamc@1073 986 box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating setval result.\");",
adamc@1073 987 newline,
adamc@1073 988 newline,
adamc@1073 989
adamc@1073 990 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@1073 991 newline,
adamc@1073 992 box [string "PQclear(res);",
adamc@1073 993 newline,
adamc@1073 994 string "uw_error(ctx, FATAL, \"",
adamc@1073 995 string (ErrorMsg.spanToString loc),
adamc@1073 996 string ": Query failed:\\n%s\\n%s\", ",
adamc@1073 997 query,
adamc@1073 998 string ", PQerrorMessage(conn));",
adamc@1073 999 newline],
adamc@1073 1000 string "}",
adamc@1073 1001 newline,
adamc@1073 1002 newline,
adamc@1073 1003
adamc@1073 1004 string "PQclear(res);",
adamc@1073 1005 newline]
adamc@1073 1006
adamc@1073 1007 fun setval {loc, seqE, count} =
adamc@1073 1008 let
adamc@1073 1009 val query = box [string "uw_Basis_strcat(ctx, \"SELECT SETVAL('\", uw_Basis_strcat(ctx, ",
adamc@1073 1010 seqE,
adamc@1073 1011 string ", uw_Basis_strcat(ctx, \"', \", uw_Basis_strcat(ctx, uw_Basis_sqlifyInt(ctx, ",
adamc@1073 1012 count,
adamc@1073 1013 string "), \")\"))))"]
adamc@1073 1014 in
adamc@1073 1015 box [string "char *query = ",
adamc@1073 1016 query,
adamc@1073 1017 string ";",
adamc@1073 1018 newline,
adamc@1073 1019 string "PGconn *conn = uw_get_db(ctx);",
adamc@1073 1020 newline,
adamc@1073 1021 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
adamc@1073 1022 newline,
adamc@1073 1023 newline,
adamc@1073 1024 setvalCommon {loc = loc, query = string "query"}]
adamc@1073 1025 end
adamc@1073 1026
adamc@874 1027 fun sqlifyString s = "E'" ^ String.translate (fn #"'" => "\\'"
adamc@874 1028 | #"\\" => "\\\\"
adamc@874 1029 | ch =>
adamc@874 1030 if Char.isPrint ch then
adamc@874 1031 str ch
adamc@874 1032 else
adamc@874 1033 "\\" ^ StringCvt.padLeft #"0" 3
adamc@874 1034 (Int.fmt StringCvt.OCT (ord ch)))
adam@1656 1035 (Prim.toCString s) ^ "'::text"
adamc@874 1036
adamc@874 1037 fun p_cast (s, t) = s ^ "::" ^ p_sql_type t
adamc@874 1038
adamc@874 1039 fun p_blank (n, t) = p_cast ("$" ^ Int.toString n, t)
adamc@874 1040
adamc@866 1041 val () = addDbms {name = "postgres",
adam@1682 1042 randomFunction = "RANDOM",
adam@1464 1043 header = Config.pgheader,
adamc@866 1044 link = "-lpq",
adamc@873 1045 p_sql_type = p_sql_type,
adamc@867 1046 init = init,
adamc@867 1047 query = query,
adamc@868 1048 queryPrepared = queryPrepared,
adamc@868 1049 dml = dml,
adamc@869 1050 dmlPrepared = dmlPrepared,
adamc@869 1051 nextval = nextval,
adamc@874 1052 nextvalPrepared = nextvalPrepared,
adamc@1073 1053 setval = setval,
adamc@874 1054 sqlifyString = sqlifyString,
adamc@874 1055 p_cast = p_cast,
adamc@874 1056 p_blank = p_blank,
adamc@877 1057 supportsDeleteAs = true,
adamc@886 1058 supportsUpdateAs = true,
adamc@877 1059 createSequence = fn s => "CREATE SEQUENCE " ^ s,
adamc@878 1060 textKeysNeedLengths = false,
adamc@879 1061 supportsNextval = true,
adamc@882 1062 supportsNestedPrepared = true,
adamc@890 1063 sqlPrefix = "",
adamc@1014 1064 supportsOctetLength = true,
adamc@1014 1065 trueString = "TRUE",
adamc@1196 1066 falseString = "FALSE",
adamc@1196 1067 onlyUnion = false,
adam@1777 1068 nestedRelops = true,
adam@1777 1069 windowFunctions = true}
adamc@874 1070
adamc@866 1071 val () = setDbms "postgres"
adamc@866 1072
adamc@866 1073 end