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

2 files changed, 150 insertions, 82 deletions

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")))))