sql: add support for rollback-only to transaction, only wrap the outermost transaction's exception with an exception with message 'transaction rolled back'

3 files changed, 59 insertions, 12 deletions

diff --git a/src/clojure/contrib/sql.clj b/src/clojure/contrib/sql.clj
index ea9d8f0d..c3615efd 100644
--- a/src/clojure/contrib/sql.clj
+++ b/src/clojure/contrib/sql.clj
@@ -16,12 +16,11 @@
 ;;  Created 2 April 2008
 
 (ns clojure.contrib.sql
-  (:use [clojure.contrib.def :only (defvar)])
+  (:use [clojure.contrib.def :only (defalias)])
   (:use clojure.contrib.sql.internal))
 
-(defvar connection connection*
-  "Returns the current database connection (or throws if there is none)")
-
+(defalias connection connection*)
+  
 (defmacro with-connection
   "Evaluates body in the context of a new connection to a database then
   closes the connection. db-spec is a map containing string values for
@@ -42,6 +41,10 @@
   [& body]
   `(transaction* (fn [] ~@body)))
 
+(defalias set-rollback-only set-rollback-only*)
+
+(defalias is-rollback-only is-rollback-only*)
+
 (defn do-commands
   "Executes SQL commands on the open database connection."
   [& commands]
diff --git a/src/clojure/contrib/sql/internal.clj b/src/clojure/contrib/sql/internal.clj
index f9ee053c..ff1d7ad2 100644
--- a/src/clojure/contrib/sql/internal.clj
+++ b/src/clojure/contrib/sql/internal.clj
@@ -33,11 +33,23 @@
     p))
 
 (defn connection*
-  "Returns the current database connection or throws"
+  "Returns the current database connection (or throws if there is none)"
   []
   (or (:connection *db*)
       (throw (Exception. "no current database connection"))))
 
+(defn set-rollback-only*
+  "Marks the current stack of nested transactions such that they will
+  rollback rather than commit when complete"
+  []
+  (update-in *db* [:rollback-only] swap! (fn [_] true)))
+
+(defn is-rollback-only*
+  "Returns true if the current stack of nested transactions will rollback
+  rather than commit when complete"
+  []
+  @(:rollback-only *db*))
+
 (defn with-connection*
   "Evaluates func in the context of a new connection to a database then
   closes the connection. db-spec is a map containing string values for
@@ -54,7 +66,8 @@
        (java.sql.DriverManager/getConnection
         (format "jdbc:%s:%s" subprotocol subname)
         (properties (dissoc db-spec :classname :subprotocol :subname)))]
-    (binding [*db* (assoc *db* :connection con :level 0)]
+    (binding [*db* (assoc *db* :connection con :level 0
+                          :rollback-only (atom false))]
       (func))))
 
 (defn transaction*
@@ -73,13 +86,18 @@
        (try
         (let [value (func)]
           (when outermost
-            (.commit con))
+            (if (is-rollback-only*)
+              (.rollback con)
+              (.commit con)))
           value)
         (catch Exception e
-          (.rollback con)
-          (throw (Exception.
-                  (format "transaction rolled back: %s"
-                          (.getMessage e)) e)))
+          (if outermost
+            (do
+              (.rollback con)
+              (throw (Exception.
+                      (format "transaction rolled back: %s"
+                              (.getMessage e)) e)))
+            (throw e)))
         (finally
          (when outermost
            (.setAutoCommit con auto-commit))))))))
diff --git a/src/clojure/contrib/sql/test.clj b/src/clojure/contrib/sql/test.clj
index 134bc862..e88cd11f 100644
--- a/src/clojure/contrib/sql/test.clj
+++ b/src/clojure/contrib/sql/test.clj
@@ -149,7 +149,7 @@
               (.getTables nil nil nil (into-array ["TABLE" "VIEW"])))))))
 
 (defn db-exception
-  "Demonstrate rolling back a partially completed transaction"
+  "Demonstrate rolling back a partially completed transaction on exception"
   []
   (sql/with-connection
    db
@@ -163,3 +163,29 @@
     ;; is not. the exception will cause it to roll back leaving the database
     ;; untouched.
     (throw (Exception. "sql/test exception")))))
+
+(defn db-rollback
+  "Demonstrate a rollback-only trasaction"
+  []
+  (sql/with-connection
+   db
+   (sql/transaction
+    (prn "is-rollback-only" (sql/is-rollback-only))
+    (sql/set-rollback-only)
+    (sql/insert-values
+     :fruit
+     [:name :appearance]
+     ["Grape" "yummy"]
+     ["Pear" "bruised"])
+    (prn "is-rollback-only" (sql/is-rollback-only))
+    (sql/with-query-results
+     res
+     ["SELECT * FROM fruit"]
+     (doseq [rec res]
+      (println rec))))
+   (prn)
+   (sql/with-query-results
+    res
+    ["SELECT * FROM fruit"]
+    (doseq [rec res]
+      (println rec)))))