diff --git a/android/AndroidManifest.xml b/android/AndroidManifest.xml index 92f3857..508dfcd 100644 --- a/android/AndroidManifest.xml +++ b/android/AndroidManifest.xml @@ -1,6 +1,6 @@ + package="net.nightweb" android:versionCode="23" android:versionName="0.0.23"> diff --git a/android/project.clj b/android/project.clj index b7c57f0..f73e084 100644 --- a/android/project.clj +++ b/android/project.clj @@ -1,4 +1,4 @@ -(defproject nightweb-android/Nightweb "0.0.22" +(defproject nightweb-android/Nightweb "0.0.23" :license {:name "Public Domain" :url "http://unlicense.org/UNLICENSE"} :min-lein-version "2.0.0" @@ -12,7 +12,7 @@ :dependencies [[com.h2database/h2 "1.3.173"] [markdown-clj "0.9.33"] [neko/neko "3.0.0"] - [org.clojure/java.jdbc "0.3.0-beta1"] + ;[org.clojure/java.jdbc "0.3.0-beta1"] [org.clojure-android/clojure "1.5.1-jb" :use-resources true]] :profiles {:dev {:dependencies [[android/tools.nrepl "0.2.0-bigstack"]] :android {:aot :all-with-unused}} @@ -27,4 +27,4 @@ :android {:support-libraries ["v13"] :target-version "15" :aot-exclude-ns ["clojure.parallel" "clojure.core.reducers"] - :dex-opts ["-JXmx4096M" "--no-optimize"]}) + :dex-opts ["-JXmx4096M"]}) diff --git a/common/clojure/clojure/java/jdbc.clj b/common/clojure/clojure/java/jdbc.clj new file mode 100644 index 0000000..e119ed1 --- /dev/null +++ b/common/clojure/clojure/java/jdbc.clj @@ -0,0 +1,1014 @@ +;; 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. +;; +;; jdbc.clj +;; +;; A Clojure interface to sql databases via jdbc +;; +;; scgilardi (gmail) +;; Created 2 April 2008 +;; +;; seancorfield (gmail) +;; Migrated from clojure.contrib.sql 17 April 2011 + +(ns + ^{ + :author "Stephen C. Gilardi, Sean Corfield", + :doc "A Clojure interface to SQL databases via JDBC + +clojure.java.jdbc provides a simple abstraction for CRUD (create, read, +update, delete) operations on a SQL database, along with basic transaction +support. Basic DDL operations are also supported (create table, drop table, +access to table metadata). + +Maps are used to represent records, making it easy to store and retrieve +data. Results can be processed using any standard sequence operations. + +For most operations, Java's PreparedStatement is used so your SQL and +parameters can be represented as simple vectors where the first element +is the SQL string, with ? for each parameter, and the remaining elements +are the parameter values to be substituted. In general, operations return +the number of rows affected, except for a single record insert where any +generated keys are returned (as a map)." } + clojure.java.jdbc + (:import [java.net URI] + [java.sql BatchUpdateException DriverManager PreparedStatement ResultSet SQLException Statement] + [java.util Hashtable Map Properties] + [javax.sql DataSource]) + (:refer-clojure :exclude [resultset-seq]) + (:require [clojure.string :as str] + [clojure.java.jdbc.sql :as sql])) + +(def ^{:private true :dynamic true + :doc "The default entity naming strategy is to do nothing."} + *as-str* + identity) + +(def ^{:private true :dynamic true + :doc "The default keyword naming strategy is to lowercase the entity."} + *as-key* + str/lower-case) + +(defn as-str + "Given a naming strategy and a keyword, return the keyword as a + string per that naming strategy. Given (a naming strategy and) + a string, return it as-is. + A keyword of the form :x.y is treated as keywords :x and :y, + both are turned into strings via the naming strategy and then + joined back together so :x.y might become `x`.`y` if the naming + strategy quotes identifiers with `." + [f x] + (if (instance? clojure.lang.Named x) + (let [n (name x) + i (.indexOf n (int \.))] + (if (= -1 i) + (f n) + (str/join "." (map f (.split n "\\."))))) + (str x))) + +(defn as-key + "Given a naming strategy and a string, return the string as a + keyword per that naming strategy. Given (a naming strategy and) + a keyword, return it as-is." + [f x] + (if (instance? clojure.lang.Named x) + x + (keyword (f (str x))))) + +(defn as-identifier + "Given a keyword, convert it to a string using the current naming + strategy. + Given a string, return it as-is." + ([x] (as-identifier x *as-str*)) + ([x f-entity] (as-str f-entity x))) + +(defn as-keyword + "Given an entity name (string), convert it to a keyword using the + current naming strategy. + Given a keyword, return it as-is." + ([x] (as-keyword x *as-key*)) + ([x f-keyword] (as-key f-keyword 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." + [m] + (let [p (Properties.)] + (doseq [[k v] m] + (.setProperty p (as-str identity k) (as-str identity v))) + p)) + +(def ^{:private true :dynamic true} *db* {:connection nil :level 0}) + +(def ^{:private true :doc "Map of classnames to subprotocols"} classnames + {"postgresql" "org.postgresql.Driver" + "mysql" "com.mysql.jdbc.Driver" + "sqlserver" "com.microsoft.sqlserver.jdbc.SQLServerDriver" + "jtds:sqlserver" "net.sourceforge.jtds.jdbc.Driver" + "derby" "org.apache.derby.jdbc.EmbeddedDriver" + "hsqldb" "org.hsqldb.jdbcDriver" + "sqlite" "org.sqlite.JDBC"}) + +(def ^{:private true :doc "Map of schemes to subprotocols"} subprotocols + {"postgres" "postgresql"}) + +(defn- parse-properties-uri [^URI uri] + (let [host (.getHost uri) + port (if (pos? (.getPort uri)) (.getPort uri)) + path (.getPath uri) + scheme (.getScheme uri)] + (merge + {:subname (if port + (str "//" host ":" port path) + (str "//" host path)) + :subprotocol (subprotocols scheme scheme)} + (if-let [user-info (.getUserInfo uri)] + {:user (first (str/split user-info #":")) + :password (second (str/split user-info #":"))})))) + +(defn- strip-jdbc [^String spec] + (if (.startsWith spec "jdbc:") + (.substring spec 5) + spec)) + +(defn get-connection + "Creates a connection to a database. db-spec is a map containing connection + parameters. db-spec is a map containing values for one of the following + parameter sets: + + Existing Connection: + :connection (required) an existing open connection that can be used + but cannot be closed (only the parent connection can be closed) + + Factory: + :factory (required) a function of one argument, a map of params + (others) (optional) passed to the factory function in a map + + DriverManager: + :subprotocol (required) a String, the jdbc subprotocol + :subname (required) a String, the jdbc subname + :classname (optional) a String, the jdbc driver class name + (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 + + Raw: + :connection-uri (required) a String + Passed directly to DriverManager/getConnection + + URI: + Parsed JDBC connection string - see below + + String: + subprotocol://user:password@host:post/subname + An optional prefix of jdbc: is allowed." + [{:keys [connection + factory + connection-uri + classname subprotocol subname + datasource username password + name environment] + :as db-spec}] + (cond + connection + connection + + (instance? URI db-spec) + (get-connection (parse-properties-uri db-spec)) + + (string? db-spec) + (get-connection (URI. (strip-jdbc db-spec))) + + factory + (factory (dissoc db-spec :factory)) + + connection-uri + (DriverManager/getConnection connection-uri) + + (and subprotocol subname) + (let [url (format "jdbc:%s:%s" subprotocol subname) + etc (dissoc db-spec :classname :subprotocol :subname) + classname (or classname (classnames subprotocol))] + (clojure.lang.RT/loadClassForName classname) + (DriverManager/getConnection url (as-properties etc))) + + (and datasource username password) + (.getConnection ^DataSource datasource ^String username ^String password) + + datasource + (.getConnection ^DataSource datasource) + + :else + (let [^String msg (format "db-spec %s is missing a required parameter" db-spec)] + (throw (IllegalArgumentException. msg))))) + +(defn- make-name-unique + "Given a collection of column names and a new column name, + return the new column name made unique, if necessary, by + appending _N where N is some unique integer suffix." + [cols col-name n] + (let [suffixed-name (if (= n 1) col-name (str col-name "_" n))] + (if (apply distinct? suffixed-name cols) + suffixed-name + (recur cols col-name (inc n))))) + +(defn- make-cols-unique + "Given a collection of column names, rename duplicates so + that the result is a collection of unique column names." + [cols] + (if (or (empty? cols) (apply distinct? cols)) + cols + (reduce (fn [unique-cols col-name] (conj unique-cols (make-name-unique unique-cols col-name 1))) [] cols))) + +(defn resultset-seq + "Creates and returns a lazy sequence of maps corresponding to + the rows in the java.sql.ResultSet rs. Based on clojure.core/resultset-seq + but it respects the current naming strategy. Duplicate column names are + made unique by appending _N before applying the naming strategy (where + N is a unique integer)." + [^ResultSet rs & {:keys [identifiers] + :or {identifiers *as-key*}}] + (let [rsmeta (.getMetaData rs) + idxs (range 1 (inc (.getColumnCount rsmeta))) + keys (->> idxs + (map (fn [^Integer i] (.getColumnLabel rsmeta i))) + make-cols-unique + (map (comp keyword identifiers))) + row-values (fn [] (map (fn [^Integer i] (.getObject rs i)) idxs)) + ;; This used to use create-struct (on keys) and then struct to populate each row. + ;; That had the side effect of preserving the order of columns in each row. As + ;; part of JDBC-15, this was changed because structmaps are deprecated. We don't + ;; want to switch to records so we're using regular maps instead. We no longer + ;; guarantee column order in rows but using into {} should preserve order for up + ;; to 16 columns (because it will use a PersistentArrayMap). If someone is relying + ;; on the order-preserving behavior of structmaps, we can reconsider... + rows (fn thisfn [] + (when (.next rs) + (cons (zipmap keys (row-values)) (lazy-seq (thisfn)))))] + (rows))) + +(defn as-quoted-str + "Given a quoting pattern - either a single character or a vector pair of + characters - and a string, return the quoted string: + (as-quoted-str X foo) will return XfooX + (as-quoted-str [A B] foo) will return AfooB" + [q x] + (if (vector? q) + (str (first q) x (last q)) + (str q x q))) + +(defn as-named-identifier + "Given a naming strategy and a keyword, return the keyword as a string using the + entity naming strategy. + Given a naming strategy and a string, return the string as-is. + The naming strategy should either be a function (the entity naming strategy) or + a map containing :entity and/or :keyword keys which provide the entity naming + strategy and/or keyword naming strategy respectively." + [naming-strategy x] + (as-identifier x (if (map? naming-strategy) (or (:entity naming-strategy) identity) naming-strategy))) + +(defn as-named-keyword + "Given a naming strategy and a string, return the string as a keyword using the + keyword naming strategy. + Given a naming strategy and a keyword, return the keyword as-is. + The naming strategy should either be a function (the entity naming strategy) or + a map containing :entity and/or :keyword keys which provide the entity naming + strategy and/or keyword naming strategy respectively. + Note that providing a single function will cause the default keyword naming + strategy to be used!" + [naming-strategy x] + (as-keyword x (if (and (map? naming-strategy) (:keyword naming-strategy)) (:keyword naming-strategy) str/lower-case))) + +(defn as-quoted-identifier + "Given a quote pattern - either a single character or a pair of characters in + a vector - and a keyword, return the keyword as a string using a simple + quoting naming strategy. + Given a qote pattern and a string, return the string as-is. + (as-quoted-identifier X :name) will return XnameX as a string. + (as-quoted-identifier [A B] :name) will return AnameB as a string." + [q x] + (as-identifier x (partial as-quoted-str q))) + +(defmacro with-naming-strategy + "Evaluates body in the context of a naming strategy. + The naming strategy is either a function - the entity naming strategy - or + a map containing :entity and/or :keyword keys which provide the entity naming + strategy and/or the keyword naming strategy respectively. The default entity + naming strategy is identity; the default keyword naming strategy is lower-case." + [naming-strategy & body ] + `(binding [*as-str* (if (map? ~naming-strategy) (or (:entity ~naming-strategy) identity) ~naming-strategy) + *as-key* (if (map? ~naming-strategy) (or (:keyword ~naming-strategy) str/lower-case))] ~@body)) + +(defmacro with-quoted-identifiers + "Evaluates body in the context of a simple quoting naming strategy." + [q & body ] + `(binding [*as-str* (partial as-quoted-str ~q)] ~@body)) + +(defn- execute-batch + "Executes a batch of SQL commands and returns a sequence of update counts. + (-2) indicates a single operation operating on an unknown number of rows. + Specifically, Oracle returns that and we must call getUpdateCount() to get + the actual number of rows affected. In general, operations return an array + of update counts, so this may not be a general solution for Oracle..." + [^Statement stmt] + (let [result (.executeBatch stmt)] + (if (and (= 1 (count result)) (= -2 (first result))) + (list (.getUpdateCount stmt)) + (seq result)))) + +(def ^{:private true + :doc "Map friendly :concurrency values to ResultSet constants."} + result-set-concurrency + {:read-only ResultSet/CONCUR_READ_ONLY + :updatable ResultSet/CONCUR_UPDATABLE}) + +(def ^{:private true + :doc "Map friendly :cursors values to ResultSet constants."} + result-set-holdability + {:hold ResultSet/HOLD_CURSORS_OVER_COMMIT + :close ResultSet/CLOSE_CURSORS_AT_COMMIT}) + +(def ^{:private true + :doc "Map friendly :type values to ResultSet constants."} + result-set-type + {:forward-only ResultSet/TYPE_FORWARD_ONLY + :scroll-insensitive ResultSet/TYPE_SCROLL_INSENSITIVE + :scroll-sensitive ResultSet/TYPE_SCROLL_SENSITIVE}) + +(defn prepare-statement + "Create a prepared statement from a connection, a SQL string and an + optional list of parameters: + :return-keys true | false - default false + :result-type :forward-only | :scroll-insensitive | :scroll-sensitive + :concurrency :read-only | :updatable + :fetch-size n + :max-rows n" + [^java.sql.Connection con ^String sql & {:keys [return-keys result-type concurrency cursors fetch-size max-rows]}] + (let [^PreparedStatement stmt (cond + return-keys (try + (.prepareStatement con sql java.sql.Statement/RETURN_GENERATED_KEYS) + (catch Exception _ + ;; assume it is unsupported and try basic PreparedStatement: + (.prepareStatement con sql))) + (and result-type concurrency) (if cursors + (.prepareStatement con sql + (result-type result-set-type) + (concurrency result-set-concurrency) + (cursors result-set-holdability)) + (.prepareStatement con sql + (result-type result-set-type) + (concurrency result-set-concurrency))) + :else (.prepareStatement con sql))] + (when fetch-size (.setFetchSize stmt fetch-size)) + (when max-rows (.setMaxRows stmt max-rows)) + stmt)) + +(defn- set-parameters + "Add the parameters to the given statement." + [^PreparedStatement stmt params] + (dorun + (map-indexed + (fn [ix value] + (.setObject stmt (inc ix) value)) + params))) + +(defn create-table-ddl + "Given a table name and column specs with an optional table-spec + return the DDL string for creating a table based on that." + [name & specs] + (let [split-specs (partition-by #(= :table-spec %) specs) + col-specs (first split-specs) + table-spec (first (second (rest split-specs))) + table-spec-str (or (and table-spec (str " " table-spec)) "") + specs-to-string (fn [specs] + (apply str + (map as-identifier + (apply concat + (interpose [", "] + (map (partial interpose " ") specs))))))] + (format "CREATE TABLE %s (%s)%s" + (as-identifier name) + (specs-to-string col-specs) + table-spec-str))) + +(defn print-sql-exception + "Prints the contents of an SQLException to *out*" + [^SQLException exception] + (let [^Class exception-class (class exception)] + (println + (format (str "%s:" \newline + " Message: %s" \newline + " SQLState: %s" \newline + " Error Code: %d") + (.getSimpleName exception-class) + (.getMessage exception) + (.getSQLState exception) + (.getErrorCode exception))))) + +(defn print-sql-exception-chain + "Prints a chain of SQLExceptions to *out*" + [^SQLException exception] + (loop [e exception] + (when e + (print-sql-exception e) + (recur (.getNextException e))))) + +(def ^{:private true} special-counts + {Statement/EXECUTE_FAILED "EXECUTE_FAILED" + Statement/SUCCESS_NO_INFO "SUCCESS_NO_INFO"}) + +(defn print-update-counts + "Prints the update counts from a BatchUpdateException to *out*" + [^BatchUpdateException exception] + (println "Update counts:") + (dorun + (map-indexed + (fn [index count] + (println (format " Statement %d: %s" + index + (get special-counts count count)))) + (.getUpdateCounts exception)))) + +;; java.jdbc pieces rewritten to not use dynamic bindings + +(defn db-find-connection + "Returns the current database connection (or nil if there is none)" + ^java.sql.Connection [db] + (:connection db)) + +(defn db-connection + "Returns the current database connection (or throws if there is none)" + ^java.sql.Connection [db] + (or (db-find-connection db) + (throw (Exception. "no current database connection")))) + +(defn- db-rollback + "Accessor for the rollback flag on the current connection" + ([db] + (deref (:rollback db))) + ([db val] + (swap! (:rollback db) (fn [_] val)))) + +(defn- throw-non-rte + "This ugliness makes it easier to catch SQLException objects + rather than something wrapped in a RuntimeException which + can really obscure your code when working with JDBC from + Clojure... :(" + [^Throwable ex] + (cond (instance? java.sql.SQLException ex) (throw ex) + (and (instance? RuntimeException ex) (.getCause ex)) (throw-non-rte (.getCause ex)) + :else (throw ex))) + +(defn db-set-rollback-only + "Marks the outermost transaction such that it will rollback rather than + commit when complete" + [db] + (db-rollback db true)) + +(defn db-is-rollback-only + "Returns true if the outermost transaction will rollback rather than + commit when complete" + [db] + (db-rollback db)) + +(defn db-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." + [db func] + (let [nested-db (update-in db [:level] inc)] + (if (= (:level nested-db) 1) + (let [^java.sql.Connection con (get-connection nested-db) + nested-db (assoc nested-db :connection con) + auto-commit (.getAutoCommit con)] + (io! + (.setAutoCommit con false) + (try + (let [result (func nested-db)] + (if (db-rollback nested-db) + (.rollback con) + (.commit con)) + result) + (catch Throwable t + (.rollback con) + (throw-non-rte t)) + (finally + (db-rollback nested-db false) + (.setAutoCommit con auto-commit))))) + (try + (func nested-db) + (catch Exception e + (throw-non-rte e)))))) + +(defmacro db-transaction + "Evaluates body in the context of a transaction on the specified database connection. + The binding provides the dataabase connection for the transaction and the name to which + that is bound for evaluation of the body. + See db-transaction* for more details." + [binding & body] + `(db-transaction* (let [db# ~(second binding)] + (assoc db# :level (or (:level db#) 0) :rollback (or (:rollback db#) (atom false)))) + (fn [~(first binding)] + ~@body))) + +(defn db-do-commands + "Executes SQL commands on the specified database connection. Wraps the commands + in a transaction if transaction? is true." + [db transaction? & commands] + (with-open [^Statement stmt (let [^java.sql.Connection con (get-connection db)] (.createStatement con))] + (doseq [^String cmd commands] + (.addBatch stmt cmd)) + (if transaction? + (db-transaction [db (assoc db :connection (.getConnection stmt))] (execute-batch stmt)) + (try + (execute-batch stmt) + (catch Exception e + (throw-non-rte e)))))) + +(defn db-do-prepared-return-keys + "Executes an (optionally parameterized) SQL prepared statement on the + open database connection. The param-group is a seq of values for all of + the parameters. + Return the generated keys for the (single) update/insert." + [db transaction? sql param-group] + (with-open [^PreparedStatement stmt (prepare-statement (get-connection db) sql :return-keys true)] + (set-parameters stmt param-group) + (letfn [(exec-and-return-keys [] + (let [counts (.executeUpdate stmt)] + (try + (let [rs (.getGeneratedKeys stmt) + result (first (resultset-seq rs))] + ;; sqlite (and maybe others?) requires + ;; record set to be closed + (.close rs) + result) + (catch Exception _ + ;; assume generated keys is unsupported and return counts instead: + counts))))] + (if transaction? + (db-transaction [db (assoc db :connection (.getConnection stmt))] (exec-and-return-keys)) + (try + (exec-and-return-keys) + (catch Exception e + (throw-non-rte e))))))) + +(defn db-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. + Return a seq of update counts (one count for each param-group)." + [db transaction? sql & param-groups] + (with-open [^PreparedStatement stmt (prepare-statement (get-connection db) sql)] + (if (empty? param-groups) + (if transaction? + (db-transaction [db (assoc db :connection (.getConnection stmt))] (vector (.executeUpdate stmt))) + (try + (vector (.executeUpdate stmt)) + (catch Exception e + (throw-non-rte e)))) + (do + (doseq [param-group param-groups] + (set-parameters stmt param-group) + (.addBatch stmt)) + (if transaction? + (db-transaction [db (assoc db :connection (.getConnection stmt))] (execute-batch stmt)) + (try + (execute-batch stmt) + (catch Exception e + (throw-non-rte e)))))))) + +(defn db-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 either: + [sql & params] - a SQL query, followed by any parameters it needs + [stmt & params] - a PreparedStatement, followed by any parameters it needs + (the PreparedStatement already contains the SQL query) + [options sql & params] - options and a SQL query for creating a + PreparedStatement, follwed by any parameters it needs + See prepare-statement for supported options." + [db sql-params func identifiers] + (when-not (vector? sql-params) + (let [^Class sql-params-class (class sql-params) + ^String msg (format "\"%s\" expected %s %s, found %s %s" + "sql-params" + "vector" + "[sql param*]" + (.getName sql-params-class) + (pr-str sql-params))] + (throw (IllegalArgumentException. msg)))) + (let [special (first sql-params) + sql-is-first (string? special) + options-are-first (map? special) + sql (cond sql-is-first special + options-are-first (second sql-params)) + params (vec (cond sql-is-first (rest sql-params) + options-are-first (rest (rest sql-params)) + :else (rest sql-params))) + prepare-args (when (map? special) (flatten (seq special)))] + (with-open [^PreparedStatement stmt (if (instance? PreparedStatement special) + special + (apply prepare-statement (get-connection db) sql prepare-args))] + (set-parameters stmt params) + (with-open [rset (.executeQuery stmt)] + (func (resultset-seq rset :identifiers identifiers)))))) + +;; top-level API for actual SQL operations + +(defn query + "Given a database connection and a vector containing SQL and optional parameters, + perform a simple database query. The optional keyword arguments specify how to + construct the result set: + :result-set-fn - applied to the entire result set, default doall + :row-fn - applied to each row as the result set is constructed, default identity + :identifiers - applied to each column name in the result set, default lower-case" + [db sql-params & {:keys [result-set-fn row-fn identifiers] + :or {result-set-fn doall row-fn identity identifiers sql/lower-case}}] + (if-let [con (:connection db)] + (db-with-query-results* + db + (vec sql-params) + (fn [rs] + (result-set-fn (map row-fn rs))) + identifiers) + (with-open [con (get-connection db)] + (db-with-query-results* + (assoc db :connection con) + (vec sql-params) + (fn [rs] + (result-set-fn (map row-fn rs))) + identifiers)))) + +(defn execute! + "Given a database connection and a vector containing SQL and optional parameters, + perform a general (non-select) SQL operation. The optional keyword argument specifies + whether to run the operation in a transaction or not (default true)." + [db sql-params & {:keys [transaction?] + :or {transaction? true}}] + (if-let [con (:connection db)] + (db-do-prepared db + transaction? + (first sql-params) + (rest sql-params)) + (with-open [con (get-connection db)] + (db-do-prepared (assoc db :connection con) + transaction? + (first sql-params) + (rest sql-params))))) + +(defn delete! + "Given a database connection, a table name and a where clause of columns to match, + perform a delete. The optional keyword arguments specify how to transform + column names in the map (default 'as-is') and whether to run the delete in + a transaction (default true). + Example: + (delete! db :person {:zip 94546}) + is equivalent to: + (execute! db [\"DELETE FROM person WHERE zip = ?\" 94546])" + [db table where-clause & {:keys [entities transaction?] + :or {entities sql/as-is transaction? true}}] + (execute! db + (sql/delete table where-clause :entities entities) + :transaction? transaction?)) + +(defn insert! + "Given a database connection, a table name and either maps representing rows or + a list of column names followed by lists of column values, perform an insert. + Currently the insert is always run in a transaction." + [db table & maps-or-cols-and-values-etc] + (let [stmts (apply sql/insert table maps-or-cols-and-values-etc) + transaction? true] + (if-let [con (:connection db)] + (if (string? (first stmts)) + (apply db-do-prepared + db + transaction? + (first stmts) + (rest stmts)) + (doall (map (fn [row] + (let [result (db-do-prepared-return-keys + db + ;; bad idea - this is nested + transaction? + (first row) + (rest row))] + result)) + stmts))) + (with-open [con (get-connection db)] + (if (string? (first stmts)) + (apply db-do-prepared + (assoc db :connection con) + transaction? + (first stmts) + (rest stmts)) + (doall (map (fn [row] + (let [result (db-do-prepared-return-keys + (assoc db :connection con) + ;; bad idea - this is nested + transaction? + (first row) + (rest row))] + result)) + stmts))))))) + +(defn update! + "Given a database connection, a table name, a map of column values to set and a + where clause of columns to match, perform an update. The optional keyword arguments + specify how column names (in the set / match maps) should be transformed (default + 'as-is') and whether to run the update in a transaction (default true). + Example: + (update! db :person {:zip 94540} (where {:zip 94546})) + is equivalent to: + (execute! db [\"UPDATE person SET zip = ? WHERE zip = ?\" 94540 94546])" + [db table set-map where-clause & {:keys [entities transaction?] + :or {entities sql/as-is transaction? true}}] + (execute! db + (sql/update table set-map where-clause :entities entities) + :transaction? transaction?)) + +;; original API mostly rewritten in terms of new API primarily without dynamic binding + +(defn ^{:doc "Returns the current database connection (or nil if there is none)" + :deprecated "0.3.0"} + find-connection + ^java.sql.Connection [] + (db-find-connection *db*)) + +(defn ^{:doc "Returns the current database connection (or throws if there is none)" + :deprecated "0.3.0"} + connection + ^java.sql.Connection [] + (db-connection *db*)) + +(defn ^{:doc "Evaluates func in the context of a new connection to a database then + closes the connection." + :deprecated "0.3.0"} + with-connection* + [db-spec func] + (with-open [^java.sql.Connection con (get-connection db-spec)] + (binding [*db* (assoc *db* :connection con :level 0 :rollback (atom false))] + (func)))) + +(defmacro ^{:doc "Evaluates body in the context of a new connection to a database then + closes the connection." + :deprecated "0.3.0"} + with-connection + [db-spec & body] + `(with-connection* ~db-spec (fn [] ~@body))) + +(defn transaction* + ^{:doc "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." + :deprecated "0.3.0"} + [func] + (binding [*db* (update-in *db* [:level] inc)] + (if (= (:level *db*) 1) + (let [^java.sql.Connection con (get-connection *db*) + auto-commit (.getAutoCommit con)] + (io! + (.setAutoCommit con false) + (try + (let [result (func)] + (if (db-rollback *db*) + (.rollback con) + (.commit con)) + result) + (catch Throwable t + (.rollback con) + (throw-non-rte t)) + (finally + (db-rollback *db* false) + (.setAutoCommit con auto-commit))))) + (try + (func) + (catch Exception e + (throw-non-rte e)))))) + +(defmacro + ^{:doc "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." + :deprecated "0.3.0"} + transaction + [& body] + `(transaction* (fn [] ~@body))) + +(defn + ^{:doc "Marks the outermost transaction such that it will rollback rather than + commit when complete" + :deprecated "0.3.0"} + set-rollback-only + [] + (db-set-rollback-only *db*)) + +(defn + ^{:doc "Returns true if the outermost transaction will rollback rather than + commit when complete" + :deprecated "0.3.0"} + is-rollback-only + [] + (db-is-rollback-only *db*)) + +(defn + ^{:doc "Executes SQL commands on the open database connection." + :deprecated "0.3.0"} + do-commands + [& commands] + (apply db-do-commands *db* true commands)) + +(defn + ^{:doc "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. + Return a seq of update counts (one count for each param-group)." + :deprecated "0.3.0"} + do-prepared + [sql & param-groups] + (apply db-do-prepared *db* true sql param-groups)) + +(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. An + optional suffix to the CREATE TABLE DDL describing table attributes may + by provided as :table-spec {table-attributes-string}. All words used to + describe the table may be supplied as strings or keywords." + ;; technically deprecated but we don't yet have a replacement + [name & specs] + (do-commands (apply create-table-ddl name specs))) + +(defn drop-table + "Drops a table on the open database connection given its name, a string + or keyword" + ;; technically deprecated but we don't yet have a replacement + [name] + (do-commands + (format "DROP TABLE %s" (as-identifier name)))) + +(defn + ^{:doc "Executes an (optionally parameterized) SQL prepared statement on the + open database connection. The param-group is a seq of values for all of + the parameters. + Return the generated keys for the (single) update/insert." + :deprecated "0.3.0"} + do-prepared-return-keys + [sql param-group] + (db-do-prepared-return-keys *db* true sql param-group)) + +(defn + ^{:doc "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. + If a single set of values is inserted, returns a map of the generated keys." + :deprecated "0.3.0"} + ;; technically not fully deprecated since the nil column-names case + ;; is not (yet) supported in the new API... JDBC-45 + insert-values + [table column-names & value-groups] + (let [column-strs (map as-identifier column-names) + n (count (first value-groups)) + return-keys (= 1 (count value-groups)) + prepared-statement (if return-keys do-prepared-return-keys do-prepared) + template (apply str (interpose "," (repeat n "?"))) + columns (if (seq column-names) + (format "(%s)" (apply str (interpose "," column-strs))) + "")] + (apply prepared-statement + (format "INSERT INTO %s %s VALUES (%s)" + (as-identifier 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. + If a single row is inserted, returns a map of the generated keys." + [table & rows] + ;; will be deprecated after JDBC-45 is implemented + (apply insert-values table nil rows)) + +(defn + ^{:doc "Inserts records into a table. records are maps from strings or keywords + (identifying columns) to values. Inserts the records one at a time. + Returns a sequence of maps containing the generated keys for each record." + :deprecated "0.3.0"} + insert-records + [table & records] + (apply insert! *db* table records)) + +(defn + ^{:doc "Inserts a single record into a table. A record is a map from strings or + keywords (identifying columns) to values. + Returns a map of the generated keys." + :deprecated "0.3.0"} + insert-record + [table record] + (first (insert! *db* table record))) + +(defn + ^{:doc "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." + :deprecated "0.3.0"} + delete-rows + [table where-params] + (delete! *db* table where-params)) + +(defn + ^{:doc "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." + :deprecated "0.3.0"} + update-values + [table where-params record] + (update! *db* table record where-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)))) + +(defn + ^{:doc "Executes a query, then evaluates func passing in a seq of the results as + an argument. The first argument is a vector containing either: + [sql & params] - a SQL query, followed by any parameters it needs + [stmt & params] - a PreparedStatement, followed by any parameters it needs + (the PreparedStatement already contains the SQL query) + [options sql & params] - options and a SQL query for creating a + PreparedStatement, follwed by any parameters it needs + See prepare-statement for supported options." + :deprecated "0.3.0"} + with-query-results* + [sql-params func] + (when-not (vector? sql-params) + (let [^Class sql-params-class (class sql-params) + ^String msg (format "\"%s\" expected %s %s, found %s %s" + "sql-params" + "vector" + "[sql param*]" + (.getName sql-params-class) + (pr-str sql-params))] + (throw (IllegalArgumentException. msg)))) + (let [special (first sql-params) + sql-is-first (string? special) + options-are-first (map? special) + sql (cond sql-is-first special + options-are-first (second sql-params)) + params (vec (cond sql-is-first (rest sql-params) + options-are-first (rest (rest sql-params)) + :else (rest sql-params))) + prepare-args (when (map? special) (flatten (seq special)))] + (with-open [^PreparedStatement stmt (if (instance? PreparedStatement special) special (apply prepare-statement (get-connection *db*) sql prepare-args))] + (set-parameters stmt params) + (with-open [rset (.executeQuery stmt)] + (binding [*db* (assoc *db* :connection (.getConnection stmt))] + (func (resultset-seq rset))))))) + +(defmacro + ^{:doc "Executes a query, then evaluates body with results bound to a seq of the + results. sql-params is a vector containing either: + [sql & params] - a SQL query, followed by any parameters it needs + [stmt & params] - a PreparedStatement, followed by any parameters it needs + (the PreparedStatement already contains the SQL query) + [options sql & params] - options and a SQL query for creating a + PreparedStatement, follwed by any parameters it needs + See prepare-statement for supported options." + :deprecated "0.3.0"} + with-query-results + [results sql-params & body] + `(with-query-results* ~sql-params (fn [~results] ~@body))) diff --git a/common/clojure/clojure/java/jdbc/sql.clj b/common/clojure/clojure/java/jdbc/sql.clj new file mode 100644 index 0000000..6a597a1 --- /dev/null +++ b/common/clojure/clojure/java/jdbc/sql.clj @@ -0,0 +1,302 @@ +;; Copyright (c) Sean Corfield. 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 basic SQL DSL for use with clojure.java.jdbc (or you can use any +;; other SQL DSL you want to...) +;; +;; seancorfield (gmail) +;; December 2012 + +(ns + ^{:author "Sean Corfield", + :doc "An optional DSL for generating SQL. + +Intended to be used with clojure.java.jdbc, this provides a simple DSL - +Domain Specific Language - that generates raw SQL strings. Any other DSL +can be used instead. This DSL is entirely optional and is deliberately +not very sophisticated. It is sufficient to support the delete!, insert! +and update! high-level operations within clojure.java.jdbc directly." } + clojure.java.jdbc.sql + (:require [clojure.string :as str] + [clojure.walk :as walk])) + +;; implementation utilities + +(defn- as-str + "Given a naming strategy and a keyword, return the keyword as a + string per that naming strategy. Given (a naming strategy and) + a string, return it as-is. + A keyword of the form :x.y is treated as keywords :x and :y, + both are turned into strings via the naming strategy and then + joined back together so :x.y might become `x`.`y` if the naming + strategy quotes identifiers with `." + [f x] + (if (instance? clojure.lang.Named x) + (let [n (name x) + i (.indexOf n (int \.))] + (if (= -1 i) + (f n) + (str/join "." (map f (.split n "\\."))))) + (str x))) + +(defn- as-identifier + "Given a keyword, convert it to a string using the current naming + strategy. + Given a string, return it as-is." + [x f-entity] + (as-str f-entity x)) + +(defn- as-quoted-str + "Given a quoting pattern - either a single character or a vector pair of + characters - and a string, return the quoted string: + (as-quoted-str X foo) will return XfooX + (as-quoted-str [A B] foo) will return AfooB" + [q x] + (if (vector? q) + (str (first q) x (last q)) + (str q x q))) + +(defn- col-str + "Transform a column spec to an entity name for SQL. The column spec may be a + string, a keyword or a map with a single pair - column name and alias." + [col entities] + (if (map? col) + (let [[k v] (first col)] + (str (as-identifier k entities) " AS " (as-identifier v entities))) + (as-identifier col entities))) + +(defn- table-str + "Transform a table spec to an entity name for SQL. The table spec may be a + string, a keyword or a map with a single pair - table name and alias." + [table entities] + (if (map? table) + (let [[k v] (first table)] + (str (as-identifier k entities) " " (as-identifier v entities))) + (as-identifier table entities))) + +(def ^{:private true + :doc "Symbols that need to be processed for entities within their forms."} + entity-symbols + #{"delete" "delete!" + "insert" "insert!" + "select" "join" "where" "order-by" + "update" "update!"}) + +(def ^{:private true + :doc "Symbols that need to be processed for identifiers within their forms."} + identifier-symbols + #{"query"}) + +(defn- order-direction + "Transform a column order spec to an order by entity for SQL. The order spec may be a + string, a keyword or a map with a single pair - column name and direction. If the order + spec is not a map, the default direction is ascending." + [col entities] + (if (map? col) + (str (as-identifier (first (keys col)) entities) + " " + (let [dir (first (vals col))] + (get {:asc "ASC" :desc "DESC"} dir dir))) + (str (as-identifier col entities) " ASC"))) + +(defn- insert-multi-row + "Given a table and a list of columns, followed by a list of column value sequences, + return a vector of the SQL needed for the insert followed by the list of column + value sequences. The entities function specifies how column names are transformed." + [table columns values entities] + (let [nc (count columns) + vcs (map count values)] + (if (not (apply = nc vcs)) + (throw (IllegalArgumentException. "insert called with inconsistent number of columns / values")) + (into [(str "INSERT INTO " (table-str table entities) " ( " + (str/join ", " (map (fn [col] (col-str col entities)) columns)) + " ) VALUES ( " + (str/join ", " (repeat nc "?")) + " )")] + values)))) + +(defn- insert-single-row + "Given a table and a map representing a row, return a vector of the SQL needed for + the insert followed by the list of column values. The entities function specifies + how column names are transformed." + [table row entities] + (let [ks (keys row)] + (into [(str "INSERT INTO " (table-str table entities) " ( " + (str/join ", " (map (fn [col] (col-str col entities)) ks)) + " ) VALUES ( " + (str/join ", " (repeat (count ks) "?")) + " )")] + (vals row)))) + +;; quoting strategy helpers + +(defmacro entities + "Given an entities function and a SQL-generating DSL form, transform the DSL form + to inject an :entities keyword argument with the function at the end of each appropriate + form." + [entities sql] + (walk/postwalk (fn [form] + (if (and (seq? form) + (symbol? (first form)) + (entity-symbols (name (first form)))) + (concat form [:entities entities]) + form)) sql)) + +(defmacro identifiers + "Given an identifiers function and a SQL-generating DSL form, transform the DSL form + to inject an :identifiers keyword argument with the function at the end of each + appropriate form." + [identifiers sql] + (walk/postwalk (fn [form] + (if (and (seq? form) + (symbol? (first form)) + (identifier-symbols (name (first form)))) + (concat form [:identifiers identifiers]) + form)) sql)) + +;; some common quoting strategies + +(def as-is identity) +(def lower-case str/lower-case) +(defn quoted [q] (partial as-quoted-str q)) + +;; SQL generation functions + +(defn delete + "Given a table name, a where class and its parameters and an optional entities spec, + return a vector of the SQL for that delete operation followed by its parameters. The + entities spec (default 'as-is') specifies how to transform column names." + [table [where & params] & {:keys [entities] :or {entities as-is}}] + (into [(str "DELETE FROM " (table-str table entities) + (when where " WHERE ") where)] + params)) + +(defn insert + "Given a table name and either column names and values or maps representing rows, retun + return a vector of the SQL for that insert operation followed by its parameters. An + optional entities spec (default 'as-is') specifies how to transform column names." + [table & clauses] + (let [rows (take-while map? clauses) + n-rows (count rows) + cols-and-vals-etc (drop n-rows clauses) + cols-and-vals (take-while (comp not keyword?) cols-and-vals-etc) + n-cols-and-vals (count cols-and-vals) + no-cols-and-vals (zero? n-cols-and-vals) + options (drop (+ (count rows) (count cols-and-vals)) clauses) + {:keys [entities] :or {entities as-is}} (apply hash-map options)] + (if (zero? n-rows) + (if no-cols-and-vals + (throw (IllegalArgumentException. "insert called without data to insert")) + (if (< n-cols-and-vals 2) + (throw (IllegalArgumentException. "insert called with columns but no values")) + (insert-multi-row table (first cols-and-vals) (rest cols-and-vals) entities))) + (if no-cols-and-vals + (map (fn [row] (insert-single-row table row entities)) rows) + (throw (IllegalArgumentException. "insert may take records or columns and values, not both")))))) + +(defn join + "Given a table name and a map of how to join it (to the existing SQL fragment), + retun the SQL string for the JOIN clause. The optional entities spec (default 'as-is') + specifies how to transform column names." + [table on-map & {:keys [entities] :or {entities as-is}}] + (str "JOIN " (table-str table entities) " ON " + (str/join + " AND " + (map (fn [[k v]] (str (as-identifier k entities) " = " (as-identifier v entities))) on-map)))) + +(defn order-by + "Given a sequence of column order specs, and an optional entities spec, return the + SQL string for the ORDER BY clause. A column order spec may be a column name or a + map of the column name to the desired order." + [cols & {:keys [entities] :or {entities as-is}}] + (str "ORDER BY " + (if (or (string? cols) (keyword? cols) (map? cols)) + (order-direction cols entities) + (str/join "," (map #(order-direction % entities) cols))))) + +(defn select + "Given a sequence of column names (or *) and a table name, followed by optional SQL + clauses, return a vector for the SQL followed by its parameters. The general form is: + (select [columns] table joins [where params] order-by options) + where joins are optional strings, as is order-by, and the where clause is a vector + of a where SQL clause followed by its parameters. The options may may include an + entities spec to specify how column names should be transformed. + The intent is that the joins, where clause and order by clause are generated by + other parts of the DSL: + (select * {:person :p} + (join {:address :a} {:p.addressId :a.id}) + (where {:a.zip 94546}) + (order-by :p.name))" + [col-seq table & clauses] + (let [joins (take-while string? clauses) + where-etc (drop (count joins) clauses) + [where-clause & more] where-etc + [where & params] (when-not (keyword? where-clause) where-clause) + order-etc (if (keyword? where-clause) where-etc more) + [order-clause & more] order-etc + order-by (when (string? order-clause) order-clause) + options (if order-by more order-etc) + {:keys [entities] :or {entities as-is}} (apply hash-map options)] + (cons (str "SELECT " + (cond + (= * col-seq) "*" + (or (string? col-seq) + (keyword? col-seq) + (map? col-seq)) (col-str col-seq entities) + :else (str/join "," (map #(col-str % entities) col-seq))) + " FROM " (table-str table entities) + (when (seq joins) (str/join " " (cons "" joins))) + (when where " WHERE ") + where + (when order-by " ") + order-by) + params))) + +(defn update + "Given a table name and a map of columns to set, and optional map of columns to + match (and an optional entities spec), return a vector of the SQL for that update + followed by its parameters. Example: + (update :person {:zip 94540} (where {:zip 94546})) + returns: + [\"UPDATE person SET zip = ? WHERE zip = ?\" 94540 94546]" + [table set-map & where-etc] + (let [[where-clause & options] (when-not (keyword? (first where-etc)) where-etc) + [where & params] where-clause + {:keys [entities] :or {entities as-is}} (if (keyword? (first where-etc)) where-etc options) + ks (keys set-map) + vs (vals set-map)] + (cons (str "UPDATE " (table-str table entities) + " SET " (str/join + "," + (map (fn [k v] + (str (as-identifier k entities) + " = " + (if (nil? v) "NULL" "?"))) + ks vs)) + (when where " WHERE ") + where) + (concat (remove nil? vs) params)))) + +(defn where + "Given a map of columns and values, return a vector containing the where clause SQL + followed by its parameters. Example: + (where {:a 42 :b nil}) + returns: + [\"a = ? AND b IS NULL\" 42]" + [param-map & {:keys [entities] :or {entities as-is}}] + (let [ks (keys param-map) + vs (vals param-map)] + (cons (str/join + " AND " + (map (fn [k v] + (str (as-identifier k entities) + (if (nil? v) " IS NULL" " = ?"))) + ks vs)) + (remove nil? vs)))) diff --git a/desktop/project.clj b/desktop/project.clj index 08de38b..517f0b7 100644 --- a/desktop/project.clj +++ b/desktop/project.clj @@ -1,4 +1,4 @@ -(defproject nightweb-desktop "0.0.22" +(defproject nightweb-desktop "0.0.23" :license {:name "Public Domain" :url "http://unlicense.org/UNLICENSE"} :dependencies [[com.github.insubstantial/substance "7.2.1"] @@ -6,7 +6,7 @@ [hiccup "1.0.4"] [markdown-clj "0.9.33"] [org.clojure/clojure "1.5.1"] - [org.clojure/java.jdbc "0.3.0-beta1"] + ;[org.clojure/java.jdbc "0.3.0-beta1"] [ring "1.2.0"] [seesaw "1.4.4"]] :source-paths ["src" "../common/clojure"] diff --git a/server/project.clj b/server/project.clj index 5f557c8..90198e8 100644 --- a/server/project.clj +++ b/server/project.clj @@ -1,8 +1,8 @@ -(defproject nightweb-server/Nightweb "0.0.22" +(defproject nightweb-server/Nightweb "0.0.23" :license {:name "Public Domain" :url "http://unlicense.org/UNLICENSE"} :dependencies [[org.clojure/clojure "1.5.1"] - [org.clojure/java.jdbc "0.3.0-beta1"] + ;[org.clojure/java.jdbc "0.3.0-beta1"] [com.h2database/h2 "1.3.173"]] :source-paths ["src" "../common/clojure"] :java-source-paths ["../common/java"]