Mercurial > urweb

annotate src/postgres.sml @ 873:41971801b62d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
MySQL query gets up to C linking
author Adam Chlipala <adamc@hcoop.net>
date Sun, 12 Jul 2009 13:16:05 -0400
parents 9654bce27cff
children 3c7b48040dcf
rev   line source
adamc@866 1 (* Copyright (c) 2008-2009, 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@873 42 | Bool => "bool"
adamc@873 43 | Time => "timestamp"
adamc@873 44 | Blob => "bytea"
adamc@873 45 | Channel => "int8"
adamc@873 46 | Client => "int4"
adamc@873 47 | Nullable t => p_sql_type t
adamc@873 48
adamc@870 49 fun p_sql_type_base t =
adamc@870 50 case t of
adamc@871 51 Int => "bigint"
adamc@871 52 | Float => "double precision"
adamc@870 53 | String => "text"
adamc@871 54 | Bool => "boolean"
adamc@871 55 | Time => "timestamp without time zone"
adamc@870 56 | Blob => "bytea"
adamc@871 57 | Channel => "bigint"
adamc@871 58 | Client => "integer"
adamc@870 59 | Nullable t => p_sql_type_base t
adamc@870 60
adamc@872 61 fun checkRel (table, checkNullable) (s, xts) =
adamc@871 62 let
adamc@871 63 val sl = CharVector.map Char.toLower s
adamc@871 64
adamc@872 65 val q = "SELECT COUNT(*) FROM information_schema." ^ table ^ " WHERE table_name = '"
adamc@871 66 ^ sl ^ "'"
adamc@871 67
adamc@871 68 val q' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE table_name = '",
adamc@871 69 sl,
adamc@871 70 "' AND (",
adamc@871 71 String.concatWith " OR "
adamc@871 72 (map (fn (x, t) =>
adamc@871 73 String.concat ["(column_name = 'uw_",
adamc@871 74 CharVector.map
adamc@871 75 Char.toLower (ident x),
adamc@871 76 "' AND data_type = '",
adamc@871 77 p_sql_type_base t,
adamc@872 78 "'",
adamc@872 79 if checkNullable then
adamc@872 80 (" AND is_nullable = '"
adamc@872 81 ^ (if isNotNull t then
adamc@872 82 "NO"
adamc@872 83 else
adamc@872 84 "YES")
adamc@872 85 ^ "'")
adamc@871 86 else
adamc@872 87 "",
adamc@872 88 ")"]) xts),
adamc@871 89 ")"]
adamc@871 90
adamc@871 91 val q'' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE table_name = '",
adamc@871 92 sl,
adamc@871 93 "' AND column_name LIKE 'uw_%'"]
adamc@871 94 in
adamc@871 95 box [string "res = PQexec(conn, \"",
adamc@871 96 string q,
adamc@871 97 string "\");",
adamc@871 98 newline,
adamc@871 99 newline,
adamc@871 100 string "if (res == NULL) {",
adamc@871 101 newline,
adamc@871 102 box [string "PQfinish(conn);",
adamc@871 103 newline,
adamc@871 104 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
adamc@871 105 newline],
adamc@871 106 string "}",
adamc@871 107 newline,
adamc@871 108 newline,
adamc@871 109 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@871 110 newline,
adamc@871 111 box [string "char msg[1024];",
adamc@871 112 newline,
adamc@871 113 string "strncpy(msg, PQerrorMessage(conn), 1024);",
adamc@871 114 newline,
adamc@871 115 string "msg[1023] = 0;",
adamc@871 116 newline,
adamc@871 117 string "PQclear(res);",
adamc@871 118 newline,
adamc@871 119 string "PQfinish(conn);",
adamc@871 120 newline,
adamc@871 121 string "uw_error(ctx, FATAL, \"Query failed:\\n",
adamc@871 122 string q,
adamc@871 123 string "\\n%s\", msg);",
adamc@871 124 newline],
adamc@871 125 string "}",
adamc@871 126 newline,
adamc@871 127 newline,
adamc@871 128 string "if (strcmp(PQgetvalue(res, 0, 0), \"1\")) {",
adamc@871 129 newline,
adamc@871 130 box [string "PQclear(res);",
adamc@871 131 newline,
adamc@871 132 string "PQfinish(conn);",
adamc@871 133 newline,
adamc@871 134 string "uw_error(ctx, FATAL, \"Table '",
adamc@871 135 string s,
adamc@871 136 string "' does not exist.\");",
adamc@871 137 newline],
adamc@871 138 string "}",
adamc@871 139 newline,
adamc@871 140 newline,
adamc@871 141 string "PQclear(res);",
adamc@871 142 newline,
adamc@871 143
adamc@871 144 string "res = PQexec(conn, \"",
adamc@871 145 string q',
adamc@871 146 string "\");",
adamc@871 147 newline,
adamc@871 148 newline,
adamc@871 149 string "if (res == NULL) {",
adamc@871 150 newline,
adamc@871 151 box [string "PQfinish(conn);",
adamc@871 152 newline,
adamc@871 153 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
adamc@871 154 newline],
adamc@871 155 string "}",
adamc@871 156 newline,
adamc@871 157 newline,
adamc@871 158 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@871 159 newline,
adamc@871 160 box [string "char msg[1024];",
adamc@871 161 newline,
adamc@871 162 string "strncpy(msg, PQerrorMessage(conn), 1024);",
adamc@871 163 newline,
adamc@871 164 string "msg[1023] = 0;",
adamc@871 165 newline,
adamc@871 166 string "PQclear(res);",
adamc@871 167 newline,
adamc@871 168 string "PQfinish(conn);",
adamc@871 169 newline,
adamc@871 170 string "uw_error(ctx, FATAL, \"Query failed:\\n",
adamc@871 171 string q',
adamc@871 172 string "\\n%s\", msg);",
adamc@871 173 newline],
adamc@871 174 string "}",
adamc@871 175 newline,
adamc@871 176 newline,
adamc@871 177 string "if (strcmp(PQgetvalue(res, 0, 0), \"",
adamc@871 178 string (Int.toString (length xts)),
adamc@871 179 string "\")) {",
adamc@871 180 newline,
adamc@871 181 box [string "PQclear(res);",
adamc@871 182 newline,
adamc@871 183 string "PQfinish(conn);",
adamc@871 184 newline,
adamc@871 185 string "uw_error(ctx, FATAL, \"Table '",
adamc@871 186 string s,
adamc@871 187 string "' has the wrong column types.\");",
adamc@871 188 newline],
adamc@871 189 string "}",
adamc@871 190 newline,
adamc@871 191 newline,
adamc@871 192 string "PQclear(res);",
adamc@871 193 newline,
adamc@871 194 newline,
adamc@871 195
adamc@871 196 string "res = PQexec(conn, \"",
adamc@871 197 string q'',
adamc@871 198 string "\");",
adamc@871 199 newline,
adamc@871 200 newline,
adamc@871 201 string "if (res == NULL) {",
adamc@871 202 newline,
adamc@871 203 box [string "PQfinish(conn);",
adamc@871 204 newline,
adamc@871 205 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
adamc@871 206 newline],
adamc@871 207 string "}",
adamc@871 208 newline,
adamc@871 209 newline,
adamc@871 210 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@871 211 newline,
adamc@871 212 box [string "char msg[1024];",
adamc@871 213 newline,
adamc@871 214 string "strncpy(msg, PQerrorMessage(conn), 1024);",
adamc@871 215 newline,
adamc@871 216 string "msg[1023] = 0;",
adamc@871 217 newline,
adamc@871 218 string "PQclear(res);",
adamc@871 219 newline,
adamc@871 220 string "PQfinish(conn);",
adamc@871 221 newline,
adamc@871 222 string "uw_error(ctx, FATAL, \"Query failed:\\n",
adamc@871 223 string q'',
adamc@871 224 string "\\n%s\", msg);",
adamc@871 225 newline],
adamc@871 226 string "}",
adamc@871 227 newline,
adamc@871 228 newline,
adamc@871 229 string "if (strcmp(PQgetvalue(res, 0, 0), \"",
adamc@871 230 string (Int.toString (length xts)),
adamc@871 231 string "\")) {",
adamc@871 232 newline,
adamc@871 233 box [string "PQclear(res);",
adamc@871 234 newline,
adamc@871 235 string "PQfinish(conn);",
adamc@871 236 newline,
adamc@871 237 string "uw_error(ctx, FATAL, \"Table '",
adamc@871 238 string s,
adamc@871 239 string "' has extra columns.\");",
adamc@871 240 newline],
adamc@871 241 string "}",
adamc@871 242 newline,
adamc@871 243 newline,
adamc@871 244 string "PQclear(res);",
adamc@871 245 newline]
adamc@871 246 end
adamc@871 247
adamc@872 248 fun init {dbstring, prepared = ss, tables, views, sequences} =
adamc@866 249 box [if #persistent (currentProtocol ()) then
adamc@870 250 box [string "static void uw_db_validate(uw_context ctx) {",
adamc@870 251 newline,
adamc@870 252 string "PGconn *conn = uw_get_db(ctx);",
adamc@870 253 newline,
adamc@870 254 string "PGresult *res;",
adamc@870 255 newline,
adamc@870 256 newline,
adamc@872 257 p_list_sep newline (checkRel ("tables", true)) tables,
adamc@872 258 p_list_sep newline (checkRel ("views", false)) views,
adamc@870 259
adamc@870 260 p_list_sep newline
adamc@870 261 (fn s =>
adamc@870 262 let
adamc@870 263 val sl = CharVector.map Char.toLower s
adamc@870 264
adamc@870 265 val q = "SELECT COUNT(*) FROM pg_class WHERE relname = '"
adamc@870 266 ^ sl ^ "' AND relkind = 'S'"
adamc@870 267 in
adamc@870 268 box [string "res = PQexec(conn, \"",
adamc@870 269 string q,
adamc@870 270 string "\");",
adamc@870 271 newline,
adamc@870 272 newline,
adamc@870 273 string "if (res == NULL) {",
adamc@870 274 newline,
adamc@870 275 box [string "PQfinish(conn);",
adamc@870 276 newline,
adamc@870 277 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
adamc@870 278 newline],
adamc@870 279 string "}",
adamc@870 280 newline,
adamc@870 281 newline,
adamc@870 282 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@870 283 newline,
adamc@870 284 box [string "char msg[1024];",
adamc@870 285 newline,
adamc@870 286 string "strncpy(msg, PQerrorMessage(conn), 1024);",
adamc@870 287 newline,
adamc@870 288 string "msg[1023] = 0;",
adamc@870 289 newline,
adamc@870 290 string "PQclear(res);",
adamc@870 291 newline,
adamc@870 292 string "PQfinish(conn);",
adamc@870 293 newline,
adamc@870 294 string "uw_error(ctx, FATAL, \"Query failed:\\n",
adamc@870 295 string q,
adamc@870 296 string "\\n%s\", msg);",
adamc@870 297 newline],
adamc@870 298 string "}",
adamc@870 299 newline,
adamc@870 300 newline,
adamc@870 301 string "if (strcmp(PQgetvalue(res, 0, 0), \"1\")) {",
adamc@870 302 newline,
adamc@870 303 box [string "PQclear(res);",
adamc@870 304 newline,
adamc@870 305 string "PQfinish(conn);",
adamc@870 306 newline,
adamc@870 307 string "uw_error(ctx, FATAL, \"Sequence '",
adamc@870 308 string s,
adamc@870 309 string "' does not exist.\");",
adamc@870 310 newline],
adamc@870 311 string "}",
adamc@870 312 newline,
adamc@870 313 newline,
adamc@870 314 string "PQclear(res);",
adamc@870 315 newline]
adamc@870 316 end) sequences,
adamc@870 317
adamc@870 318 string "}",
adamc@870 319
adamc@870 320 string "static void uw_db_prepare(uw_context ctx) {",
adamc@866 321 newline,
adamc@866 322 string "PGconn *conn = uw_get_db(ctx);",
adamc@866 323 newline,
adamc@866 324 string "PGresult *res;",
adamc@866 325 newline,
adamc@866 326 newline,
adamc@866 327
adamc@866 328 p_list_sepi newline (fn i => fn (s, n) =>
adamc@866 329 box [string "res = PQprepare(conn, \"uw",
adamc@866 330 string (Int.toString i),
adamc@866 331 string "\", \"",
adamc@866 332 string (String.toString s),
adamc@866 333 string "\", ",
adamc@866 334 string (Int.toString n),
adamc@866 335 string ", NULL);",
adamc@866 336 newline,
adamc@866 337 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@866 338 newline,
adamc@866 339 box [string "char msg[1024];",
adamc@866 340 newline,
adamc@866 341 string "strncpy(msg, PQerrorMessage(conn), 1024);",
adamc@866 342 newline,
adamc@866 343 string "msg[1023] = 0;",
adamc@866 344 newline,
adamc@866 345 string "PQclear(res);",
adamc@866 346 newline,
adamc@866 347 string "PQfinish(conn);",
adamc@866 348 newline,
adamc@866 349 string "uw_error(ctx, FATAL, \"Unable to create prepared statement:\\n",
adamc@866 350 string (String.toString s),
adamc@866 351 string "\\n%s\", msg);",
adamc@866 352 newline],
adamc@866 353 string "}",
adamc@866 354 newline,
adamc@866 355 string "PQclear(res);",
adamc@866 356 newline])
adamc@866 357 ss,
adamc@866 358
adamc@866 359 string "}",
adamc@866 360 newline,
adamc@866 361 newline,
adamc@866 362
adamc@866 363 string "void uw_db_close(uw_context ctx) {",
adamc@866 364 newline,
adamc@866 365 string "PQfinish(uw_get_db(ctx));",
adamc@866 366 newline,
adamc@866 367 string "}",
adamc@866 368 newline,
adamc@866 369 newline,
adamc@866 370
adamc@866 371 string "int uw_db_begin(uw_context ctx) {",
adamc@866 372 newline,
adamc@866 373 string "PGconn *conn = uw_get_db(ctx);",
adamc@866 374 newline,
adamc@866 375 string "PGresult *res = PQexec(conn, \"BEGIN ISOLATION LEVEL SERIALIZABLE\");",
adamc@866 376 newline,
adamc@866 377 newline,
adamc@866 378 string "if (res == NULL) return 1;",
adamc@866 379 newline,
adamc@866 380 newline,
adamc@866 381 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@866 382 box [string "PQclear(res);",
adamc@866 383 newline,
adamc@866 384 string "return 1;",
adamc@866 385 newline],
adamc@866 386 string "}",
adamc@866 387 newline,
adamc@866 388 string "return 0;",
adamc@866 389 newline,
adamc@866 390 string "}",
adamc@866 391 newline,
adamc@866 392 newline,
adamc@866 393
adamc@866 394 string "int uw_db_commit(uw_context ctx) {",
adamc@866 395 newline,
adamc@866 396 string "PGconn *conn = uw_get_db(ctx);",
adamc@866 397 newline,
adamc@866 398 string "PGresult *res = PQexec(conn, \"COMMIT\");",
adamc@866 399 newline,
adamc@866 400 newline,
adamc@866 401 string "if (res == NULL) return 1;",
adamc@866 402 newline,
adamc@866 403 newline,
adamc@866 404 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@866 405 box [string "PQclear(res);",
adamc@866 406 newline,
adamc@866 407 string "return 1;",
adamc@866 408 newline],
adamc@866 409 string "}",
adamc@866 410 newline,
adamc@866 411 string "return 0;",
adamc@866 412 newline,
adamc@866 413 string "}",
adamc@866 414 newline,
adamc@866 415 newline,
adamc@866 416
adamc@866 417 string "int uw_db_rollback(uw_context ctx) {",
adamc@866 418 newline,
adamc@866 419 string "PGconn *conn = uw_get_db(ctx);",
adamc@866 420 newline,
adamc@866 421 string "PGresult *res = PQexec(conn, \"ROLLBACK\");",
adamc@866 422 newline,
adamc@866 423 newline,
adamc@866 424 string "if (res == NULL) return 1;",
adamc@866 425 newline,
adamc@866 426 newline,
adamc@866 427 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@866 428 box [string "PQclear(res);",
adamc@866 429 newline,
adamc@866 430 string "return 1;",
adamc@866 431 newline],
adamc@866 432 string "}",
adamc@866 433 newline,
adamc@866 434 string "return 0;",
adamc@866 435 newline,
adamc@866 436 string "}",
adamc@866 437 newline,
adamc@866 438 newline]
adamc@866 439 else
adamc@870 440 box [string "static void uw_db_validate(uw_context ctx) { }",
adamc@870 441 newline,
adamc@870 442 string "static void uw_db_prepare(uw_context ctx) { }"],
adamc@870 443
adamc@866 444 newline,
adamc@866 445 newline,
adamc@866 446
adamc@866 447 string "void uw_db_init(uw_context ctx) {",
adamc@866 448 newline,
adamc@866 449 string "PGconn *conn = PQconnectdb(\"",
adamc@866 450 string (String.toString dbstring),
adamc@866 451 string "\");",
adamc@866 452 newline,
adamc@866 453 string "if (conn == NULL) uw_error(ctx, FATAL, ",
adamc@866 454 string "\"libpq can't allocate a connection.\");",
adamc@866 455 newline,
adamc@866 456 string "if (PQstatus(conn) != CONNECTION_OK) {",
adamc@866 457 newline,
adamc@866 458 box [string "char msg[1024];",
adamc@866 459 newline,
adamc@866 460 string "strncpy(msg, PQerrorMessage(conn), 1024);",
adamc@866 461 newline,
adamc@866 462 string "msg[1023] = 0;",
adamc@866 463 newline,
adamc@866 464 string "PQfinish(conn);",
adamc@866 465 newline,
adamc@866 466 string "uw_error(ctx, BOUNDED_RETRY, ",
adamc@866 467 string "\"Connection to Postgres server failed: %s\", msg);"],
adamc@866 468 newline,
adamc@866 469 string "}",
adamc@866 470 newline,
adamc@866 471 string "uw_set_db(ctx, conn);",
adamc@866 472 newline,
adamc@866 473 string "uw_db_validate(ctx);",
adamc@866 474 newline,
adamc@866 475 string "uw_db_prepare(ctx);",
adamc@866 476 newline,
adamc@866 477 string "}"]
adamc@866 478
adamc@867 479 fun p_getcol {wontLeakStrings, col = i, typ = t} =
adamc@867 480 let
adamc@867 481 fun p_unsql t e eLen =
adamc@867 482 case t of
adamc@867 483 Int => box [string "uw_Basis_stringToInt_error(ctx, ", e, string ")"]
adamc@867 484 | Float => box [string "uw_Basis_stringToFloat_error(ctx, ", e, string ")"]
adamc@867 485 | String =>
adamc@867 486 if wontLeakStrings then
adamc@867 487 e
adamc@867 488 else
adamc@867 489 box [string "uw_strdup(ctx, ", e, string ")"]
adamc@867 490 | Bool => box [string "uw_Basis_stringToBool_error(ctx, ", e, string ")"]
adamc@867 491 | Time => box [string "uw_Basis_stringToTime_error(ctx, ", e, string ")"]
adamc@867 492 | Blob => box [string "uw_Basis_stringToBlob_error(ctx, ",
adamc@867 493 e,
adamc@867 494 string ", ",
adamc@867 495 eLen,
adamc@867 496 string ")"]
adamc@867 497 | Channel => box [string "uw_Basis_stringToChannel_error(ctx, ", e, string ")"]
adamc@867 498 | Client => box [string "uw_Basis_stringToClient_error(ctx, ", e, string ")"]
adamc@867 499
adamc@867 500 | Nullable _ => raise Fail "Postgres: Recursive Nullable"
adamc@867 501
adamc@867 502 fun getter t =
adamc@867 503 case t of
adamc@867 504 Nullable t =>
adamc@867 505 box [string "(PQgetisnull(res, i, ",
adamc@867 506 string (Int.toString i),
adamc@867 507 string ") ? NULL : ",
adamc@867 508 case t of
adamc@867 509 String => getter t
adamc@867 510 | _ => box [string "({",
adamc@867 511 newline,
adamc@870 512 string (p_sql_type t),
adamc@867 513 space,
adamc@867 514 string "*tmp = uw_malloc(ctx, sizeof(",
adamc@870 515 string (p_sql_type t),
adamc@867 516 string "));",
adamc@867 517 newline,
adamc@867 518 string "*tmp = ",
adamc@867 519 getter t,
adamc@867 520 string ";",
adamc@867 521 newline,
adamc@867 522 string "tmp;",
adamc@867 523 newline,
adamc@867 524 string "})"],
adamc@867 525 string ")"]
adamc@867 526 | _ =>
adamc@867 527 box [string "(PQgetisnull(res, i, ",
adamc@867 528 string (Int.toString i),
adamc@867 529 string ") ? ",
adamc@867 530 box [string "({",
adamc@870 531 string (p_sql_type t),
adamc@867 532 space,
adamc@867 533 string "tmp;",
adamc@867 534 newline,
adamc@867 535 string "uw_error(ctx, FATAL, \"Unexpectedly NULL field #",
adamc@867 536 string (Int.toString i),
adamc@867 537 string "\");",
adamc@867 538 newline,
adamc@867 539 string "tmp;",
adamc@867 540 newline,
adamc@867 541 string "})"],
adamc@867 542 string " : ",
adamc@867 543 p_unsql t
adamc@867 544 (box [string "PQgetvalue(res, i, ",
adamc@867 545 string (Int.toString i),
adamc@867 546 string ")"])
adamc@867 547 (box [string "PQgetlength(res, i, ",
adamc@867 548 string (Int.toString i),
adamc@867 549 string ")"]),
adamc@867 550 string ")"]
adamc@867 551 in
adamc@867 552 getter t
adamc@867 553 end
adamc@867 554
adamc@873 555 fun queryCommon {loc, query, cols, doCols} =
adamc@867 556 box [string "int n, i;",
adamc@867 557 newline,
adamc@867 558 newline,
adamc@867 559
adamc@867 560 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
adamc@867 561 newline,
adamc@867 562 newline,
adamc@867 563
adamc@867 564 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@867 565 newline,
adamc@867 566 box [string "PQclear(res);",
adamc@867 567 newline,
adamc@867 568 string "uw_error(ctx, FATAL, \"",
adamc@867 569 string (ErrorMsg.spanToString loc),
adamc@867 570 string ": Query failed:\\n%s\\n%s\", ",
adamc@867 571 query,
adamc@867 572 string ", PQerrorMessage(conn));",
adamc@867 573 newline],
adamc@867 574 string "}",
adamc@867 575 newline,
adamc@867 576 newline,
adamc@867 577
adamc@867 578 string "if (PQnfields(res) != ",
adamc@873 579 string (Int.toString (length cols)),
adamc@867 580 string ") {",
adamc@867 581 newline,
adamc@867 582 box [string "int nf = PQnfields(res);",
adamc@867 583 newline,
adamc@867 584 string "PQclear(res);",
adamc@867 585 newline,
adamc@867 586 string "uw_error(ctx, FATAL, \"",
adamc@867 587 string (ErrorMsg.spanToString loc),
adamc@867 588 string ": Query returned %d columns instead of ",
adamc@873 589 string (Int.toString (length cols)),
adamc@867 590 string ":\\n%s\\n%s\", nf, ",
adamc@867 591 query,
adamc@867 592 string ", PQerrorMessage(conn));",
adamc@867 593 newline],
adamc@867 594 string "}",
adamc@867 595 newline,
adamc@867 596 newline,
adamc@867 597
adamc@867 598 string "uw_end_region(ctx);",
adamc@867 599 newline,
adamc@867 600 string "uw_push_cleanup(ctx, (void (*)(void *))PQclear, res);",
adamc@867 601 newline,
adamc@867 602 string "n = PQntuples(res);",
adamc@867 603 newline,
adamc@867 604 string "for (i = 0; i < n; ++i) {",
adamc@867 605 newline,
adamc@867 606 doCols p_getcol,
adamc@867 607 string "}",
adamc@867 608 newline,
adamc@867 609 newline,
adamc@867 610 string "uw_pop_cleanup(ctx);",
adamc@867 611 newline]
adamc@867 612
adamc@873 613 fun query {loc, cols, doCols} =
adamc@867 614 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@867 615 newline,
adamc@867 616 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
adamc@867 617 newline,
adamc@867 618 newline,
adamc@873 619 queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"}]
adamc@867 620
adamc@867 621 fun p_ensql t e =
adamc@867 622 case t of
adamc@867 623 Int => box [string "uw_Basis_attrifyInt(ctx, ", e, string ")"]
adamc@867 624 | Float => box [string "uw_Basis_attrifyFloat(ctx, ", e, string ")"]
adamc@867 625 | String => e
adamc@867 626 | Bool => box [string "(", e, string " ? \"TRUE\" : \"FALSE\")"]
adamc@867 627 | Time => box [string "uw_Basis_attrifyTime(ctx, ", e, string ")"]
adamc@867 628 | Blob => box [e, string ".data"]
adamc@867 629 | Channel => box [string "uw_Basis_attrifyChannel(ctx, ", e, string ")"]
adamc@867 630 | Client => box [string "uw_Basis_attrifyClient(ctx, ", e, string ")"]
adamc@867 631 | Nullable String => e
adamc@867 632 | Nullable t => box [string "(",
adamc@867 633 e,
adamc@867 634 string " == NULL ? NULL : ",
adamc@867 635 p_ensql t (box [string "(*", e, string ")"]),
adamc@867 636 string ")"]
adamc@867 637
adamc@873 638 fun queryPrepared {loc, id, query, inputs, cols, doCols} =
adamc@867 639 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@867 640 newline,
adamc@867 641 string "const int paramFormats[] = { ",
adamc@867 642 p_list_sep (box [string ",", space])
adamc@867 643 (fn t => if isBlob t then string "1" else string "0") inputs,
adamc@867 644 string " };",
adamc@867 645 newline,
adamc@867 646 string "const int paramLengths[] = { ",
adamc@867 647 p_list_sepi (box [string ",", space])
adamc@867 648 (fn i => fn Blob => string ("arg" ^ Int.toString (i + 1) ^ ".size")
adamc@867 649 | Nullable Blob => string ("arg" ^ Int.toString (i + 1)
adamc@867 650 ^ "?arg" ^ Int.toString (i + 1) ^ "->size:0")
adamc@867 651 | _ => string "0") inputs,
adamc@867 652 string " };",
adamc@867 653 newline,
adamc@867 654 string "const char *paramValues[] = { ",
adamc@867 655 p_list_sepi (box [string ",", space])
adamc@867 656 (fn i => fn t => p_ensql t (box [string "arg",
adamc@867 657 string (Int.toString (i + 1))]))
adamc@867 658 inputs,
adamc@867 659 string " };",
adamc@867 660 newline,
adamc@867 661 newline,
adamc@867 662 string "PGresult *res = ",
adamc@867 663 if #persistent (Settings.currentProtocol ()) then
adamc@867 664 box [string "PQexecPrepared(conn, \"uw",
adamc@867 665 string (Int.toString id),
adamc@867 666 string "\", ",
adamc@867 667 string (Int.toString (length inputs)),
adamc@867 668 string ", paramValues, paramLengths, paramFormats, 0);"]
adamc@867 669 else
adamc@867 670 box [string "PQexecParams(conn, \"",
adamc@867 671 string (String.toString query),
adamc@867 672 string "\", ",
adamc@867 673 string (Int.toString (length inputs)),
adamc@867 674 string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
adamc@867 675 newline,
adamc@867 676 newline,
adamc@873 677 queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
adamc@873 678 string (String.toString query),
adamc@873 679 string "\""]}]
adamc@867 680
adamc@868 681 fun dmlCommon {loc, dml} =
adamc@868 682 box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
adamc@868 683 newline,
adamc@868 684 newline,
adamc@868 685
adamc@868 686 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@868 687 newline,
adamc@868 688 box [string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {",
adamc@868 689 box [newline,
adamc@868 690 string "PQclear(res);",
adamc@868 691 newline,
adamc@868 692 string "uw_error(ctx, UNLIMITED_RETRY, \"Serialization failure\");",
adamc@868 693 newline],
adamc@868 694 string "}",
adamc@868 695 newline,
adamc@868 696 string "PQclear(res);",
adamc@868 697 newline,
adamc@868 698 string "uw_error(ctx, FATAL, \"",
adamc@868 699 string (ErrorMsg.spanToString loc),
adamc@868 700 string ": DML failed:\\n%s\\n%s\", ",
adamc@868 701 dml,
adamc@868 702 string ", PQerrorMessage(conn));",
adamc@868 703 newline],
adamc@868 704 string "}",
adamc@868 705 newline,
adamc@868 706 newline,
adamc@868 707
adamc@868 708 string "PQclear(res);",
adamc@868 709 newline]
adamc@868 710
adamc@868 711 fun dml loc =
adamc@868 712 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@868 713 newline,
adamc@868 714 string "PGresult *res = PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);",
adamc@868 715 newline,
adamc@868 716 newline,
adamc@868 717 dmlCommon {loc = loc, dml = string "dml"}]
adamc@868 718
adamc@868 719 fun dmlPrepared {loc, id, dml, inputs} =
adamc@868 720 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@868 721 newline,
adamc@868 722 string "const int paramFormats[] = { ",
adamc@868 723 p_list_sep (box [string ",", space])
adamc@868 724 (fn t => if isBlob t then string "1" else string "0") inputs,
adamc@868 725 string " };",
adamc@868 726 newline,
adamc@868 727 string "const int paramLengths[] = { ",
adamc@868 728 p_list_sepi (box [string ",", space])
adamc@868 729 (fn i => fn Blob => string ("arg" ^ Int.toString (i + 1) ^ ".size")
adamc@868 730 | Nullable Blob => string ("arg" ^ Int.toString (i + 1)
adamc@868 731 ^ "?arg" ^ Int.toString (i + 1) ^ "->size:0")
adamc@868 732 | _ => string "0") inputs,
adamc@868 733 string " };",
adamc@868 734 newline,
adamc@868 735 string "const char *paramValues[] = { ",
adamc@868 736 p_list_sepi (box [string ",", space])
adamc@868 737 (fn i => fn t => p_ensql t (box [string "arg",
adamc@868 738 string (Int.toString (i + 1))]))
adamc@868 739 inputs,
adamc@868 740 string " };",
adamc@868 741 newline,
adamc@868 742 newline,
adamc@868 743 string "PGresult *res = ",
adamc@868 744 if #persistent (Settings.currentProtocol ()) then
adamc@868 745 box [string "PQexecPrepared(conn, \"uw",
adamc@868 746 string (Int.toString id),
adamc@868 747 string "\", ",
adamc@868 748 string (Int.toString (length inputs)),
adamc@868 749 string ", paramValues, paramLengths, paramFormats, 0);"]
adamc@868 750 else
adamc@868 751 box [string "PQexecParams(conn, \"",
adamc@868 752 string (String.toString dml),
adamc@868 753 string "\", ",
adamc@868 754 string (Int.toString (length inputs)),
adamc@868 755 string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
adamc@868 756 newline,
adamc@868 757 newline,
adamc@868 758 dmlCommon {loc = loc, dml = box [string "\"",
adamc@868 759 string (String.toString dml),
adamc@868 760 string "\""]}]
adamc@868 761
adamc@869 762 fun nextvalCommon {loc, query} =
adamc@869 763 box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating nextval result.\");",
adamc@869 764 newline,
adamc@869 765 newline,
adamc@869 766
adamc@869 767 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
adamc@869 768 newline,
adamc@869 769 box [string "PQclear(res);",
adamc@869 770 newline,
adamc@869 771 string "uw_error(ctx, FATAL, \"",
adamc@869 772 string (ErrorMsg.spanToString loc),
adamc@869 773 string ": Query failed:\\n%s\\n%s\", ",
adamc@869 774 query,
adamc@869 775 string ", PQerrorMessage(conn));",
adamc@869 776 newline],
adamc@869 777 string "}",
adamc@869 778 newline,
adamc@869 779 newline,
adamc@869 780
adamc@869 781 string "uw_end_region(ctx);",
adamc@869 782 newline,
adamc@869 783 string "n = PQntuples(res);",
adamc@869 784 newline,
adamc@869 785 string "if (n != 1) {",
adamc@869 786 newline,
adamc@869 787 box [string "PQclear(res);",
adamc@869 788 newline,
adamc@869 789 string "uw_error(ctx, FATAL, \"",
adamc@869 790 string (ErrorMsg.spanToString loc),
adamc@869 791 string ": Wrong number of result rows:\\n%s\\n%s\", ",
adamc@869 792 query,
adamc@869 793 string ", PQerrorMessage(conn));",
adamc@869 794 newline],
adamc@869 795 string "}",
adamc@869 796 newline,
adamc@869 797 newline,
adamc@869 798
adamc@869 799 string "n = uw_Basis_stringToInt_error(ctx, PQgetvalue(res, 0, 0));",
adamc@869 800 newline,
adamc@869 801 string "PQclear(res);",
adamc@869 802 newline]
adamc@869 803
adamc@869 804 fun nextval loc =
adamc@869 805 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@869 806 newline,
adamc@869 807 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
adamc@869 808 newline,
adamc@869 809 newline,
adamc@869 810 nextvalCommon {loc = loc, query = string "query"}]
adamc@869 811
adamc@869 812 fun nextvalPrepared {loc, id, query} =
adamc@869 813 box [string "PGconn *conn = uw_get_db(ctx);",
adamc@869 814 newline,
adamc@869 815 newline,
adamc@869 816 string "PGresult *res = ",
adamc@869 817 if #persistent (Settings.currentProtocol ()) then
adamc@869 818 box [string "PQexecPrepared(conn, \"uw",
adamc@869 819 string (Int.toString id),
adamc@869 820 string "\", 0, NULL, NULL, NULL, 0);"]
adamc@869 821 else
adamc@869 822 box [string "PQexecParams(conn, \"",
adamc@869 823 string (String.toString query),
adamc@869 824 string "\", 0, NULL, NULL, NULL, NULL, 0);"],
adamc@869 825 newline,
adamc@869 826 newline,
adamc@869 827 nextvalCommon {loc = loc, query = box [string "\"",
adamc@869 828 string (String.toString query),
adamc@869 829 string "\""]}]
adamc@869 830
adamc@866 831 val () = addDbms {name = "postgres",
adamc@866 832 header = "postgresql/libpq-fe.h",
adamc@866 833 link = "-lpq",
adamc@866 834 global_init = box [string "void uw_client_init() { }",
adamc@866 835 newline],
adamc@873 836 p_sql_type = p_sql_type,
adamc@867 837 init = init,
adamc@867 838 query = query,
adamc@868 839 queryPrepared = queryPrepared,
adamc@868 840 dml = dml,
adamc@869 841 dmlPrepared = dmlPrepared,
adamc@869 842 nextval = nextval,
adamc@869 843 nextvalPrepared = nextvalPrepared}
adamc@866 844 val () = setDbms "postgres"
adamc@866 845
adamc@866 846 end