Mercurial > urweb

annotate src/postgres.sml @ 1611:217384f4b8ea

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Tweak error message about Basis.get to use that name instead of internal name
author Adam Chlipala <adam@chlipala.net>
date Thu, 24 Nov 2011 11:56:05 -0500
parents 8128fcb2d4a4
children 1bfd793e7eb8
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
adamc@866 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@1285 340 string (String.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@1285 358 string (String.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,
adamc@1094 383 string "uw_sqlsuffixString = \"::text\";",
adamc@1094 384 newline,
adamc@1094 385 string "uw_sqlsuffixChar = \"::char\";",
adamc@1094 386 newline,
adamc@1094 387 string "uw_sqlsuffixBlob = \"::bytea\";",
adamc@1094 388 newline,
adamc@1094 389 string "uw_sqlfmtUint4 = \"%u::int4%n\";",
adamc@1094 390 newline],
adamc@1094 391 string "}",
adamc@866 392 newline,
adamc@866 393 newline,
adamc@866 394
adamc@1094 395 string "static void uw_db_close(uw_context ctx) {",
adamc@1094 396 newline,
adamc@1094 397 string "PQfinish(uw_get_db(ctx));",
adamc@1094 398 newline,
adamc@1094 399 string "}",
adamc@1094 400 newline,
adamc@1094 401 newline,
adamc@1094 402
adamc@1094 403 string "static int uw_db_begin(uw_context ctx) {",
adamc@1094 404 newline,
adamc@1094 405 string "PGconn *conn = uw_get_db(ctx);",
adamc@1094 406 newline,
adamc@1094 407 string "PGresult *res = PQexec(conn, \"BEGIN ISOLATION LEVEL SERIALIZABLE\");",
adamc@1094 408 newline,
adamc@1094 409 newline,
adamc@1094 410 string "if (res == NULL) return 1;",
adamc@1094 411 newline,
adamc@1094 412 newline,
adamc@1094 413 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@1094 414 box [string "PQclear(res);",
adamc@1094 415 newline,
adamc@1094 416 string "return 1;",
adamc@1094 417 newline],
adamc@1094 418 string "}",
adamc@1094 419 newline,
adamc@1144 420 string "PQclear(res);",
adamc@1144 421 newline,
adamc@1094 422 string "return 0;",
adamc@1094 423 newline,
adamc@1094 424 string "}",
adamc@1094 425 newline,
adamc@1094 426 newline,
adamc@1094 427
adamc@1094 428 string "static int uw_db_commit(uw_context ctx) {",
adamc@1094 429 newline,
adamc@1094 430 string "PGconn *conn = uw_get_db(ctx);",
adamc@1094 431 newline,
adamc@1094 432 string "PGresult *res = PQexec(conn, \"COMMIT\");",
adamc@1094 433 newline,
adamc@1094 434 newline,
adamc@1094 435 string "if (res == NULL) return 1;",
adamc@1094 436 newline,
adamc@1094 437 newline,
adamc@1094 438 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@1094 439 box [string "PQclear(res);",
adamc@1094 440 newline,
adamc@1094 441 string "return 1;",
adamc@1094 442 newline],
adamc@1094 443 string "}",
adamc@1094 444 newline,
adamc@1144 445 string "PQclear(res);",
adamc@1144 446 newline,
adamc@1094 447 string "return 0;",
adamc@1094 448 newline,
adamc@1094 449 string "}",
adamc@1094 450 newline,
adamc@1094 451 newline,
adamc@1094 452
adamc@1094 453 string "static int uw_db_rollback(uw_context ctx) {",
adamc@1094 454 newline,
adamc@1094 455 string "PGconn *conn = uw_get_db(ctx);",
adamc@1094 456 newline,
adamc@1094 457 string "PGresult *res = PQexec(conn, \"ROLLBACK\");",
adamc@1094 458 newline,
adamc@1094 459 newline,
adamc@1094 460 string "if (res == NULL) return 1;",
adamc@1094 461 newline,
adamc@1094 462 newline,
adamc@1094 463 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@1094 464 box [string "PQclear(res);",
adamc@1094 465 newline,
adamc@1094 466 string "return 1;",
adamc@1094 467 newline],
adamc@1094 468 string "}",
adamc@1094 469 newline,
adamc@1144 470 string "PQclear(res);",
adamc@1144 471 newline,
adamc@1094 472 string "return 0;",
adamc@1094 473 newline,
adamc@1094 474 string "}",
adamc@1094 475
adamc@1094 476 newline,
adamc@1094 477 newline,
adamc@1094 478
adamc@1094 479 string "static void uw_db_init(uw_context ctx) {",
adamc@866 480 newline,
as@1564 481 string "char *env_db_str = getenv(\"URWEB_PQ_CON\");",
as@1564 482 newline,
as@1564 483 string "PGconn *conn = PQconnectdb(env_db_str == NULL ? \"",
adam@1285 484 string (String.toCString dbstring),
as@1564 485 string "\" : env_db_str);",
adamc@866 486 newline,
adamc@866 487 string "if (conn == NULL) uw_error(ctx, FATAL, ",
adamc@866 488 string "\"libpq can't allocate a connection.\");",
adamc@866 489 newline,
adamc@866 490 string "if (PQstatus(conn) != CONNECTION_OK) {",
adamc@866 491 newline,
adamc@866 492 box [string "char msg[1024];",
adamc@866 493 newline,
adamc@866 494 string "strncpy(msg, PQerrorMessage(conn), 1024);",
adamc@866 495 newline,
adamc@866 496 string "msg[1023] = 0;",
adamc@866 497 newline,
adamc@866 498 string "PQfinish(conn);",
adamc@866 499 newline,
adamc@866 500 string "uw_error(ctx, BOUNDED_RETRY, ",
adamc@866 501 string "\"Connection to Postgres server failed: %s\", msg);"],
adamc@866 502 newline,
adamc@866 503 string "}",
adamc@866 504 newline,
adamc@866 505 string "uw_set_db(ctx, conn);",
adamc@866 506 newline,
adamc@866 507 string "uw_db_validate(ctx);",
adamc@866 508 newline,
adamc@866 509 string "uw_db_prepare(ctx);",
adamc@866 510 newline,
adamc@866 511 string "}"]
adamc@866 512
adamc@880 513 fun p_getcol {loc, wontLeakStrings, col = i, typ = t} =
adamc@867 514 let
adamc@867 515 fun p_unsql t e eLen =
adamc@867 516 case t of
adamc@867 517 Int => box [string "uw_Basis_stringToInt_error(ctx, ", e, string ")"]
adamc@867 518 | Float => box [string "uw_Basis_stringToFloat_error(ctx, ", e, string ")"]
adamc@867 519 | String =>
adamc@867 520 if wontLeakStrings then
adamc@867 521 e
adamc@867 522 else
adamc@867 523 box [string "uw_strdup(ctx, ", e, string ")"]
adamc@1011 524 | Char => box [e, string "[0]"]
adamc@867 525 | Bool => box [string "uw_Basis_stringToBool_error(ctx, ", e, string ")"]
adamc@939 526 | Time => box [string "uw_Basis_unsqlTime(ctx, ", e, string ")"]
adamc@867 527 | Blob => box [string "uw_Basis_stringToBlob_error(ctx, ",
adamc@867 528 e,
adamc@867 529 string ", ",
adamc@867 530 eLen,
adamc@867 531 string ")"]
adamc@867 532 | Channel => box [string "uw_Basis_stringToChannel_error(ctx, ", e, string ")"]
adamc@867 533 | Client => box [string "uw_Basis_stringToClient_error(ctx, ", e, string ")"]
adamc@867 534
adamc@867 535 | Nullable _ => raise Fail "Postgres: Recursive Nullable"
adamc@867 536
adamc@867 537 fun getter t =
adamc@867 538 case t of
adamc@867 539 Nullable t =>
adamc@867 540 box [string "(PQgetisnull(res, i, ",
adamc@867 541 string (Int.toString i),
adamc@867 542 string ") ? NULL : ",
adamc@867 543 case t of
adamc@867 544 String => getter t
adamc@867 545 | _ => box [string "({",
adamc@867 546 newline,
adamc@874 547 string (p_sql_ctype t),
adamc@867 548 space,
adamc@867 549 string "*tmp = uw_malloc(ctx, sizeof(",
adamc@874 550 string (p_sql_ctype t),
adamc@867 551 string "));",
adamc@867 552 newline,
adamc@867 553 string "*tmp = ",
adamc@867 554 getter t,
adamc@867 555 string ";",
adamc@867 556 newline,
adamc@867 557 string "tmp;",
adamc@867 558 newline,
adamc@867 559 string "})"],
adamc@867 560 string ")"]
adamc@867 561 | _ =>
adamc@867 562 box [string "(PQgetisnull(res, i, ",
adamc@867 563 string (Int.toString i),
adamc@867 564 string ") ? ",
adamc@867 565 box [string "({",
adamc@874 566 string (p_sql_ctype t),
adamc@867 567 space,
adamc@867 568 string "tmp;",
adamc@867 569 newline,
adamc@880 570 string "uw_error(ctx, FATAL, \"",
adamc@880 571 string (ErrorMsg.spanToString loc),
adamc@880 572 string ": Unexpectedly NULL field #",
adamc@867 573 string (Int.toString i),
adamc@867 574 string "\");",
adamc@867 575 newline,
adamc@867 576 string "tmp;",
adamc@867 577 newline,
adamc@867 578 string "})"],
adamc@867 579 string " : ",
adamc@867 580 p_unsql t
adamc@867 581 (box [string "PQgetvalue(res, i, ",
adamc@867 582 string (Int.toString i),
adamc@867 583 string ")"])
adamc@867 584 (box [string "PQgetlength(res, i, ",
adamc@867 585 string (Int.toString i),
adamc@867 586 string ")"]),
adamc@867 587 string ")"]
adamc@867 588 in
adamc@867 589 getter t
adamc@867 590 end
adamc@867 591
adamc@873 592 fun queryCommon {loc, query, cols, doCols} =
adamc@867 593 box [string "int n, i;",
adamc@867 594 newline,
adamc@867 595 newline,
adamc@867 596
adamc@867 597 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
adamc@867 598 newline,
adamc@867 599 newline,
adamc@867 600
adamc@867 601 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@867 602 newline,
adamc@867 603 box [string "PQclear(res);",
adamc@867 604 newline,
adamc@867 605 string "uw_error(ctx, FATAL, \"",
adamc@867 606 string (ErrorMsg.spanToString loc),
adamc@867 607 string ": Query failed:\\n%s\\n%s\", ",
adamc@867 608 query,
adamc@867 609 string ", PQerrorMessage(conn));",
adamc@867 610 newline],
adamc@867 611 string "}",
adamc@867 612 newline,
adamc@867 613 newline,
adamc@867 614
adamc@867 615 string "if (PQnfields(res) != ",
adamc@873 616 string (Int.toString (length cols)),
adamc@867 617 string ") {",
adamc@867 618 newline,
adamc@867 619 box [string "int nf = PQnfields(res);",
adamc@867 620 newline,
adamc@867 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 returned %d columns instead of ",
adamc@873 626 string (Int.toString (length cols)),
adamc@867 627 string ":\\n%s\\n%s\", nf, ",
adamc@867 628 query,
adamc@867 629 string ", PQerrorMessage(conn));",
adamc@867 630 newline],
adamc@867 631 string "}",
adamc@867 632 newline,
adamc@867 633 newline,
adamc@867 634
adamc@867 635 string "uw_end_region(ctx);",
adamc@867 636 newline,
adamc@867 637 string "uw_push_cleanup(ctx, (void (*)(void *))PQclear, res);",
adamc@867 638 newline,
adamc@867 639 string "n = PQntuples(res);",
adamc@867 640 newline,
adamc@867 641 string "for (i = 0; i < n; ++i) {",
adamc@867 642 newline,
adamc@867 643 doCols p_getcol,
adamc@867 644 string "}",
adamc@867 645 newline,
adamc@867 646 newline,
adamc@867 647 string "uw_pop_cleanup(ctx);",
adamc@867 648 newline]
adamc@867 649
adamc@873 650 fun query {loc, cols, doCols} =
adamc@867 651 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@867 652 newline,
adamc@867 653 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
adamc@867 654 newline,
adamc@867 655 newline,
adamc@873 656 queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"}]
adamc@867 657
adamc@867 658 fun p_ensql t e =
adamc@867 659 case t of
adamc@867 660 Int => box [string "uw_Basis_attrifyInt(ctx, ", e, string ")"]
adamc@867 661 | Float => box [string "uw_Basis_attrifyFloat(ctx, ", e, string ")"]
adamc@867 662 | String => e
adamc@1011 663 | Char => box [string "uw_Basis_attrifyChar(ctx, ", e, string ")"]
adamc@867 664 | Bool => box [string "(", e, string " ? \"TRUE\" : \"FALSE\")"]
adam@1364 665 | Time => box [string "uw_Basis_ensqlTime(ctx, ", e, string ")"]
adamc@867 666 | Blob => box [e, string ".data"]
adamc@867 667 | Channel => box [string "uw_Basis_attrifyChannel(ctx, ", e, string ")"]
adamc@867 668 | Client => box [string "uw_Basis_attrifyClient(ctx, ", e, string ")"]
adamc@867 669 | Nullable String => e
adamc@867 670 | Nullable t => box [string "(",
adamc@867 671 e,
adamc@867 672 string " == NULL ? NULL : ",
adamc@867 673 p_ensql t (box [string "(*", e, string ")"]),
adamc@867 674 string ")"]
adamc@867 675
adam@1431 676 fun makeParams inputs =
adam@1431 677 box [string "static const int paramFormats[] = { ",
adamc@867 678 p_list_sep (box [string ",", space])
adamc@867 679 (fn t => if isBlob t then string "1" else string "0") inputs,
adamc@867 680 string " };",
adamc@867 681 newline,
adam@1431 682 if List.exists isBlob inputs then
adam@1431 683 box [string "const int *paramLengths = uw_malloc(ctx, ",
adam@1431 684 string (Int.toString (length inputs)),
adam@1431 685 string " * sizeof(int));",
adam@1431 686 newline,
adam@1431 687 p_list_sepi (box [])
adam@1431 688 (fn i => fn t =>
adam@1431 689 box [string "paramLengths[",
adam@1431 690 string (Int.toString i),
adam@1431 691 string "] = ",
adam@1431 692 case t of
adam@1431 693 Blob => string ("arg" ^ Int.toString (i + 1) ^ ".size")
adam@1431 694 | Nullable Blob => string ("arg" ^ Int.toString (i + 1)
adam@1431 695 ^ "?arg" ^ Int.toString (i + 1) ^ "->size:0")
adam@1431 696 | _ => string "0",
adam@1431 697 string ";",
adam@1431 698 newline]) inputs,
adam@1431 699 string " };",
adam@1431 700 newline]
adam@1431 701 else
adam@1431 702 box [string "const int *paramLengths = paramFormats;",
adam@1431 703 newline],
adam@1431 704
adam@1431 705 string "const char **paramValues = uw_malloc(ctx, ",
adam@1431 706 string (Int.toString (length inputs)),
adam@1431 707 string " * sizeof(char*));",
adamc@867 708 newline,
adam@1431 709 p_list_sepi (box [])
adam@1431 710 (fn i => fn t => box [string "paramValues[",
adam@1431 711 string (Int.toString i),
adam@1431 712 string "] = ",
adam@1431 713 p_ensql t (box [string "arg",
adam@1431 714 string (Int.toString (i + 1))]),
adam@1431 715 string ";",
adam@1431 716 newline])
adamc@867 717 inputs,
adam@1431 718 newline]
adam@1431 719
adam@1431 720 fun queryPrepared {loc, id, query, inputs, cols, doCols, nested = _} =
adam@1431 721 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@867 722 newline,
adam@1431 723
adam@1431 724 makeParams inputs,
adam@1431 725
adamc@867 726 newline,
adamc@867 727 string "PGresult *res = ",
adamc@867 728 if #persistent (Settings.currentProtocol ()) then
adamc@867 729 box [string "PQexecPrepared(conn, \"uw",
adamc@867 730 string (Int.toString id),
adamc@867 731 string "\", ",
adamc@867 732 string (Int.toString (length inputs)),
adamc@867 733 string ", paramValues, paramLengths, paramFormats, 0);"]
adamc@867 734 else
adamc@867 735 box [string "PQexecParams(conn, \"",
adam@1285 736 string (String.toCString query),
adamc@867 737 string "\", ",
adamc@867 738 string (Int.toString (length inputs)),
adamc@867 739 string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
adamc@867 740 newline,
adamc@867 741 newline,
adamc@873 742 queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
adam@1285 743 string (String.toCString query),
adamc@873 744 string "\""]}]
adamc@867 745
adam@1293 746 fun dmlCommon {loc, dml, mode} =
adamc@868 747 box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
adamc@868 748 newline,
adamc@868 749 newline,
adamc@868 750
adamc@868 751 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@868 752 newline,
adamc@868 753 box [string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {",
adamc@868 754 box [newline,
adamc@868 755 string "PQclear(res);",
adamc@868 756 newline,
adamc@868 757 string "uw_error(ctx, UNLIMITED_RETRY, \"Serialization failure\");",
adamc@868 758 newline],
adamc@868 759 string "}",
adamc@868 760 newline,
adam@1550 761 string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40P01\")) {",
adam@1550 762 box [newline,
adam@1550 763 string "PQclear(res);",
adam@1550 764 newline,
adam@1550 765 string "uw_error(ctx, UNLIMITED_RETRY, \"Deadlock detected\");",
adam@1550 766 newline],
adam@1550 767 string "}",
adam@1550 768 newline,
adam@1293 769 case mode of
adam@1293 770 Settings.Error => box [string "PQclear(res);",
adam@1293 771 newline,
adam@1293 772 string "uw_error(ctx, FATAL, \"",
adam@1293 773 string (ErrorMsg.spanToString loc),
adam@1293 774 string ": DML failed:\\n%s\\n%s\", ",
adam@1293 775 dml,
adam@1293 776 string ", PQerrorMessage(conn));"]
adam@1295 777 | Settings.None => box [string "uw_set_error_message(ctx, PQerrorMessage(conn));",
adam@1295 778 newline,
adam@1295 779 newline,
adam@1295 780
adam@1295 781 string "res = PQexec(conn, \"ROLLBACK TO s\");",
adam@1295 782 newline,
adam@1295 783 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
adam@1295 784 newline,
adam@1295 785 newline,
adam@1295 786
adam@1295 787 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adam@1295 788 newline,
adam@1295 789 box [string "PQclear(res);",
adam@1295 790 newline,
adam@1295 791 string "uw_error(ctx, FATAL, \"",
adam@1295 792 string (ErrorMsg.spanToString loc),
adam@1295 793 string ": ROLLBACK TO failed:\\n%s\\n%s\", ",
adam@1295 794 dml,
adam@1295 795 string ", PQerrorMessage(conn));",
adam@1295 796 newline,
adam@1295 797 string "}"],
adam@1295 798 newline,
adam@1295 799
adam@1295 800 string "PQclear(res);",
adam@1295 801 newline],
adamc@868 802 newline],
adamc@868 803 string "}",
adamc@868 804
adam@1295 805 case mode of
adam@1295 806 Error => box [newline,
adam@1295 807 newline,
adam@1295 808 string "PQclear(res);",
adam@1295 809 newline]
adam@1295 810 | None => box[string " else {",
adam@1295 811 newline,
adam@1295 812 box [string "PQclear(res);",
adam@1295 813 newline,
adam@1295 814 string "res = PQexec(conn, \"RELEASE s\");",
adam@1295 815 newline,
adam@1295 816 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
adam@1295 817 newline,
adam@1295 818 newline,
adam@1295 819
adam@1295 820 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adam@1295 821 newline,
adam@1295 822 box [string "PQclear(res);",
adam@1295 823 newline,
adam@1295 824 string "uw_error(ctx, FATAL, \"",
adam@1295 825 string (ErrorMsg.spanToString loc),
adam@1295 826 string ": RELEASE failed:\\n%s\\n%s\", ",
adam@1295 827 dml,
adam@1295 828 string ", PQerrorMessage(conn));",
adam@1295 829 newline],
adam@1295 830 string "}",
adam@1295 831 newline,
adam@1295 832 string "PQclear(res);",
adam@1295 833 newline],
adam@1295 834 string "}",
adam@1295 835 newline]]
adam@1295 836
adam@1295 837 fun makeSavepoint mode =
adam@1295 838 case mode of
adam@1295 839 Error => box []
adam@1295 840 | None => box [string "res = PQexec(conn, \"SAVEPOINT s\");",
adam@1295 841 newline,
adam@1295 842 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
adam@1295 843 newline,
adam@1295 844 newline,
adam@1295 845 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adam@1295 846 box [newline,
adam@1295 847 string "PQclear(res);",
adam@1295 848 newline,
adam@1295 849 string "uw_error(ctx, FATAL, \"Error creating SAVEPOINT\");",
adam@1295 850 newline],
adam@1295 851 string "}",
adam@1295 852 newline,
adam@1295 853 string "PQclear(res);",
adam@1295 854 newline,
adam@1295 855 newline]
adamc@868 856
adam@1293 857 fun dml (loc, mode) =
adamc@868 858 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@868 859 newline,
adam@1295 860 string "PGresult *res;",
adam@1295 861 newline,
adam@1295 862
adam@1295 863 makeSavepoint mode,
adam@1295 864
adam@1295 865 string "res = PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);",
adamc@868 866 newline,
adamc@868 867 newline,
adam@1293 868 dmlCommon {loc = loc, dml = string "dml", mode = mode}]
adamc@868 869
adam@1293 870 fun dmlPrepared {loc, id, dml, inputs, mode} =
adamc@868 871 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@868 872 newline,
adam@1431 873
adam@1431 874 makeParams inputs,
adam@1431 875
adamc@868 876 newline,
adam@1295 877 string "PGresult *res;",
adam@1295 878 newline,
adam@1295 879 newline,
adam@1295 880
adam@1295 881 makeSavepoint mode,
adam@1295 882
adam@1295 883 string "res = ",
adamc@868 884 if #persistent (Settings.currentProtocol ()) then
adamc@868 885 box [string "PQexecPrepared(conn, \"uw",
adamc@868 886 string (Int.toString id),
adamc@868 887 string "\", ",
adamc@868 888 string (Int.toString (length inputs)),
adamc@868 889 string ", paramValues, paramLengths, paramFormats, 0);"]
adamc@868 890 else
adamc@868 891 box [string "PQexecParams(conn, \"",
adam@1285 892 string (String.toCString dml),
adamc@868 893 string "\", ",
adamc@868 894 string (Int.toString (length inputs)),
adamc@868 895 string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
adamc@868 896 newline,
adamc@868 897 newline,
adamc@868 898 dmlCommon {loc = loc, dml = box [string "\"",
adam@1285 899 string (String.toCString dml),
adam@1293 900 string "\""], mode = mode}]
adamc@868 901
adamc@869 902 fun nextvalCommon {loc, query} =
adamc@869 903 box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating nextval result.\");",
adamc@869 904 newline,
adamc@869 905 newline,
adamc@869 906
adamc@869 907 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@869 908 newline,
adamc@869 909 box [string "PQclear(res);",
adamc@869 910 newline,
adamc@869 911 string "uw_error(ctx, FATAL, \"",
adamc@869 912 string (ErrorMsg.spanToString loc),
adamc@869 913 string ": Query failed:\\n%s\\n%s\", ",
adamc@869 914 query,
adamc@869 915 string ", PQerrorMessage(conn));",
adamc@869 916 newline],
adamc@869 917 string "}",
adamc@869 918 newline,
adamc@869 919 newline,
adamc@869 920
adamc@869 921 string "n = PQntuples(res);",
adamc@869 922 newline,
adamc@869 923 string "if (n != 1) {",
adamc@869 924 newline,
adamc@869 925 box [string "PQclear(res);",
adamc@869 926 newline,
adamc@869 927 string "uw_error(ctx, FATAL, \"",
adamc@869 928 string (ErrorMsg.spanToString loc),
adamc@869 929 string ": Wrong number of result rows:\\n%s\\n%s\", ",
adamc@869 930 query,
adamc@869 931 string ", PQerrorMessage(conn));",
adamc@869 932 newline],
adamc@869 933 string "}",
adamc@869 934 newline,
adamc@869 935 newline,
adamc@869 936
adamc@869 937 string "n = uw_Basis_stringToInt_error(ctx, PQgetvalue(res, 0, 0));",
adamc@869 938 newline,
adamc@869 939 string "PQclear(res);",
adamc@869 940 newline]
adamc@869 941
adamc@878 942 open Cjr
adamc@878 943
adamc@878 944 fun nextval {loc, seqE, seqName} =
adamc@878 945 let
adamc@878 946 val query = case seqName of
adamc@878 947 SOME s =>
adamc@879 948 string ("\"SELECT NEXTVAL('" ^ s ^ "')\"")
adamc@878 949 | _ => box [string "uw_Basis_strcat(ctx, \"SELECT NEXTVAL('\", uw_Basis_strcat(ctx, ",
adamc@878 950 seqE,
adamc@878 951 string ", \"')\"))"]
adamc@878 952 in
adamc@878 953 box [string "char *query = ",
adamc@878 954 query,
adamc@878 955 string ";",
adamc@878 956 newline,
adamc@878 957 string "PGconn *conn = uw_get_db(ctx);",
adamc@878 958 newline,
adamc@878 959 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
adamc@878 960 newline,
adamc@878 961 newline,
adamc@878 962 nextvalCommon {loc = loc, query = string "query"}]
adamc@878 963 end
adamc@869 964
adamc@869 965 fun nextvalPrepared {loc, id, query} =
adamc@869 966 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@869 967 newline,
adamc@869 968 newline,
adamc@869 969 string "PGresult *res = ",
adamc@869 970 if #persistent (Settings.currentProtocol ()) then
adamc@869 971 box [string "PQexecPrepared(conn, \"uw",
adamc@869 972 string (Int.toString id),
adamc@869 973 string "\", 0, NULL, NULL, NULL, 0);"]
adamc@869 974 else
adamc@869 975 box [string "PQexecParams(conn, \"",
adam@1285 976 string (String.toCString query),
adamc@869 977 string "\", 0, NULL, NULL, NULL, NULL, 0);"],
adamc@869 978 newline,
adamc@869 979 newline,
adamc@869 980 nextvalCommon {loc = loc, query = box [string "\"",
adam@1285 981 string (String.toCString query),
adamc@869 982 string "\""]}]
adamc@869 983
adamc@1073 984 fun setvalCommon {loc, query} =
adamc@1073 985 box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating setval result.\");",
adamc@1073 986 newline,
adamc@1073 987 newline,
adamc@1073 988
adamc@1073 989 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@1073 990 newline,
adamc@1073 991 box [string "PQclear(res);",
adamc@1073 992 newline,
adamc@1073 993 string "uw_error(ctx, FATAL, \"",
adamc@1073 994 string (ErrorMsg.spanToString loc),
adamc@1073 995 string ": Query failed:\\n%s\\n%s\", ",
adamc@1073 996 query,
adamc@1073 997 string ", PQerrorMessage(conn));",
adamc@1073 998 newline],
adamc@1073 999 string "}",
adamc@1073 1000 newline,
adamc@1073 1001 newline,
adamc@1073 1002
adamc@1073 1003 string "PQclear(res);",
adamc@1073 1004 newline]
adamc@1073 1005
adamc@1073 1006 fun setval {loc, seqE, count} =
adamc@1073 1007 let
adamc@1073 1008 val query = box [string "uw_Basis_strcat(ctx, \"SELECT SETVAL('\", uw_Basis_strcat(ctx, ",
adamc@1073 1009 seqE,
adamc@1073 1010 string ", uw_Basis_strcat(ctx, \"', \", uw_Basis_strcat(ctx, uw_Basis_sqlifyInt(ctx, ",
adamc@1073 1011 count,
adamc@1073 1012 string "), \")\"))))"]
adamc@1073 1013 in
adamc@1073 1014 box [string "char *query = ",
adamc@1073 1015 query,
adamc@1073 1016 string ";",
adamc@1073 1017 newline,
adamc@1073 1018 string "PGconn *conn = uw_get_db(ctx);",
adamc@1073 1019 newline,
adamc@1073 1020 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
adamc@1073 1021 newline,
adamc@1073 1022 newline,
adamc@1073 1023 setvalCommon {loc = loc, query = string "query"}]
adamc@1073 1024 end
adamc@1073 1025
adamc@874 1026 fun sqlifyString s = "E'" ^ String.translate (fn #"'" => "\\'"
adamc@874 1027 | #"\\" => "\\\\"
adamc@874 1028 | ch =>
adamc@874 1029 if Char.isPrint ch then
adamc@874 1030 str ch
adamc@874 1031 else
adamc@874 1032 "\\" ^ StringCvt.padLeft #"0" 3
adamc@874 1033 (Int.fmt StringCvt.OCT (ord ch)))
adam@1285 1034 (String.toCString s) ^ "'::text"
adamc@874 1035
adamc@874 1036 fun p_cast (s, t) = s ^ "::" ^ p_sql_type t
adamc@874 1037
adamc@874 1038 fun p_blank (n, t) = p_cast ("$" ^ Int.toString n, t)
adamc@874 1039
adamc@866 1040 val () = addDbms {name = "postgres",
adam@1464 1041 header = Config.pgheader,
adamc@866 1042 link = "-lpq",
adamc@873 1043 p_sql_type = p_sql_type,
adamc@867 1044 init = init,
adamc@867 1045 query = query,
adamc@868 1046 queryPrepared = queryPrepared,
adamc@868 1047 dml = dml,
adamc@869 1048 dmlPrepared = dmlPrepared,
adamc@869 1049 nextval = nextval,
adamc@874 1050 nextvalPrepared = nextvalPrepared,
adamc@1073 1051 setval = setval,
adamc@874 1052 sqlifyString = sqlifyString,
adamc@874 1053 p_cast = p_cast,
adamc@874 1054 p_blank = p_blank,
adamc@877 1055 supportsDeleteAs = true,
adamc@886 1056 supportsUpdateAs = true,
adamc@877 1057 createSequence = fn s => "CREATE SEQUENCE " ^ s,
adamc@878 1058 textKeysNeedLengths = false,
adamc@879 1059 supportsNextval = true,
adamc@882 1060 supportsNestedPrepared = true,
adamc@890 1061 sqlPrefix = "",
adamc@1014 1062 supportsOctetLength = true,
adamc@1014 1063 trueString = "TRUE",
adamc@1196 1064 falseString = "FALSE",
adamc@1196 1065 onlyUnion = false,
adamc@1196 1066 nestedRelops = true}
adamc@874 1067
adamc@866 1068 val () = setDbms "postgres"
adamc@866 1069
adamc@866 1070 end