diff options
| -rw-r--r-- | src/clojure/contrib/sql.clj | 65 | ||||
| -rw-r--r-- | src/clojure/contrib/sql/internal.clj | 69 | ||||
| -rw-r--r-- | src/clojure/contrib/sql/test.clj | 31 |
3 files changed, 98 insertions, 67 deletions
diff --git a/src/clojure/contrib/sql.clj b/src/clojure/contrib/sql.clj index b8aa64ef..172cd190 100644 --- a/src/clojure/contrib/sql.clj +++ b/src/clojure/contrib/sql.clj @@ -16,59 +16,33 @@ ;; Created 2 April 2008 (ns clojure.contrib.sql - (:use clojure.contrib.except - clojure.contrib.sql.internal)) + (:use clojure.contrib.sql.internal)) (defmacro with-connection "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: + 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 & body] - `(do - (Class/forName (: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* :connection con# :level 0)] - ~@body)))) + `(with-connection* ~db-spec (fn [] ~@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." + "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." [& body] - `(let [con# (connection) - level# (:level *db*)] - (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#)))))))) + `(transaction* (fn [] ~@body))) (defn do-commands "Executes SQL commands that don't return results on the open database connection" [& commands] - (with-open [stmt (.createStatement (connection))] + (with-open [stmt (create-statement)] (doseq [cmd commands] (.addBatch stmt cmd)) (.executeBatch stmt))) @@ -77,7 +51,7 @@ "Executes a prepared statement on the open database connection with parameter sets" [sql & sets] - (with-open [stmt (.prepareStatement (connection) sql)] + (with-open [stmt (prepare-statement sql)] (doseq [set sets] (doseq [[index value] (map vector (iterate inc 1) set)] (.setObject stmt index value)) @@ -113,10 +87,11 @@ [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)))) - "")] + columns + (if (seq column-names) + (format "(%s)" + (apply str (interpose "," (map the-str column-names)))) + "")] (apply do-prepared (format "insert into %s %s values (%s)" (the-str table) columns template) @@ -132,7 +107,7 @@ "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)] - (with-open [rset# (.executeQuery stmt#)] - (let [~results (resultset-seq rset#)] - ~@body)))) + `(with-open [stmt# (prepare-statement ~sql) + rset# (.executeQuery stmt#)] + (let [~results (resultset-seq rset#)] + ~@body))) diff --git a/src/clojure/contrib/sql/internal.clj b/src/clojure/contrib/sql/internal.clj index 42e0ba5f..8d6e8414 100644 --- a/src/clojure/contrib/sql/internal.clj +++ b/src/clojure/contrib/sql/internal.clj @@ -16,11 +16,21 @@ (def *db* {:connection nil :level 0}) (defn connection - "Returns the current database connection or throws an exception." + "Returns the current database connection or throws" [] (or (:connection *db*) (throw (Exception. "no current database connection")))) +(defn create-statement + "Creates a statement object on the current connection" + [] + (.createStatement (connection))) + +(defn prepare-statement + "Creates a prepared statement object on the current connection" + [sql] + (.prepareStatement (connection) sql)) + (defn the-str "Returns the name or string representation of x" [x] @@ -29,15 +39,56 @@ (str x))) (defn properties - "Converts a map from keywords or symbols to values into a - java.util.Properties object that maps the same keys to the values with + "Converts a map from keywords, symbols, or strings to values into a + java.util.Properties object that maps the key names to the values with all represented as strings." [m] (let [p (java.util.Properties.)] - (when m - (loop [[key & keys] (keys m) - [val & vals] (vals m)] - (.setProperty p (the-str key) (the-str val)) - (when keys - (recur keys vals)))) + (doseq [[key val] (seq m)] + (.setProperty p (the-str key) (the-str val))) p)) + +(defn with-connection* + "Evaluates thunk 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)) + (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* :connection con :level 0)] + (thunk)))) + +(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] + (let [con (connection) + outermost (zero? (:level *db*)) + auto-commit (when outermost (.getAutoCommit con))] + (binding [*db* (update-in *db* [:level] inc)] + (when outermost + (.setAutoCommit con false)) + (try + (let [value (thunk)] + (when outermost + (.commit con)) + value) + (catch Exception e + (.rollback con) + (throw (Exception. + (format "transaction rolled back: %s" + (.getMessage e)) 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 26a8a4a2..314a1c40 100644 --- a/src/clojure/contrib/sql/test.clj +++ b/src/clojure/contrib/sql/test.clj @@ -27,24 +27,27 @@ (catch Exception e))) (defn create-fruit [] - (sql/create-table :fruit + (sql/transaction + (sql/create-table :fruit [:name "varchar(32)" "NOT NULL"] [:appearance "varchar(32)"] [:cost :int] - [:grade :real])) + [:grade :real]))) (defn insert-rows-fruit [] - (sql/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])) + ["Orange" "juicy" 89 88.6]))) (defn insert-values-fruit [] - (sql/insert-values :fruit + (sql/transaction + (sql/insert-values :fruit [:name :cost] ["Mango" 722] - ["Feijoa" 441])) + ["Feijoa" 441]))) (defn db-write [] (sql/with-connection db @@ -64,16 +67,18 @@ (defn db-read-all [] (sql/with-connection db - (sql/with-results res - "select * from fruit" - (into [] res)))) + (sql/transaction + (sql/with-results res + "select * from fruit" + (into [] res))))) (defn db-grade-a [] (sql/with-connection db - (sql/with-results res - "select name, cost from fruit where grade >= 90" - (doseq [rec res] - (println rec))))) + (sql/transaction + (sql/with-results res + "select name, cost from fruit where grade >= 90" + (doseq [rec res] + (println rec)))))) (defn db-exception [] (sql/with-connection db |