sql: updates to be more modular, explicit transactions that nest, db-spec as data rather than as a function, with-results changed to bind a seq of results rather than records repeatedly, see clojure.contrib.sql.test for new examples.

1 files changed, 81 insertions, 57 deletions

diff --git a/src/clojure/contrib/sql/sql.clj b/src/clojure/contrib/sql/sql.clj
index 08c162ec..7f257e08 100644
--- a/src/clojure/contrib/sql/sql.clj
+++ b/src/clojure/contrib/sql/sql.clj
@@ -16,48 +16,71 @@
 ;;  Created 2 April 2008
 
 (ns clojure.contrib.sql
-  (:import
-   (java.sql DriverManager Connection PreparedStatement ResultSet)
-   (java.util Properties))
-  (:load "internal.clj"))
+  (:use clojure.contrib.except)
+  (:load "sql_internal.clj"))
 
-(defn connection
-  "Returns a connection to a database via a jdbc URL. Additional options
-  for the connection may be specified either as a map from keywords to
-  values or as inline keywords and values after db-name"
-  [subprotocol db-name & opts]
-  (DriverManager/getConnection
-   (format "jdbc:%s:%s" subprotocol db-name)
-   (properties (if (keyword? (first opts))
-                 (apply hash-map opts)
-                 (first opts)))))
+(def *db* {:con nil :level 0})
 
 (defmacro with-connection
-  "Evaluates body in the context of a connection to a database. Any updates
-  are committed as one transaction after evaluating body or rolled back on
-  any uncaught exception."
-  [con init & body]
-  `(with-open ~con ~init
-     (try
-      (.setAutoCommit ~con false)
-      ~@body
-      (.commit ~con)
-      (catch Exception e#
-        (.rollback ~con)
-        (throw (Exception. "transaction rolled back" e#))))))
+  "Evaluates body in the context of a new connection to a database then
+  closes it. db-spec is a map containing string values for these required
+  keys:
+    :classname     the jdbc driver class name
+    :subprotocol   the jdbc subprotocol
+    :subname       the jdbc subname
+  db-spec may contain additional key-value pairs that are passed along to
+  the driver as properties such as :user, :password, etc."
+  [db-spec & body]
+  `(do
+     (clojure.lang.RT/classForName (:classname ~db-spec))
+     (with-open con#
+         (java.sql.DriverManager/getConnection
+          (format "jdbc:%s:%s" (:subprotocol ~db-spec) (:subname ~db-spec))
+          (properties (dissoc ~db-spec :classname :subprotocol :subname)))
+       (binding [*db* (assoc *db* :con con# :level 0)]
+         ~@body))))
+
+(defmacro transaction
+  "Evaluates body as a transaction on the open database connection. Updates
+  are committed together as a group after evaluating body or rolled back on
+  any uncaught exception. Any nested transactions will be absorbed into the
+  outermost transaction."
+  [& body]
+  `(let [con# (:con *db*)
+         level# (:level *db*)]
+     (throw-if (not con#) "no database connection")
+     (binding [*db* (assoc *db* :level (inc level#))]
+       (let [auto-commit# (.getAutoCommit con#)]
+         (when (zero? level#)
+           (.setAutoCommit con# false))
+         (try
+          (let [value# (do ~@body)]
+            (when (zero? level#)
+              (.commit con#))
+            value#)
+          (catch Exception e#
+            (.rollback con#)
+            (throw (Exception.
+                    (format "transaction rolled back: %s"
+                            (.getMessage e#)) e#)))
+          (finally
+           (when (zero? level#)
+             (.setAutoCommit con# auto-commit#))))))))
 
 (defn do-commands
-  "Executes SQL commands that do not return results"
-  [con & commands]
-  (with-open stmt (.createStatement con)
+  "Executes SQL commands that don't return results on the open database
+  connection"
+  [& commands]
+  (with-open stmt (.createStatement (:con *db*))
     (doseq cmd commands
       (.addBatch stmt cmd))
     (.executeBatch stmt)))
 
 (defn do-prepared
-  "Executes a prepared statement with parameter sets"
-  [con sql & sets]
-  (with-open stmt (.prepareStatement con sql)
+  "Executes a prepared statement on the open database connection with
+  parameter sets"
+  [sql & sets]
+  (with-open stmt (.prepareStatement (:con *db*) sql)
     (doseq set sets
       (doseq [index value] (map vector (iterate inc 1) set)
         (.setObject stmt index value))
@@ -65,51 +88,52 @@
     (.executeBatch stmt)))
 
 (defn create-table
-  "Creates a table given a name (a string or keyword) and column specs. A
-  column spec is a vector containing a name, a type, and optionally other
-  items such as constraints, each a string or keyword."
-  [con name & cols]
-  (do-commands con
-    (format "create table %s (%s)"
-            (the-str name)
-            (apply str
+  "Creates a table on the open database connection given a name (a string
+  or keyword) and column specs. A column spec is a vector containing a name
+  and optionally a type and other items such as constraints, each a string
+  or keyword."
+  [name & cols]
+  (do-commands
+   (format "create table %s (%s)"
+           (the-str name)
+           (apply str
              (map the-str
               (apply concat
                (interpose [", "]
                 (map (partial interpose " ") cols))))))))
 
 (defn drop-table
-  "Drops a table give its name (a string or keyword)"
-  [con name]
-  (do-commands con
-    (format "drop table %s" (the-str name))))
+  "Drops a table on the open database connection given its name (a string
+  or keyword)"
+  [name]
+  (do-commands
+   (format "drop table %s" (the-str name))))
 
 (defn insert-values
-  "Inserts values into columns of a table. Columns is a seq of column
-  names (strings or keywords) and each value is a seq of values for those
-  columns. To insert complete rows (all columns), use insert-rows."
-  [con table columns & values]
+  "Inserts values into columns of a table. columns is a vector of column
+  names (strings or keywords) and each value is a vector of values for
+  those columns. To insert complete rows (all columns), use insert-rows."
+  [table columns & values]
   (let [count (count (first values))
         template (apply str (interpose "," (replicate count "?")))
         cols (if (seq columns)
                (format "(%s)" (apply str (interpose "," (map the-str columns))))
                "")]
     (apply do-prepared
-           con
            (format "insert into %s %s values (%s)" (the-str table) cols template)
            values)))
 
 (defn insert-rows
-  "Inserts complete rows into a table. Each row is a seq of values for
+  "Inserts complete rows into a table. Each row is a vector of values for
   each of the table's columns in order."
-  [con table & rows]
-  (apply insert-values con table nil rows))
+  [table & rows]
+  (apply insert-values table nil rows))
 
 (defmacro with-results
-  "Executes a query and then evaluates body repeatedly with rec bound to
-  each of the generated results in turn"
-  [rec con sql & body]
-  `(with-open stmt# (.prepareStatement ~con ~sql)
+  "Executes a query and then evaluates body with res bound to a seq of the
+  results"
+  [res sql & body]
+  `(with-open stmt# (.prepareStatement (:con *db*) ~sql)
      (with-open rset# (.executeQuery stmt#)
-       (doseq ~rec (resultset-seq rset#)
+       (let [~res (resultset-seq rset#)]
          ~@body))))