Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

file 209 lines (189 sloc) 7.064 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209
;; Copyright (c) Stephen C. Gilardi. All rights reserved. The use and
;; distribution terms for this software are covered by the Eclipse Public
;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
;; be found in the file epl-v10.html at the root of this distribution. By
;; using this software in any fashion, you are agreeing to be bound by the
;; terms of this license. You must not remove this notice, or any other,
;; from this software.
;;
;; internal definitions for clojure.contrib.sql
;;
;; scgilardi (gmail)
;; Created 3 October 2008

(ns clojure.contrib.sql.internal
  (:use
   (clojure.contrib
    [except :only (throwf throw-arg)]
    [seq :only (indexed)]))
  (:import
   (clojure.lang RT)
   (java.sql BatchUpdateException DriverManager SQLException Statement)
   (java.util Hashtable Map Properties)
   (javax.naming InitialContext Name)
   (javax.sql DataSource)))

(def *db* {:connection nil :level 0})

(def special-counts
     {Statement/EXECUTE_FAILED "EXECUTE_FAILED"
      Statement/SUCCESS_NO_INFO "SUCCESS_NO_INFO"})

(defn find-connection*
  "Returns the current database connection (or nil if there is none)"
  []
  (:connection *db*))

(defn connection*
  "Returns the current database connection (or throws if there is none)"
  []
  (or (find-connection*)
      (throwf "no current database connection")))

(defn rollback
  "Accessor for the rollback flag on the current connection"
  ([]
     (deref (:rollback *db*)))
  ([val]
     (swap! (:rollback *db*) (fn [_] val))))

(defn- as-str
  [x]
  (if (instance? clojure.lang.Named x)
    (name x)
    (str x)))

(defn- ^Properties as-properties
  "Convert any seq of pairs to a java.utils.Properties instance.
Uses as-str to convert both keys and values into strings."
  {:tag Properties}
  [m]
  (let [p (Properties.)]
    (doseq [[k v] m]
      (.setProperty p (as-str k) (as-str v)))
    p))

(defn get-connection
  "Creates a connection to a database. db-spec is a map containing values
for one of the following parameter sets:

Factory:
:factory (required) a function of one argument, a map of params
(others) (optional) passed to the factory function in a map

DriverManager:
:classname (required) a String, the jdbc driver class name
:subprotocol (required) a String, the jdbc subprotocol
:subname (required) a String, the jdbc subname
(others) (optional) passed to the driver as properties.

DataSource:
:datasource (required) a javax.sql.DataSource
:username (optional) a String
:password (optional) a String, required if :username is supplied

JNDI:
:name (required) a String or javax.naming.Name
:environment (optional) a java.util.Map"
  [{:keys [factory
           classname subprotocol subname
           datasource username password
           name environment]
    :as db-spec}]
  (cond
   factory
   (factory (dissoc db-spec :factory))
   (and classname subprotocol subname)
   (let [url (format "jdbc:%s:%s" subprotocol subname)
         etc (dissoc db-spec :classname :subprotocol :subname)]
     (RT/loadClassForName classname)
     (DriverManager/getConnection url (as-properties etc)))
   (and datasource username password)
   (.getConnection datasource username password)
   datasource
   (.getConnection datasource)
   name
   (let [env (and environment (Hashtable. environment))
         context (InitialContext. env)
         datasource (.lookup context name)]
     (.getConnection datasource))
   :else
   (throw-arg "db-spec %s is missing a required parameter" db-spec)))

(defn with-connection*
  "Evaluates func in the context of a new connection to a database then
closes the connection."
  [db-spec func]
  (with-open [con (get-connection db-spec)]
    (binding [*db* (assoc *db*
                     :connection con :level 0 :rollback (atom false))]
      (func))))

(defn print-sql-exception
  "Prints the contents of an SQLException to stream"
  [stream exception]
  (.println
   stream
   (format (str "%s:" \newline
                " Message: %s" \newline
                " SQLState: %s" \newline
                " Error Code: %d")
           (.getSimpleName (class exception))
           (.getMessage exception)
           (.getSQLState exception)
           (.getErrorCode exception))))

(defn print-sql-exception-chain
  "Prints a chain of SQLExceptions to stream"
  [stream exception]
  (loop [e exception]
    (when e
      (print-sql-exception stream e)
      (recur (.getNextException e)))))

(defn print-update-counts
  "Prints the update counts from a BatchUpdateException to stream"
  [stream exception]
  (.println stream "Update counts:")
  (doseq [[index count] (indexed (.getUpdateCounts exception))]
    (.println stream (format " Statement %d: %s"
                             index
                             (get special-counts count count)))))

(defn throw-rollback
  "Sets rollback and throws a wrapped exception"
  [e]
  (rollback true)
  (throwf e "transaction rolled back: %s" (.getMessage e)))

(defn transaction*
  "Evaluates func as a transaction on the open database connection. Any
nested transactions are absorbed into the outermost transaction. By
default, all database updates are committed together as a group after
evaluating the outermost body, or rolled back on any uncaught
exception. If rollback is set within scope of the outermost transaction,
the entire transaction will be rolled back rather than committed when
complete."
  [func]
  (binding [*db* (update-in *db* [:level] inc)]
    (if (= (:level *db*) 1)
      (let [con (connection*)
            auto-commit (.getAutoCommit con)]
        (io!
         (.setAutoCommit con false)
         (try
          (func)
          (catch BatchUpdateException e
            (print-update-counts *err* e)
            (print-sql-exception-chain *err* e)
            (throw-rollback e))
          (catch SQLException e
            (print-sql-exception-chain *err* e)
            (throw-rollback e))
          (catch Exception e
            (throw-rollback e))
          (finally
           (if (rollback)
             (.rollback con)
             (.commit con))
           (rollback false)
           (.setAutoCommit con auto-commit)))))
      (func))))

(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 :as sql-params] func]
  (when-not (vector? sql-params)
    (throw-arg "\"%s\" expected %s %s, found %s %s"
               "sql-params"
               "vector"
               "[sql param*]"
               (.getName (class sql-params))
               (pr-str sql-params)))
  (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)))))
Something went wrong with that request. Please try again.