sql* updates to doc strings, update-values, parameterized queries

3 files changed, 219 insertions, 127 deletions

diff --git a/src/clojure/contrib/sql.clj b/src/clojure/contrib/sql.clj
index d569ead5..0fe0017d 100644
--- a/src/clojure/contrib/sql.clj
+++ b/src/clojure/contrib/sql.clj
@@ -29,77 +29,78 @@
     :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."
+  If db-spec contains additional keys (such as :user, :password, etc.) and
+  associated values, they will be passed along to the driver as properties."
   [db-spec & body]
   `(with-connection* ~db-spec (fn [] ~@body)))
 
 (defmacro transaction
   "Evaluates body as a transaction on the open database connection. Any
-  database updates are committed together as a group after evaluating, or
-  rolled back on any uncaught exception. Any nested transactions are
-  absorbed into the outermost transaction."
+  nested transactions are absorbed into the outermost transaction. All
+  database updates are committed together as a group after evaluating the
+  outermost body, or rolled back on any uncaught exception."
   [& body]
   `(transaction* (fn [] ~@body)))
 
 (defn do-commands
-  "Executes SQL commands that don't return results on the open database
-  connection"
+  "Executes SQL commands on the open database connection."
   [& commands]
   (with-open [stmt (.createStatement (connection))]
     (doseq [cmd commands]
       (.addBatch stmt cmd))
-    (.executeBatch stmt)))
+    (into [] (.executeBatch stmt))))
 
 (defn do-prepared
-  "Executes a prepared statement on the open database connection with
-  parameter sets"
-  [sql & sets]
+  "Executes an (optionally parameterized) SQL prepared statement on the
+  open database connection. Each param-group is a seq of values for all of
+  the parameters."
+  [sql & param-groups]
   (with-open [stmt (.prepareStatement (connection) sql)]
-    (doseq [set sets]
-      (doseq [[index value] (map vector (iterate inc 1) set)]
+    (doseq [param-group param-groups]
+      (doseq [[index value] (map vector (iterate inc 1) param-group)]
         (.setObject stmt index value))
       (.addBatch stmt))
-    (.executeBatch stmt)))
+    (into [] (.executeBatch stmt))))
 
 (defn create-table
-  "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 & column-specs]
+  "Creates a table on the open database connection given a table name and
+  specs. Each spec is either a column spec: a vector containing a column
+  name and optionally a type and other constraints, or a table-level
+  constraint: a vector containing words that express the constraint. All
+  words used to describe the table may be supplied as strings or keywords."
+  [name & specs]
   (do-commands
-   (format "create table %s (%s)"
+   (format "CREATE TABLE %s (%s)"
            (the-str name)
            (apply str
              (map the-str
               (apply concat
                (interpose [", "]
-                (map (partial interpose " ") column-specs))))))))
+                (map (partial interpose " ") specs))))))))
 
 (defn drop-table
-  "Drops a table on the open database connection given its name (a string
-  or keyword)"
+  "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))))
+   (format "DROP TABLE %s" (the-str name))))
 
 (defn insert-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 column-names & values]
-  (let [count (count (first values))
-        template (apply str (interpose "," (replicate count "?")))
-        columns
-        (if (seq column-names)
-          (format "(%s)"
-                  (apply str (interpose "," (map the-str column-names))))
-          "")]
+  "Inserts rows with values only for specified columns into a table.
+  column-names is a vector of strings or keywords identifying columns. Each
+  value-group is a vector containing values for each column in order. To
+  insert complete rows (all columns), use insert-rows."
+  [table column-names & value-groups]
+  (let [column-strs (map the-str column-names)
+        n (count (first value-groups))
+        template (apply str (interpose "," (replicate n "?")))
+        columns (if (seq column-names)
+                  (format "(%s)" (apply str (interpose "," column-strs)))
+                  "")]
     (apply do-prepared
-           (format "insert into %s %s values (%s)"
+           (format "INSERT INTO %s %s VALUES (%s)"
                    (the-str table) columns template)
-           values)))
+           value-groups)))
 
 (defn insert-rows
   "Inserts complete rows into a table. Each row is a vector of values for
@@ -107,11 +108,34 @@
   [table & rows]
   (apply insert-values table nil rows))
 
-(defmacro with-results
-  "Executes a query and then evaluates body with results bound to a seq of
-  the results"
-  [results sql & body]
-  `(with-open [stmt# (.prepareStatement (connection) ~sql)
-               rset# (.executeQuery stmt#)]
-     (let [~results (resultset-seq rset#)]
-       ~@body)))
+(defn delete-rows
+  "Deletes rows from a table. where-params is a vector containing a string
+  providing (optionally parameterized) criteria to identify the row(s) to
+  delete followed by values for any parameters."
+  [table where-params]
+  (let [[where & params] where-params]
+    (apply do-prepared
+           (format "DELETE FROM %s WHERE %s"
+                   (the-str table) where)
+           [params])))
+
+(defn update-values
+  "Updates column values in a table. where-params is a vector containing a
+  string providing (optionally parameterized) criteria to identify the
+  row(s) to be updated followed by values for any parameters. record is a
+  map from strings or keywords identifying columns to (new) values."
+  [table where-params record]
+  (let [[where & params] where-params
+        column-strs (map the-str (keys record))
+        columns (apply str (concat (interpose "=?, " column-strs) "=?"))]
+    (apply do-prepared
+           (format "UPDATE %s SET %s WHERE %s"
+                   (the-str table) columns where)
+           [(concat (vals record) params)])))
+
+(defmacro with-query-results
+  "Executes a query, then evaluates body with results bound to a seq of the
+  results. sql-params is a vector containing the (optionally parameterized)
+  sql query string followed by values for any parameters."
+  [results sql-params & body]
+  `(with-query-results* ~sql-params (fn [~results] ~@body)))
diff --git a/src/clojure/contrib/sql/internal.clj b/src/clojure/contrib/sql/internal.clj
index 8d17552c..1eb89323 100644
--- a/src/clojure/contrib/sql/internal.clj
+++ b/src/clojure/contrib/sql/internal.clj
@@ -15,12 +15,6 @@
 
 (def *db* {:connection nil :level 0})
 
-(defn connection*
-  "Returns the current database connection or throws"
-  []
-  (or (:connection *db*)
-      (throw (Exception. "no current database connection"))))
-
 (defn the-str
   "Returns the name or string representation of x"
   [x]
@@ -38,31 +32,37 @@
       (.setProperty p (the-str key) (the-str val)))
     p))
 
+(defn connection*
+  "Returns the current database connection or throws"
+  []
+  (or (:connection *db*)
+      (throw (Exception. "no current database connection"))))
+
 (defn with-connection*
-  "Evaluates thunk in the context of a new connection to a database then
+  "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
   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 thunk]
-  (clojure.lang.RT/loadClassForName (:classname db-spec))
+  If db-spec contains additional keys (such as :user, :password, etc.) and
+  associated values, they will be passed along to the driver as properties."
+  [{:keys [classname subprotocol subname] :as db-spec} func]
+  (clojure.lang.RT/loadClassForName classname)
   (with-open
       [con
        (java.sql.DriverManager/getConnection
-        (format "jdbc:%s:%s" (:subprotocol db-spec) (:subname db-spec))
+        (format "jdbc:%s:%s" subprotocol subname)
         (properties (dissoc db-spec :classname :subprotocol :subname)))]
     (binding [*db* (assoc *db* :connection con :level 0)]
-      (thunk))))
+      (func))))
 
 (defn transaction*
-  "Evaluates thunk as a transaction on the open database connection.
-  Any database updates are committed together as a group after evaluating,
-  or rolled back on any uncaught exception. Any nested transactions are
-  absorbed into the outermost transaction."
-  [thunk]
+  "Evaluates func as a transaction on the open database connection. Any
+  nested transactions are absorbed into the outermost transaction. All
+  database updates are committed together as a group after evaluating the
+  outermost func, or rolled back on any uncaught exception."
+  [func]
   (let [con (connection*)
         outermost (zero? (:level *db*))
         auto-commit (when outermost (.getAutoCommit con))]
@@ -70,7 +70,7 @@
       (when outermost
         (.setAutoCommit con false))
       (try
-       (let [value (thunk)]
+       (let [value (func)]
          (when outermost
            (.commit con))
          value)
@@ -82,3 +82,14 @@
        (finally
         (when outermost
           (.setAutoCommit con auto-commit)))))))
+
+(defn with-query-results*
+  "Executes a query, then evaluates func passing in a seq of the results as
+  an argument. The first argument is a vector containing the (optionally
+  parameterized) sql query string followed by values for any parameters."
+  [[sql & params] func]
+  (with-open [stmt (.prepareStatement (connection*) sql)]
+    (doseq [[index value] (map vector (iterate inc 1) params)]
+      (.setObject stmt index value))
+    (with-open [rset (.executeQuery stmt)]
+      (func (resultset-seq rset)))))
diff --git a/src/clojure/contrib/sql/test.clj b/src/clojure/contrib/sql/test.clj
index 50901b18..660d87e2 100644
--- a/src/clojure/contrib/sql/test.clj
+++ b/src/clojure/contrib/sql/test.clj
@@ -21,78 +21,135 @@
          :subname "/tmp/clojure.contrib.sql.test.db"
          :create true})
 
-(defn drop-fruit []
+(defn create-fruit
+  "Create a table"
+  []
+  (sql/create-table
+   :fruit
+   [:name "varchar(32)" "NOT NULL" "PRIMARY KEY"]
+   [:appearance "varchar(32)"]
+   [:cost :int]
+   [:grade :real]))
+
+(defn drop-fruit
+  "Drop a table"
+  []
   (try
    (sql/drop-table :fruit)
-   (catch Exception e)))
+   (catch Exception _)))
+
+(defn insert-rows-fruit
+  "Insert complete rows"
+  []
+  (sql/insert-rows
+   :fruit
+   ["Apple" "red" 59 87]
+   ["Banana" "yellow" 29 92.2]
+   ["Peach" "fuzzy" 139 90.0]
+   ["Orange" "juicy" 89 88.6]))
 
-(defn create-fruit []
-  (sql/transaction
-   (sql/create-table :fruit
-    [:name "varchar(32)" "NOT NULL"]
-    [:appearance "varchar(32)"]
-    [:cost :int]
-    [:grade :real])))
+(defn insert-values-fruit
+  "Insert rows with values for only specific columns"
+  []
+  (sql/insert-values
+   :fruit
+   [:name :cost]
+   ["Mango" 722]
+   ["Feijoa" 441]))
+
+(defn db-write
+  "Write initial values to the database as a transaction"
+  []
+  (sql/with-connection
+   db
+   (sql/transaction
+    (drop-fruit)
+    (create-fruit)
+    (insert-rows-fruit)
+    (insert-values-fruit)))
+  nil)
 
-(defn insert-rows-fruit []
-  (sql/transaction
-   (sql/insert-rows :fruit
-    ["Apple" "red" 59 87]
-    ["Banana" "yellow" 29 92.2]
-    ["Peach" "fuzzy" 139 90.0]
-    ["Orange" "juicy" 89 88.6])))
+(defn db-read
+  "Read the entire fruit table"
+  []
+  (sql/with-connection
+   db
+   (sql/with-query-results
+    res
+    ["SELECT * FROM fruit"]
+    (doseq [rec res]
+      (println rec)))))
 
-(defn insert-values-fruit []
-  (sql/transaction
-   (sql/insert-values :fruit
-    [:name :cost]
-    ["Mango" 722]
-    ["Feijoa" 441])))
+(defn db-update-appearance-cost
+  "Update the appearance and cost of the named fruit"
+  [name appearance cost]
+  (sql/update-values
+   :fruit
+   ["name=?" name]
+   {:appearance appearance :cost cost}))
 
-(defn db-write []
-  (sql/with-connection db
-    (sql/transaction
-     (drop-fruit)
-     (create-fruit)
-     (insert-rows-fruit)
-     (insert-values-fruit)))
+(defn db-update
+  "Update two fruits as a transaction"
+  []
+  (sql/with-connection
+   db
+   (sql/transaction
+    (db-update-appearance-cost "Banana" "bruised" 14)
+    (db-update-appearance-cost "Feijoa" "green" 400)))
   nil)
 
-(defn db-read []
-  (sql/with-connection db
-    (sql/with-results res
-     "select * from fruit"
-      (doseq [rec res]
-        (println rec)))))
+(defn db-read-all
+  "Return all the rows of the fruit table as a vector"
+  []
+  (sql/with-connection
+   db
+   (sql/with-query-results
+    res
+    ["SELECT * FROM fruit"]
+    (into [] res))))
 
-(defn db-read-all []
-  (sql/with-connection db
-    (sql/transaction                       
-     (sql/with-results res
-      "select * from fruit"
-      (into [] res)))))
+(defn db-grade-range
+  "Print rows describing fruit that are within a grade range"
+  [min max]
+  (sql/with-connection
+   db
+   (sql/with-query-results
+    res
+    [(str "SELECT name, cost, grade "
+          "FROM fruit "
+          "WHERE grade >= ? AND grade <= ?")
+     min max]
+    (doseq [rec res]
+      (println rec)))))
 
-(defn db-grade-a []
-  (sql/with-connection db
-    (sql/transaction
-     (sql/with-results res
-       "select name, cost from fruit where grade >= 90"
-       (doseq [rec res]
-         (println rec))))))
+(defn db-grade-a 
+  "Print rows describing all grade a fruit (grade between 90 and 100)"
+  []
+  (db-grade-range 90 100))
 
-(defn db-get-tables []
-  (sql/with-connection db
-    (into []
-      (resultset-seq
-       (-> (sql/connection)
-           (.getMetaData)
-           (.getTables nil nil nil (into-array ["TABLE" "VIEW"])))))))
+(defn db-get-tables
+  "Demonstrate getting table info"
+  []
+  (sql/with-connection
+   db
+   (into []
+         (resultset-seq
+          (-> (sql/connection)
+              (.getMetaData)
+              (.getTables nil nil nil (into-array ["TABLE" "VIEW"])))))))
 
-(defn db-exception []
-  (sql/with-connection db
-    (sql/transaction
-      (sql/insert-values :fruit
-        [:name :appearance]
-        ["Grape" "yummy"]
-        ["Pear" "bruised"])
-      (throw (Exception. "an exception")))))
+(defn db-exception
+  "Demonstrate rolling back a partially completed transaction"
+  []
+  (sql/with-connection
+   db
+   (sql/transaction
+    (sql/insert-values
+     :fruit
+     [:name :appearance]
+     ["Grape" "yummy"]
+     ["Pear" "bruised"])
+    ;; at this point the insert-values call is complete, but the transaction
+    ;; is not. the exception will cause it to roll back leaving the database
+    ;; untouched.
+    (throw (Exception. "sql/test exception")))))