1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/contrib/sql/internal.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,194 @@
     1.4 +;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
     1.5 +;;  distribution terms for this software are covered by the Eclipse Public
     1.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
     1.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
     1.8 +;;  using this software in any fashion, you are agreeing to be bound by the
     1.9 +;;  terms of this license.  You must not remove this notice, or any other,
    1.10 +;;  from this software.
    1.11 +;;
    1.12 +;;  internal definitions for clojure.contrib.sql
    1.13 +;;
    1.14 +;;  scgilardi (gmail)
    1.15 +;;  Created 3 October 2008
    1.16 +
    1.17 +(ns clojure.contrib.sql.internal
    1.18 +  (:use
    1.19 +   (clojure.contrib
    1.20 +    [except :only (throwf throw-arg)]
    1.21 +    [properties :only (as-properties)]
    1.22 +    [seq :only (indexed)]))
    1.23 +  (:import
    1.24 +   (clojure.lang RT)
    1.25 +   (java.sql BatchUpdateException DriverManager SQLException Statement)
    1.26 +   (java.util Hashtable Map)
    1.27 +   (javax.naming InitialContext Name)
    1.28 +   (javax.sql DataSource)))
    1.29 +
    1.30 +(def *db* {:connection nil :level 0})
    1.31 +
    1.32 +(def special-counts
    1.33 +     {Statement/EXECUTE_FAILED "EXECUTE_FAILED"
    1.34 +      Statement/SUCCESS_NO_INFO "SUCCESS_NO_INFO"})
    1.35 +
    1.36 +(defn find-connection*
    1.37 +  "Returns the current database connection (or nil if there is none)"
    1.38 +  []
    1.39 +  (:connection *db*))
    1.40 +
    1.41 +(defn connection*
    1.42 +  "Returns the current database connection (or throws if there is none)"
    1.43 +  []
    1.44 +  (or (find-connection*)
    1.45 +      (throwf "no current database connection")))
    1.46 +
    1.47 +(defn rollback
    1.48 +  "Accessor for the rollback flag on the current connection"
    1.49 +  ([]
    1.50 +     (deref (:rollback *db*)))
    1.51 +  ([val]
    1.52 +     (swap! (:rollback *db*) (fn [_] val))))
    1.53 +
    1.54 +(defn get-connection
    1.55 +  "Creates a connection to a database. db-spec is a map containing values
    1.56 +  for one of the following parameter sets:
    1.57 +
    1.58 +  Factory:
    1.59 +    :factory     (required) a function of one argument, a map of params
    1.60 +    (others)     (optional) passed to the factory function in a map
    1.61 +
    1.62 +  DriverManager:
    1.63 +    :classname   (required) a String, the jdbc driver class name
    1.64 +    :subprotocol (required) a String, the jdbc subprotocol
    1.65 +    :subname     (required) a String, the jdbc subname
    1.66 +    (others)     (optional) passed to the driver as properties.
    1.67 +
    1.68 +  DataSource:
    1.69 +    :datasource  (required) a javax.sql.DataSource
    1.70 +    :username    (optional) a String
    1.71 +    :password    (optional) a String, required if :username is supplied
    1.72 +
    1.73 +  JNDI:
    1.74 +    :name        (required) a String or javax.naming.Name
    1.75 +    :environment (optional) a java.util.Map"
    1.76 +  [{:keys [factory
    1.77 +           classname subprotocol subname
    1.78 +           datasource username password
    1.79 +           name environment]
    1.80 +    :as db-spec}]
    1.81 +  (cond
    1.82 +   factory
    1.83 +   (factory (dissoc db-spec :factory))
    1.84 +   (and classname subprotocol subname)
    1.85 +   (let [url (format "jdbc:%s:%s" subprotocol subname)
    1.86 +         etc (dissoc db-spec :classname :subprotocol :subname)]
    1.87 +     (RT/loadClassForName classname)
    1.88 +     (DriverManager/getConnection url (as-properties etc)))
    1.89 +   (and datasource username password)
    1.90 +   (.getConnection datasource username password)
    1.91 +   datasource
    1.92 +   (.getConnection datasource)
    1.93 +   name
    1.94 +   (let [env (and environment (Hashtable. environment))
    1.95 +         context (InitialContext. env)
    1.96 +         datasource (.lookup context name)]
    1.97 +     (.getConnection datasource))
    1.98 +   :else
    1.99 +   (throw-arg "db-spec %s is missing a required parameter" db-spec)))
   1.100 +
   1.101 +(defn with-connection*
   1.102 +  "Evaluates func in the context of a new connection to a database then
   1.103 +  closes the connection."
   1.104 +  [db-spec func]
   1.105 +  (with-open [con (get-connection db-spec)]
   1.106 +    (binding [*db* (assoc *db*
   1.107 +                     :connection con :level 0 :rollback (atom false))]
   1.108 +      (func))))
   1.109 +
   1.110 +(defn print-sql-exception
   1.111 +  "Prints the contents of an SQLException to stream"
   1.112 +  [stream exception]
   1.113 +  (.println
   1.114 +   stream
   1.115 +   (format (str "%s:" \newline
   1.116 +                " Message: %s" \newline
   1.117 +                " SQLState: %s" \newline
   1.118 +                " Error Code: %d")
   1.119 +           (.getSimpleName (class exception))
   1.120 +           (.getMessage exception)
   1.121 +           (.getSQLState exception)
   1.122 +           (.getErrorCode exception))))
   1.123 +
   1.124 +(defn print-sql-exception-chain
   1.125 +  "Prints a chain of SQLExceptions to stream"
   1.126 +  [stream exception]
   1.127 +  (loop [e exception]
   1.128 +    (when e
   1.129 +      (print-sql-exception stream e)
   1.130 +      (recur (.getNextException e)))))
   1.131 +
   1.132 +(defn print-update-counts
   1.133 +  "Prints the update counts from a BatchUpdateException to stream"
   1.134 +  [stream exception]
   1.135 +  (.println stream "Update counts:")
   1.136 +  (doseq [[index count] (indexed (.getUpdateCounts exception))]
   1.137 +    (.println stream (format " Statement %d: %s"
   1.138 +                             index
   1.139 +                             (get special-counts count count)))))
   1.140 +
   1.141 +(defn throw-rollback
   1.142 +  "Sets rollback and throws a wrapped exception"
   1.143 +  [e]
   1.144 +  (rollback true)
   1.145 +  (throwf e "transaction rolled back: %s" (.getMessage e)))
   1.146 +
   1.147 +(defn transaction*
   1.148 +  "Evaluates func as a transaction on the open database connection. Any
   1.149 +  nested transactions are absorbed into the outermost transaction. By
   1.150 +  default, all database updates are committed together as a group after
   1.151 +  evaluating the outermost body, or rolled back on any uncaught
   1.152 +  exception. If rollback is set within scope of the outermost transaction,
   1.153 +  the entire transaction will be rolled back rather than committed when
   1.154 +  complete."
   1.155 +  [func]
   1.156 +  (binding [*db* (update-in *db* [:level] inc)]
   1.157 +    (if (= (:level *db*) 1)
   1.158 +      (let [con (connection*)
   1.159 +            auto-commit (.getAutoCommit con)]
   1.160 +        (io!
   1.161 +         (.setAutoCommit con false)
   1.162 +         (try
   1.163 +          (func)
   1.164 +          (catch BatchUpdateException e
   1.165 +            (print-update-counts *err* e)
   1.166 +            (print-sql-exception-chain *err* e)
   1.167 +            (throw-rollback e))
   1.168 +          (catch SQLException e
   1.169 +            (print-sql-exception-chain *err* e)
   1.170 +            (throw-rollback e))
   1.171 +          (catch Exception e
   1.172 +            (throw-rollback e))
   1.173 +          (finally
   1.174 +           (if (rollback)
   1.175 +             (.rollback con)
   1.176 +             (.commit con))
   1.177 +           (rollback false)
   1.178 +           (.setAutoCommit con auto-commit)))))
   1.179 +      (func))))
   1.180 +
   1.181 +(defn with-query-results*
   1.182 +  "Executes a query, then evaluates func passing in a seq of the results as
   1.183 +  an argument. The first argument is a vector containing the (optionally
   1.184 +  parameterized) sql query string followed by values for any parameters."
   1.185 +  [[sql & params :as sql-params] func]
   1.186 +  (when-not (vector? sql-params)
   1.187 +    (throw-arg "\"%s\" expected %s %s, found %s %s"
   1.188 +               "sql-params"
   1.189 +               "vector"
   1.190 +               "[sql param*]"
   1.191 +               (.getName (class sql-params))
   1.192 +               (pr-str sql-params)))
   1.193 +  (with-open [stmt (.prepareStatement (connection*) sql)]
   1.194 +    (doseq [[index value] (map vector (iterate inc 1) params)]
   1.195 +      (.setObject stmt index value))
   1.196 +    (with-open [rset (.executeQuery stmt)]
   1.197 +      (func (resultset-seq rset)))))