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