Mercurial > urweb

annotate src/postgres.sml @ 866:03e7f111fe99

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Start of multi-DBMS support
author Adam Chlipala <adamc@hcoop.net>
date Sun, 28 Jun 2009 13:49:32 -0400
parents
children e7f80d78075b
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@866 34 fun init (dbstring, ss) =
adamc@866 35 box [if #persistent (currentProtocol ()) then
adamc@866 36 box [string "static void uw_db_prepare(uw_context ctx) {",
adamc@866 37 newline,
adamc@866 38 string "PGconn *conn = uw_get_db(ctx);",
adamc@866 39 newline,
adamc@866 40 string "PGresult *res;",
adamc@866 41 newline,
adamc@866 42 newline,
adamc@866 43
adamc@866 44 p_list_sepi newline (fn i => fn (s, n) =>
adamc@866 45 box [string "res = PQprepare(conn, \"uw",
adamc@866 46 string (Int.toString i),
adamc@866 47 string "\", \"",
adamc@866 48 string (String.toString s),
adamc@866 49 string "\", ",
adamc@866 50 string (Int.toString n),
adamc@866 51 string ", NULL);",
adamc@866 52 newline,
adamc@866 53 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@866 54 newline,
adamc@866 55 box [string "char msg[1024];",
adamc@866 56 newline,
adamc@866 57 string "strncpy(msg, PQerrorMessage(conn), 1024);",
adamc@866 58 newline,
adamc@866 59 string "msg[1023] = 0;",
adamc@866 60 newline,
adamc@866 61 string "PQclear(res);",
adamc@866 62 newline,
adamc@866 63 string "PQfinish(conn);",
adamc@866 64 newline,
adamc@866 65 string "uw_error(ctx, FATAL, \"Unable to create prepared statement:\\n",
adamc@866 66 string (String.toString s),
adamc@866 67 string "\\n%s\", msg);",
adamc@866 68 newline],
adamc@866 69 string "}",
adamc@866 70 newline,
adamc@866 71 string "PQclear(res);",
adamc@866 72 newline])
adamc@866 73 ss,
adamc@866 74
adamc@866 75 string "}",
adamc@866 76 newline,
adamc@866 77 newline,
adamc@866 78
adamc@866 79 string "void uw_db_close(uw_context ctx) {",
adamc@866 80 newline,
adamc@866 81 string "PQfinish(uw_get_db(ctx));",
adamc@866 82 newline,
adamc@866 83 string "}",
adamc@866 84 newline,
adamc@866 85 newline,
adamc@866 86
adamc@866 87 string "int uw_db_begin(uw_context ctx) {",
adamc@866 88 newline,
adamc@866 89 string "PGconn *conn = uw_get_db(ctx);",
adamc@866 90 newline,
adamc@866 91 string "PGresult *res = PQexec(conn, \"BEGIN ISOLATION LEVEL SERIALIZABLE\");",
adamc@866 92 newline,
adamc@866 93 newline,
adamc@866 94 string "if (res == NULL) return 1;",
adamc@866 95 newline,
adamc@866 96 newline,
adamc@866 97 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@866 98 box [string "PQclear(res);",
adamc@866 99 newline,
adamc@866 100 string "return 1;",
adamc@866 101 newline],
adamc@866 102 string "}",
adamc@866 103 newline,
adamc@866 104 string "return 0;",
adamc@866 105 newline,
adamc@866 106 string "}",
adamc@866 107 newline,
adamc@866 108 newline,
adamc@866 109
adamc@866 110 string "int uw_db_commit(uw_context ctx) {",
adamc@866 111 newline,
adamc@866 112 string "PGconn *conn = uw_get_db(ctx);",
adamc@866 113 newline,
adamc@866 114 string "PGresult *res = PQexec(conn, \"COMMIT\");",
adamc@866 115 newline,
adamc@866 116 newline,
adamc@866 117 string "if (res == NULL) return 1;",
adamc@866 118 newline,
adamc@866 119 newline,
adamc@866 120 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@866 121 box [string "PQclear(res);",
adamc@866 122 newline,
adamc@866 123 string "return 1;",
adamc@866 124 newline],
adamc@866 125 string "}",
adamc@866 126 newline,
adamc@866 127 string "return 0;",
adamc@866 128 newline,
adamc@866 129 string "}",
adamc@866 130 newline,
adamc@866 131 newline,
adamc@866 132
adamc@866 133 string "int uw_db_rollback(uw_context ctx) {",
adamc@866 134 newline,
adamc@866 135 string "PGconn *conn = uw_get_db(ctx);",
adamc@866 136 newline,
adamc@866 137 string "PGresult *res = PQexec(conn, \"ROLLBACK\");",
adamc@866 138 newline,
adamc@866 139 newline,
adamc@866 140 string "if (res == NULL) return 1;",
adamc@866 141 newline,
adamc@866 142 newline,
adamc@866 143 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
adamc@866 144 box [string "PQclear(res);",
adamc@866 145 newline,
adamc@866 146 string "return 1;",
adamc@866 147 newline],
adamc@866 148 string "}",
adamc@866 149 newline,
adamc@866 150 string "return 0;",
adamc@866 151 newline,
adamc@866 152 string "}",
adamc@866 153 newline,
adamc@866 154 newline]
adamc@866 155 else
adamc@866 156 string "static void uw_db_prepare(uw_context ctx) { }",
adamc@866 157 newline,
adamc@866 158 newline,
adamc@866 159
adamc@866 160 string "void uw_db_init(uw_context ctx) {",
adamc@866 161 newline,
adamc@866 162 string "PGconn *conn = PQconnectdb(\"",
adamc@866 163 string (String.toString dbstring),
adamc@866 164 string "\");",
adamc@866 165 newline,
adamc@866 166 string "if (conn == NULL) uw_error(ctx, FATAL, ",
adamc@866 167 string "\"libpq can't allocate a connection.\");",
adamc@866 168 newline,
adamc@866 169 string "if (PQstatus(conn) != CONNECTION_OK) {",
adamc@866 170 newline,
adamc@866 171 box [string "char msg[1024];",
adamc@866 172 newline,
adamc@866 173 string "strncpy(msg, PQerrorMessage(conn), 1024);",
adamc@866 174 newline,
adamc@866 175 string "msg[1023] = 0;",
adamc@866 176 newline,
adamc@866 177 string "PQfinish(conn);",
adamc@866 178 newline,
adamc@866 179 string "uw_error(ctx, BOUNDED_RETRY, ",
adamc@866 180 string "\"Connection to Postgres server failed: %s\", msg);"],
adamc@866 181 newline,
adamc@866 182 string "}",
adamc@866 183 newline,
adamc@866 184 string "uw_set_db(ctx, conn);",
adamc@866 185 newline,
adamc@866 186 string "uw_db_validate(ctx);",
adamc@866 187 newline,
adamc@866 188 string "uw_db_prepare(ctx);",
adamc@866 189 newline,
adamc@866 190 string "}"]
adamc@866 191
adamc@866 192 val () = addDbms {name = "postgres",
adamc@866 193 header = "postgresql/libpq-fe.h",
adamc@866 194 link = "-lpq",
adamc@866 195 global_init = box [string "void uw_client_init() { }",
adamc@866 196 newline],
adamc@866 197 init = init}
adamc@866 198 val () = setDbms "postgres"
adamc@866 199
adamc@866 200 end