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.

3 files changed, 142 insertions, 93 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))))
diff --git a/src/clojure/contrib/sql/internal.clj b/src/clojure/contrib/sql/sql_internal.clj
index 0880d491..f58ad4be 100644
--- a/src/clojure/contrib/sql/internal.clj
+++ b/src/clojure/contrib/sql/sql_internal.clj
@@ -11,12 +11,12 @@
 ;;  scgilardi (gmail)
 ;;  Created 3 October 2008
 
-(defn- properties
+(defn properties
   "Converts a Clojure map from keywords or symbols to values into a
   java.util.Properties object that maps the names of the keywords or
   symbols to the String representation of the values"
   [m]
-  (let [p (Properties.)]
+  (let [p (java.util.Properties.)]
     (when m
       (loop [[key & keys] (keys m)
              [val & vals] (vals m)]
diff --git a/src/clojure/contrib/sql/test/test.clj b/src/clojure/contrib/sql/test/test.clj
index 94a5a644..eb212dc5 100644
--- a/src/clojure/contrib/sql/test/test.clj
+++ b/src/clojure/contrib/sql/test/test.clj
@@ -14,47 +14,72 @@
 ;;  Created 13 September 2008
 
 (ns clojure.contrib.sql.test
-  (:use clojure.contrib.sql))
+  (:require [clojure.contrib.sql :as sql]))
 
-(clojure.lang.RT/classForName "org.apache.derby.jdbc.EmbeddedDriver")
+(def db {:classname "org.apache.derby.jdbc.EmbeddedDriver"
+         :subprotocol "derby"
+         :subname "/tmp/clojure.contrib.sql.test.db"
+         :create true})
 
-(defn db []
-  (connection "derby" "/tmp/clojure.contrib.sql.test.db" :create true))
+(defn drop-fruit []
+  (try
+   (sql/drop-table :fruit)
+   (catch Exception e)))
+
+(defn create-fruit []
+  (sql/create-table :fruit
+    [:name "varchar(32)" "NOT NULL"]
+    [:appearance "varchar(32)"]
+    [:cost :int]
+    [:grade :real]))
+
+(defn insert-rows-fruit []
+  (sql/insert-rows :fruit
+    ["Apple" "red" 59 87]
+    ["Banana" "yellow" 29 92.2]
+    ["Peach" "fuzzy" 139 90.0]
+    ["Orange" "juicy" 89 88.6]))
+
+(defn insert-values-fruit []
+  (sql/insert-values :fruit
+    [:name :cost]
+    ["Mango" 722]
+    ["Feijoa" 441]))
 
 (defn db-write []
-  (with-connection con (db)
-    (try
-     (drop-table con :fruit)
-     (catch Exception e))
-    (create-table con :fruit
-      [:name "varchar(32)" "NOT NULL"]
-      [:appearance "varchar(32)"]
-      [:cost :int]
-      [:grade :real])
-    (insert-rows con :fruit
-      ["Apple" "red" 59 87]
-      ["Banana" "yellow" 29 92.2]
-      ["Peach" "fuzzy" 139 90.0]
-      ["Orange" "juicy" 89 88.6])
-    (insert-values con :fruit [:name :cost]
-      ["Mango" 722]
-      ["Feijoa" 441])))
+  (sql/with-connection db
+    (sql/transaction
+     (drop-fruit)
+     (create-fruit)
+     (insert-rows-fruit)
+     (insert-values-fruit)))
+  nil)
 
 (defn db-read []
-  (with-connection con (db)
-    (with-results rec con
-      "select * from fruit"
-      (println rec))))
+  (sql/with-connection db
+    (sql/with-results res
+     "select * from fruit"
+      (doseq rec res
+        (println rec)))))
+
+(defn db-read-all []
+  (sql/with-connection db
+    (sql/with-results res
+     "select * from fruit"
+      (into [] res))))
 
 (defn db-grade-a []
-  (with-connection con (db)
-    (with-results rec con
-      "select name, cost from fruit where grade >= 90"
-      (println rec))))
+  (sql/with-connection db
+    (sql/with-results res
+     "select name, cost from fruit where grade >= 90"
+      (doseq rec res
+        (println rec)))))
 
 (defn db-exception []
-  (with-connection con (db)
-    (insert-values con :fruit [:name :appearance]
-      ["Grape" "yummy"]
-      ["Pear" "bruised"])
-    (throw (Exception. "an exception"))))
+  (sql/with-connection db
+    (sql/transaction
+      (sql/insert-values :fruit
+        [:name :appearance]
+        ["Grape" "yummy"]
+        ["Pear" "bruised"])
+      (throw (Exception. "an exception")))))