Mercurial > urweb
diff src/cjr_print.sml @ 866:03e7f111fe99
Start of multi-DBMS support
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 28 Jun 2009 13:49:32 -0400 |
parents | 305bc0a431de |
children | e7f80d78075b |
line wrap: on
line diff
--- a/src/cjr_print.sml Sun Jun 28 11:49:04 2009 -0400 +++ b/src/cjr_print.sml Sun Jun 28 13:49:32 2009 -0400 @@ -2039,6 +2039,8 @@ string "}"] end +val prepped = ref ([] : (string * int) list) + fun p_decl env (dAll as (d, _) : decl) = case d of DStruct (n, xts) => @@ -2196,115 +2198,8 @@ string "static void uw_db_prepare(uw_context);", newline, newline, - string "void uw_db_init(uw_context ctx) {", - newline, - string "PGconn *conn = PQconnectdb(\"", - string (String.toString name), - string "\");", - newline, - string "if (conn == NULL) uw_error(ctx, BOUNDED_RETRY, ", - string "\"libpq can't allocate a connection.\");", - newline, - string "if (PQstatus(conn) != CONNECTION_OK) {", - newline, - box [string "char msg[1024];", - newline, - string "strncpy(msg, PQerrorMessage(conn), 1024);", - newline, - string "msg[1023] = 0;", - newline, - string "PQfinish(conn);", - newline, - string "uw_error(ctx, BOUNDED_RETRY, ", - string "\"Connection to Postgres server failed: %s\", msg);"], - newline, - string "}", - newline, - string "uw_set_db(ctx, conn);", - newline, - string "uw_db_validate(ctx);", - newline, - string "uw_db_prepare(ctx);", - newline, - string "}", - newline, - newline, - string "void uw_db_close(uw_context ctx) {", - newline, - string "PQfinish(uw_get_db(ctx));", - newline, - string "}", - newline, - newline, - string "int uw_db_begin(uw_context ctx) {", - newline, - string "PGconn *conn = uw_get_db(ctx);", - newline, - string "PGresult *res = PQexec(conn, \"BEGIN ISOLATION LEVEL SERIALIZABLE\");", - newline, - newline, - string "if (res == NULL) return 1;", - newline, - newline, - string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {", - box [string "PQclear(res);", - newline, - string "return 1;", - newline], - string "}", - newline, - string "return 0;", - newline, - string "}", - newline, - newline, - - string "int uw_db_commit(uw_context ctx) {", - newline, - string "PGconn *conn = uw_get_db(ctx);", - newline, - string "PGresult *res = PQexec(conn, \"COMMIT\");", - newline, - newline, - string "if (res == NULL) return 1;", - newline, - newline, - string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {", - box [string "PQclear(res);", - newline, - string "return 1;", - newline], - string "}", - newline, - string "return 0;", - newline, - string "}", - newline, - newline, - - string "int uw_db_rollback(uw_context ctx) {", - newline, - string "PGconn *conn = uw_get_db(ctx);", - newline, - string "PGresult *res = PQexec(conn, \"ROLLBACK\");", - newline, - newline, - string "if (res == NULL) return 1;", - newline, - newline, - string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {", - box [string "PQclear(res);", - newline, - string "return 1;", - newline], - string "}", - newline, - string "return 0;", - newline, - string "}", - newline, - newline, + #init (Settings.currentDbms ()) (name, !prepped), string "void uw_expunger(uw_context ctx, uw_Basis_client cli) {", newline, @@ -2323,54 +2218,9 @@ string "}", newline] - | DPreparedStatements [] => - box [string "static void uw_db_prepare(uw_context ctx) {", - newline, - string "}"] | DPreparedStatements ss => - if #persistent (Settings.currentProtocol ()) then - box [string "static void uw_db_prepare(uw_context ctx) {", - newline, - string "PGconn *conn = uw_get_db(ctx);", - newline, - string "PGresult *res;", - newline, - newline, - - p_list_sepi newline (fn i => fn (s, n) => - box [string "res = PQprepare(conn, \"uw", - string (Int.toString i), - string "\", \"", - string (String.toString s), - string "\", ", - string (Int.toString n), - string ", NULL);", - newline, - string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {", - newline, - box [string "char msg[1024];", - newline, - string "strncpy(msg, PQerrorMessage(conn), 1024);", - newline, - string "msg[1023] = 0;", - newline, - string "PQclear(res);", - newline, - string "PQfinish(conn);", - newline, - string "uw_error(ctx, FATAL, \"Unable to create prepared statement:\\n", - string (String.toString s), - string "\\n%s\", msg);", - newline], - string "}", - newline, - string "PQclear(res);", - newline]) - ss, - - string "}"] - else - string "static void uw_db_prepare(uw_context ctx) { }" + (prepped := ss; + box []) | DJavaScript s => box [string "static char jslib[] = \"", string (String.toString s), @@ -3268,7 +3118,7 @@ string "#include <math.h>", newline, if hasDb then - box [string "#include <postgresql/libpq-fe.h>", + box [string ("#include <" ^ #header (Settings.currentDbms ()) ^ ">"), newline] else box [],