Mercurial > lasercutter

annotate src/clojure/contrib/sql/internal.clj @ 10:ef7dbbd6452c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
added clojure source goodness
author Robert McIntyre <rlm@mit.edu>
date Sat, 21 Aug 2010 06:25:44 -0400
parents
children
rev   line source
rlm@10 1 ;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and
rlm@10 2 ;; distribution terms for this software are covered by the Eclipse Public
rlm@10 3 ;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
rlm@10 4 ;; be found in the file epl-v10.html at the root of this distribution. By
rlm@10 5 ;; using this software in any fashion, you are agreeing to be bound by the
rlm@10 6 ;; terms of this license. You must not remove this notice, or any other,
rlm@10 7 ;; from this software.
rlm@10 8 ;;
rlm@10 9 ;; internal definitions for clojure.contrib.sql
rlm@10 10 ;;
rlm@10 11 ;; scgilardi (gmail)
rlm@10 12 ;; Created 3 October 2008
rlm@10 13
rlm@10 14 (ns clojure.contrib.sql.internal
rlm@10 15 (:use
rlm@10 16 (clojure.contrib
rlm@10 17 [except :only (throwf throw-arg)]
rlm@10 18 [properties :only (as-properties)]
rlm@10 19 [seq :only (indexed)]))
rlm@10 20 (:import
rlm@10 21 (clojure.lang RT)
rlm@10 22 (java.sql BatchUpdateException DriverManager SQLException Statement)
rlm@10 23 (java.util Hashtable Map)
rlm@10 24 (javax.naming InitialContext Name)
rlm@10 25 (javax.sql DataSource)))
rlm@10 26
rlm@10 27 (def *db* {:connection nil :level 0})
rlm@10 28
rlm@10 29 (def special-counts
rlm@10 30 {Statement/EXECUTE_FAILED "EXECUTE_FAILED"
rlm@10 31 Statement/SUCCESS_NO_INFO "SUCCESS_NO_INFO"})
rlm@10 32
rlm@10 33 (defn find-connection*
rlm@10 34 "Returns the current database connection (or nil if there is none)"
rlm@10 35 []
rlm@10 36 (:connection *db*))
rlm@10 37
rlm@10 38 (defn connection*
rlm@10 39 "Returns the current database connection (or throws if there is none)"
rlm@10 40 []
rlm@10 41 (or (find-connection*)
rlm@10 42 (throwf "no current database connection")))
rlm@10 43
rlm@10 44 (defn rollback
rlm@10 45 "Accessor for the rollback flag on the current connection"
rlm@10 46 ([]
rlm@10 47 (deref (:rollback *db*)))
rlm@10 48 ([val]
rlm@10 49 (swap! (:rollback *db*) (fn [_] val))))
rlm@10 50
rlm@10 51 (defn get-connection
rlm@10 52 "Creates a connection to a database. db-spec is a map containing values
rlm@10 53 for one of the following parameter sets:
rlm@10 54
rlm@10 55 Factory:
rlm@10 56 :factory (required) a function of one argument, a map of params
rlm@10 57 (others) (optional) passed to the factory function in a map
rlm@10 58
rlm@10 59 DriverManager:
rlm@10 60 :classname (required) a String, the jdbc driver class name
rlm@10 61 :subprotocol (required) a String, the jdbc subprotocol
rlm@10 62 :subname (required) a String, the jdbc subname
rlm@10 63 (others) (optional) passed to the driver as properties.
rlm@10 64
rlm@10 65 DataSource:
rlm@10 66 :datasource (required) a javax.sql.DataSource
rlm@10 67 :username (optional) a String
rlm@10 68 :password (optional) a String, required if :username is supplied
rlm@10 69
rlm@10 70 JNDI:
rlm@10 71 :name (required) a String or javax.naming.Name
rlm@10 72 :environment (optional) a java.util.Map"
rlm@10 73 [{:keys [factory
rlm@10 74 classname subprotocol subname
rlm@10 75 datasource username password
rlm@10 76 name environment]
rlm@10 77 :as db-spec}]
rlm@10 78 (cond
rlm@10 79 factory
rlm@10 80 (factory (dissoc db-spec :factory))
rlm@10 81 (and classname subprotocol subname)
rlm@10 82 (let [url (format "jdbc:%s:%s" subprotocol subname)
rlm@10 83 etc (dissoc db-spec :classname :subprotocol :subname)]
rlm@10 84 (RT/loadClassForName classname)
rlm@10 85 (DriverManager/getConnection url (as-properties etc)))
rlm@10 86 (and datasource username password)
rlm@10 87 (.getConnection datasource username password)
rlm@10 88 datasource
rlm@10 89 (.getConnection datasource)
rlm@10 90 name
rlm@10 91 (let [env (and environment (Hashtable. environment))
rlm@10 92 context (InitialContext. env)
rlm@10 93 datasource (.lookup context name)]
rlm@10 94 (.getConnection datasource))
rlm@10 95 :else
rlm@10 96 (throw-arg "db-spec %s is missing a required parameter" db-spec)))
rlm@10 97
rlm@10 98 (defn with-connection*
rlm@10 99 "Evaluates func in the context of a new connection to a database then
rlm@10 100 closes the connection."
rlm@10 101 [db-spec func]
rlm@10 102 (with-open [con (get-connection db-spec)]
rlm@10 103 (binding [*db* (assoc *db*
rlm@10 104 :connection con :level 0 :rollback (atom false))]
rlm@10 105 (func))))
rlm@10 106
rlm@10 107 (defn print-sql-exception
rlm@10 108 "Prints the contents of an SQLException to stream"
rlm@10 109 [stream exception]
rlm@10 110 (.println
rlm@10 111 stream
rlm@10 112 (format (str "%s:" \newline
rlm@10 113 " Message: %s" \newline
rlm@10 114 " SQLState: %s" \newline
rlm@10 115 " Error Code: %d")
rlm@10 116 (.getSimpleName (class exception))
rlm@10 117 (.getMessage exception)
rlm@10 118 (.getSQLState exception)
rlm@10 119 (.getErrorCode exception))))
rlm@10 120
rlm@10 121 (defn print-sql-exception-chain
rlm@10 122 "Prints a chain of SQLExceptions to stream"
rlm@10 123 [stream exception]
rlm@10 124 (loop [e exception]
rlm@10 125 (when e
rlm@10 126 (print-sql-exception stream e)
rlm@10 127 (recur (.getNextException e)))))
rlm@10 128
rlm@10 129 (defn print-update-counts
rlm@10 130 "Prints the update counts from a BatchUpdateException to stream"
rlm@10 131 [stream exception]
rlm@10 132 (.println stream "Update counts:")
rlm@10 133 (doseq [[index count] (indexed (.getUpdateCounts exception))]
rlm@10 134 (.println stream (format " Statement %d: %s"
rlm@10 135 index
rlm@10 136 (get special-counts count count)))))
rlm@10 137
rlm@10 138 (defn throw-rollback
rlm@10 139 "Sets rollback and throws a wrapped exception"
rlm@10 140 [e]
rlm@10 141 (rollback true)
rlm@10 142 (throwf e "transaction rolled back: %s" (.getMessage e)))
rlm@10 143
rlm@10 144 (defn transaction*
rlm@10 145 "Evaluates func as a transaction on the open database connection. Any
rlm@10 146 nested transactions are absorbed into the outermost transaction. By
rlm@10 147 default, all database updates are committed together as a group after
rlm@10 148 evaluating the outermost body, or rolled back on any uncaught
rlm@10 149 exception. If rollback is set within scope of the outermost transaction,
rlm@10 150 the entire transaction will be rolled back rather than committed when
rlm@10 151 complete."
rlm@10 152 [func]
rlm@10 153 (binding [*db* (update-in *db* [:level] inc)]
rlm@10 154 (if (= (:level *db*) 1)
rlm@10 155 (let [con (connection*)
rlm@10 156 auto-commit (.getAutoCommit con)]
rlm@10 157 (io!
rlm@10 158 (.setAutoCommit con false)
rlm@10 159 (try
rlm@10 160 (func)
rlm@10 161 (catch BatchUpdateException e
rlm@10 162 (print-update-counts *err* e)
rlm@10 163 (print-sql-exception-chain *err* e)
rlm@10 164 (throw-rollback e))
rlm@10 165 (catch SQLException e
rlm@10 166 (print-sql-exception-chain *err* e)
rlm@10 167 (throw-rollback e))
rlm@10 168 (catch Exception e
rlm@10 169 (throw-rollback e))
rlm@10 170 (finally
rlm@10 171 (if (rollback)
rlm@10 172 (.rollback con)
rlm@10 173 (.commit con))
rlm@10 174 (rollback false)
rlm@10 175 (.setAutoCommit con auto-commit)))))
rlm@10 176 (func))))
rlm@10 177
rlm@10 178 (defn with-query-results*
rlm@10 179 "Executes a query, then evaluates func passing in a seq of the results as
rlm@10 180 an argument. The first argument is a vector containing the (optionally
rlm@10 181 parameterized) sql query string followed by values for any parameters."
rlm@10 182 [[sql & params :as sql-params] func]
rlm@10 183 (when-not (vector? sql-params)
rlm@10 184 (throw-arg "\"%s\" expected %s %s, found %s %s"
rlm@10 185 "sql-params"
rlm@10 186 "vector"
rlm@10 187 "[sql param*]"
rlm@10 188 (.getName (class sql-params))
rlm@10 189 (pr-str sql-params)))
rlm@10 190 (with-open [stmt (.prepareStatement (connection*) sql)]
rlm@10 191 (doseq [[index value] (map vector (iterate inc 1) params)]
rlm@10 192 (.setObject stmt index value))
rlm@10 193 (with-open [rset (.executeQuery stmt)]
rlm@10 194 (func (resultset-seq rset)))))