Mercurial > urweb

changeset 1295:929981850d9d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
'tryDml' works with Postgres
author Adam Chlipala <adam@chlipala.net>
date Tue, 07 Sep 2010 09:06:13 -0400
parents b4480a56cab7
children 0d3d9e653829
files include/urweb.h src/c/urweb.c src/cjr_print.sml src/mysql.sml src/postgres.sml src/sqlite.sml tests/tryDml.ur
diffstat 7 files changed, 111 insertions(+), 23 deletions(-) [+]
line wrap: on
line diff
--- a/include/urweb.h	Tue Sep 07 08:28:07 2010 -0400
+++ b/include/urweb.h	Tue Sep 07 09:06:13 2010 -0400
@@ -44,6 +44,7 @@
 __attribute__((noreturn)) void uw_error(uw_context, failure_kind, const char *fmt, ...);
 char *uw_error_message(uw_context);
 void uw_set_error_message(uw_context, const char *fmt, ...);
+uw_Basis_string uw_dup_and_clear_error_message(uw_context);
 int uw_has_error(uw_context);
 void uw_push_cleanup(uw_context, void (*func)(void *), void *arg);
 void uw_pop_cleanup(uw_context);
--- a/src/c/urweb.c	Tue Sep 07 08:28:07 2010 -0400
+++ b/src/c/urweb.c	Tue Sep 07 09:06:13 2010 -0400
@@ -2175,6 +2175,15 @@
   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);
--- a/src/cjr_print.sml	Tue Sep 07 08:28:07 2010 -0400
+++ b/src/cjr_print.sml	Tue Sep 07 09:06:13 2010 -0400
@@ -1794,10 +1794,7 @@
         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 @@
 
              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 "({",
--- a/src/mysql.sml	Tue Sep 07 08:28:07 2010 -0400
+++ b/src/mysql.sml	Tue Sep 07 09:06:13 2010 -0400
@@ -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 @@
                                     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]
 
--- a/src/postgres.sml	Tue Sep 07 08:28:07 2010 -0400
+++ b/src/postgres.sml	Tue Sep 07 09:06:13 2010 -0400
@@ -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 @@
                                          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 @@
          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),
--- a/src/sqlite.sml	Tue Sep 07 08:28:07 2010 -0400
+++ b/src/sqlite.sml	Tue Sep 07 09:06:13 2010 -0400
@@ -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 @@
                                     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) =
--- a/tests/tryDml.ur	Tue Sep 07 08:28:07 2010 -0400
+++ b/tests/tryDml.ur	Tue Sep 07 09:06:13 2010 -0400
@@ -5,8 +5,10 @@
     dml (INSERT INTO t (Id) VALUES (0));
     o1 <- tryDml (INSERT INTO t (Id) VALUES (0));
     dml (INSERT INTO t (Id) VALUES (1));
-    o2 <- tryDml (INSERT INTO t (Id) VALUES (1));
-    return <xml>{[o1]}; {[o2]}</xml>
+    o2 <- tryDml (INSERT INTO t (Id) VALUES (2));
+    dml (INSERT INTO t (Id) VALUES (3));
+    o3 <- tryDml (INSERT INTO t (Id) VALUES (3));
+    return <xml>{[o1]}; {[o2]}; {[o3]}</xml>
 
 fun main () = return <xml><body>
   <form> <submit action={doStuff}/> </form>