summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/c/urweb.c9
-rw-r--r--src/cjr_print.sml12
-rw-r--r--src/mysql.sml4
-rw-r--r--src/postgres.sml98
-rw-r--r--src/sqlite.sml4
5 files changed, 106 insertions, 21 deletions
diff --git a/src/c/urweb.c b/src/c/urweb.c
index cac518ec..747f62b6 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -2175,6 +2175,15 @@ uw_Basis_string uw_strdup(uw_context ctx, uw_Basis_string s1) {
return s;
}
+uw_Basis_string uw_dup_and_clear_error_message(uw_context ctx) {
+ if (ctx->error_message[0]) {
+ char *s = uw_strdup(ctx, ctx->error_message);
+ ctx->error_message[0] = 0;
+ return s;
+ } else
+ return NULL;
+}
+
uw_Basis_string uw_maybe_strdup(uw_context ctx, uw_Basis_string s1) {
if (s1)
return uw_strdup(ctx, s1);
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 9b5edab5..5282ddc2 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -1794,10 +1794,7 @@ fun p_exp' par env (e, loc) =
end
| EDml {dml, prepared, mode} =>
- box [case mode of
- Settings.Error => box []
- | Settings.None => string "({const char *uw_errmsg = NULL;",
- string "(uw_begin_region(ctx), ({",
+ box [string "(uw_begin_region(ctx), ({",
newline,
case prepared of
NONE => box [string "char *dml = ",
@@ -1838,13 +1835,10 @@ fun p_exp' par env (e, loc) =
case mode of
Settings.Error => string "uw_unit_v;"
- | Settings.None => string "uw_errmsg ? uw_strdup(ctx, uw_errmsg) : NULL;",
+ | Settings.None => string "uw_dup_and_clear_error_message(ctx);",
newline,
- string "}))",
- case mode of
- Settings.Error => box []
- | Settings.None => string ";})"]
+ string "}))"]
| ENextval {seq, prepared} =>
box [string "({",
diff --git a/src/mysql.sml b/src/mysql.sml
index 44d88c1d..2f28f4dd 100644
--- a/src/mysql.sml
+++ b/src/mysql.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2009, Adam Chlipala
+(* Copyright (c) 2009-2010, Adam Chlipala
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
@@ -1202,7 +1202,7 @@ fun dmlCommon {loc, dml, mode} =
string ": Error executing DML: %s\\n%s\", ",
dml,
string ", mysql_error(conn->conn));"]
- | Settings.None => string "uw_errmsg = mysql_error(conn->conn);",
+ | Settings.None => string "uw_set_error_message(ctx, mysql_error(conn->conn));",
newline,
newline]
diff --git a/src/postgres.sml b/src/postgres.sml
index bf1e8536..0acd1bf3 100644
--- a/src/postgres.sml
+++ b/src/postgres.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2009, Adam Chlipala
+(* Copyright (c) 2008-2010, Adam Chlipala
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
@@ -731,19 +731,95 @@ fun dmlCommon {loc, dml, mode} =
string ": DML failed:\\n%s\\n%s\", ",
dml,
string ", PQerrorMessage(conn));"]
- | Settings.None => string "uw_errmsg = PQerrorMessage(conn);",
+ | Settings.None => box [string "uw_set_error_message(ctx, PQerrorMessage(conn));",
+ newline,
+ newline,
+
+ string "res = PQexec(conn, \"ROLLBACK TO s\");",
+ newline,
+ string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
+ newline,
+ newline,
+
+ string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
+ newline,
+ box [string "PQclear(res);",
+ newline,
+ string "uw_error(ctx, FATAL, \"",
+ string (ErrorMsg.spanToString loc),
+ string ": ROLLBACK TO failed:\\n%s\\n%s\", ",
+ dml,
+ string ", PQerrorMessage(conn));",
+ newline,
+ string "}"],
+ newline,
+
+ string "PQclear(res);",
+ newline],
newline],
string "}",
- newline,
- newline,
- string "PQclear(res);",
- newline]
+ case mode of
+ Error => box [newline,
+ newline,
+ string "PQclear(res);",
+ newline]
+ | None => box[string " else {",
+ newline,
+ box [string "PQclear(res);",
+ newline,
+ string "res = PQexec(conn, \"RELEASE s\");",
+ newline,
+ string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
+ newline,
+ newline,
+
+ string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
+ newline,
+ box [string "PQclear(res);",
+ newline,
+ string "uw_error(ctx, FATAL, \"",
+ string (ErrorMsg.spanToString loc),
+ string ": RELEASE failed:\\n%s\\n%s\", ",
+ dml,
+ string ", PQerrorMessage(conn));",
+ newline],
+ string "}",
+ newline,
+ string "PQclear(res);",
+ newline],
+ string "}",
+ newline]]
+
+fun makeSavepoint mode =
+ case mode of
+ Error => box []
+ | None => box [string "res = PQexec(conn, \"SAVEPOINT s\");",
+ newline,
+ string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
+ newline,
+ newline,
+ string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
+ box [newline,
+ string "PQclear(res);",
+ newline,
+ string "uw_error(ctx, FATAL, \"Error creating SAVEPOINT\");",
+ newline],
+ string "}",
+ newline,
+ string "PQclear(res);",
+ newline,
+ newline]
fun dml (loc, mode) =
box [string "PGconn *conn = uw_get_db(ctx);",
newline,
- string "PGresult *res = PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);",
+ string "PGresult *res;",
+ newline,
+
+ makeSavepoint mode,
+
+ string "res = PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);",
newline,
newline,
dmlCommon {loc = loc, dml = string "dml", mode = mode}]
@@ -772,7 +848,13 @@ fun dmlPrepared {loc, id, dml, inputs, mode} =
string " };",
newline,
newline,
- string "PGresult *res = ",
+ string "PGresult *res;",
+ newline,
+ newline,
+
+ makeSavepoint mode,
+
+ string "res = ",
if #persistent (Settings.currentProtocol ()) then
box [string "PQexecPrepared(conn, \"uw",
string (Int.toString id),
diff --git a/src/sqlite.sml b/src/sqlite.sml
index 20afd5bc..c87bd509 100644
--- a/src/sqlite.sml
+++ b/src/sqlite.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2009, Adam Chlipala
+(* Copyright (c) 2009-2010, Adam Chlipala
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
@@ -708,7 +708,7 @@ fun dmlCommon {loc, dml, mode} =
string ": DML step failed: %s<br />%s\", ",
dml,
string ", sqlite3_errmsg(conn->conn));"]
- | Settings.None => string "uw_errmsg = sqlite3_errmsg(conn->conn);",
+ | Settings.None => string "uw_set_error_message(ctx, sqlite3_errmsg(conn->conn));",
newline]
fun dml (loc, mode) =
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-06 09:53:54 +0000