Split all namespaces into sub-modules.

* Examples and tests have not been copied over.
* Clojure test/compile phases are commented out in parent POM.
* May require installing parent POM before full build.

3 files changed, 421 insertions, 0 deletions

diff --git a/modules/sql/pom.xml b/modules/sql/pom.xml
new file mode 100644
index 00000000..de94c477
--- /dev/null
+++ b/modules/sql/pom.xml
@@ -0,0 +1,26 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<project xmlns="http://maven.apache.org/POM/4.0.0"
+         xmlns:xsi="http//www.w3.org/2001/XMLSchema-instance"
+         xsi:schemaLocation="http://maven.apache.org/POM/4.0.0
+                             http://maven.apache.org/maven-v4_0_0.xsd">
+  <modelVersion>4.0.0</modelVersion>
+  <parent>
+    <groupId>org.clojure.contrib</groupId>
+    <artifactId>parent</artifactId>
+    <version>1.3.0-SNAPSHOT</version>
+    <relativePath>../parent</relativePath>
+  </parent>
+  <artifactId>sql</artifactId>
+  <dependencies>
+    <dependency>
+      <groupId>org.clojure.contrib</groupId>
+      <artifactId>def</artifactId>
+      <version>1.3.0-SNAPSHOT</version>
+    </dependency>
+    <dependency>
+      <groupId>org.clojure.contrib</groupId>
+      <artifactId>string</artifactId>
+      <version>1.3.0-SNAPSHOT</version>
+    </dependency>
+  </dependencies>
+</project>
\ No newline at end of file
diff --git a/modules/sql/src/main/clojure/clojure/contrib/sql.clj b/modules/sql/src/main/clojure/clojure/contrib/sql.clj
new file mode 100644
index 00000000..c6946078
--- /dev/null
+++ b/modules/sql/src/main/clojure/clojure/contrib/sql.clj
@@ -0,0 +1,201 @@
+;;  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.
+;;
+;;  sql.clj
+;;
+;;  A Clojure interface to sql databases via jdbc
+;;
+;;  See clojure.contrib.sql.test for an example
+;;
+;;  scgilardi (gmail)
+;;  Created 2 April 2008
+
+(ns
+  ^{:author "Stephen C. Gilardi",
+     :doc "A Clojure interface to sql databases via jdbc."
+     :see-also [["http://github.com/richhickey/clojure-contrib/blob/master/src/test/clojure/clojure/contrib/test_sql.clj"
+                 "Example code"]]}
+  clojure.contrib.sql
+  (:use (clojure.contrib
+         [def :only (defalias)]
+         [string :only (as-str)])
+        clojure.contrib.sql.internal))
+
+(defalias find-connection find-connection*)
+(defalias connection connection*)
+
+(defmacro with-connection
+  "Evaluates body in the context of a new connection to a database then
+  closes the connection. 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"
+  [db-spec & body]
+  `(with-connection* ~db-spec (fn [] ~@body)))
+
+(defmacro transaction
+  "Evaluates body 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 set-rollback-only is called within scope of the outermost
+  transaction, the entire transaction will be rolled back rather than
+  committed when complete."
+  [& body]
+  `(transaction* (fn [] ~@body)))
+
+(defn set-rollback-only
+  "Marks the outermost transaction such that it will rollback rather than
+  commit when complete"
+  []
+  (rollback true))
+
+(defn is-rollback-only
+  "Returns true if the outermost transaction will rollback rather than
+  commit when complete"
+  []
+  (rollback))
+
+(defn do-commands
+  "Executes SQL commands on the open database connection."
+  [& commands]
+  (with-open [stmt (.createStatement (connection))]
+    (doseq [cmd commands]
+      (.addBatch stmt cmd))
+    (transaction
+     (seq (.executeBatch stmt)))))
+
+(defn do-prepared
+  "Executes an (optionally parameterized) SQL prepared statement on the
+  open database connection. Each param-group is a seq of values for all of
+  the parameters."
+  [sql & param-groups]
+  (with-open [stmt (.prepareStatement (connection) sql)]
+    (doseq [param-group param-groups]
+      (doseq [[index value] (map vector (iterate inc 1) param-group)]
+        (.setObject stmt index value))
+      (.addBatch stmt))
+    (transaction
+     (seq (.executeBatch stmt)))))
+
+(defn create-table
+  "Creates a table on the open database connection given a table name and
+  specs. Each spec is either a column spec: a vector containing a column
+  name and optionally a type and other constraints, or a table-level
+  constraint: a vector containing words that express the constraint. All
+  words used to describe the table may be supplied as strings or keywords."
+  [name & specs]
+  (do-commands
+   (format "CREATE TABLE %s (%s)"
+           (as-str name)
+           (apply str
+             (map as-str
+              (apply concat
+               (interpose [", "]
+                (map (partial interpose " ") specs))))))))
+
+(defn drop-table
+  "Drops a table on the open database connection given its name, a string
+  or keyword"
+  [name]
+  (do-commands
+   (format "DROP TABLE %s" (as-str name))))
+
+(defn insert-values
+  "Inserts rows into a table with values for specified columns only.
+  column-names is a vector of strings or keywords identifying columns. Each
+  value-group is a vector containing a values for each column in
+  order. When inserting complete rows (all columns), consider using
+  insert-rows instead."
+  [table column-names & value-groups]
+  (let [column-strs (map as-str column-names)
+        n (count (first value-groups))
+        template (apply str (interpose "," (replicate n "?")))
+        columns (if (seq column-names)
+                  (format "(%s)" (apply str (interpose "," column-strs)))
+                  "")]
+    (apply do-prepared
+           (format "INSERT INTO %s %s VALUES (%s)"
+                   (as-str table) columns template)
+           value-groups)))
+
+(defn insert-rows
+  "Inserts complete rows into a table. Each row is a vector of values for
+  each of the table's columns in order."
+  [table & rows]
+  (apply insert-values table nil rows))
+
+(defn insert-records
+  "Inserts records into a table. records are maps from strings or
+  keywords (identifying columns) to values."
+  [table & records]
+  (doseq [record records]
+    (insert-values table (keys record) (vals record))))
+
+(defn delete-rows
+  "Deletes rows from a table. where-params is a vector containing a string
+  providing the (optionally parameterized) selection criteria followed by
+  values for any parameters."
+  [table where-params]
+  (let [[where & params] where-params]
+    (do-prepared
+     (format "DELETE FROM %s WHERE %s"
+             (as-str table) where)
+     params)))
+
+(defn update-values
+  "Updates values on selected rows in a table. where-params is a vector
+  containing a string providing the (optionally parameterized) selection
+  criteria followed by values for any parameters. record is a map from
+  strings or keywords (identifying columns) to updated values."
+  [table where-params record]
+  (let [[where & params] where-params
+        column-strs (map as-str (keys record))
+        columns (apply str (concat (interpose "=?, " column-strs) "=?"))]
+    (do-prepared
+     (format "UPDATE %s SET %s WHERE %s"
+             (as-str table) columns where)
+     (concat (vals record) params))))
+
+(defn update-or-insert-values
+  "Updates values on selected rows in a table, or inserts a new row when no
+  existing row matches the selection criteria. where-params is a vector
+  containing a string providing the (optionally parameterized) selection
+  criteria followed by values for any parameters. record is a map from
+  strings or keywords (identifying columns) to updated values."
+  [table where-params record]
+  (transaction
+   (let [result (update-values table where-params record)]
+     (if (zero? (first result))
+       (insert-values table (keys record) (vals record))
+       result))))
+
+(defmacro with-query-results
+  "Executes a query, then evaluates body with results bound to a seq of the
+  results. sql-params is a vector containing a string providing
+  the (optionally parameterized) SQL query followed by values for any
+  parameters."
+  [results sql-params & body]
+  `(with-query-results* ~sql-params (fn [~results] ~@body)))
diff --git a/modules/sql/src/main/clojure/clojure/contrib/sql/internal.clj b/modules/sql/src/main/clojure/clojure/contrib/sql/internal.clj
new file mode 100644
index 00000000..59a05205
--- /dev/null
+++ b/modules/sql/src/main/clojure/clojure/contrib/sql/internal.clj
@@ -0,0 +1,194 @@
+;;  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)]
+    [properties :only (as-properties)]
+    [seq :only (indexed)]))
+  (:import
+   (clojure.lang RT)
+   (java.sql BatchUpdateException DriverManager SQLException Statement)
+   (java.util Hashtable Map)
+   (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 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)))))