diff --git a/clj-test/jdbc/core_test.clj b/clj-test/jdbc/core_test.clj index c05b816..0d0373b 100644 --- a/clj-test/jdbc/core_test.clj +++ b/clj-test/jdbc/core_test.clj @@ -1,5 +1,9 @@ (ns jdbc.core-test - (:require [jdbc.core :as jdbc])) + (:require [jdbc.core :as jdbc] + ;; the placeholder rewriter lives in the pg driver; requiring it here + ;; lets the sqlite-only run cover the lexer table. Loading db.pg does + ;; not need libpq present, only calling into it does. + [db.pg])) (def failures (atom 0)) @@ -87,7 +91,7 @@ ;; really a placeholder must neither be rewritten nor consume a number. These ;; run without a database, so the sqlite-only build covers them. (println "postgres placeholder rewriting") - (let [rewrite (deref (resolve (symbol "jdbc.core" "pg-placeholders")))] + (let [rewrite (deref (resolve (symbol "db.pg" "pg-placeholders")))] (doseq [[label in out] [["no placeholders" "select 1" "select 1"] ["bare placeholder" "?" "$1"] diff --git a/clj/db/jdbc.clj b/clj/db/jdbc.clj new file mode 100644 index 0000000..56c033a --- /dev/null +++ b/clj/db/jdbc.clj @@ -0,0 +1,33 @@ +(ns db.jdbc + "Entry point: loads the java.sql shim, then the real clojure.jdbc on top of it, + then points clojure.jdbc's connection construction at the native drivers. + + Require this once before using jdbc.core. Two things depend on the order. The + shim has to be loaded before clojure.jdbc's namespaces compile, because they + resolve java.sql constants at compile time. And the IConnection extension below + has to be loaded after clojure.jdbc's own, since the later extension is the one + that wins, which is how a dbspec reaches db.sqlite / db.pg instead of + DriverManager. + + (require '[db.jdbc]) + (require '[jdbc.core :as jdbc]) + (with-open [conn (jdbc/connection \"sqlite::memory:\")] + (jdbc/fetch conn \"select 1 as one\")) + + Not wired in yet. While this repo still ships its own clj/jdbc/core.clj, that + copy shadows the dependency on the classpath and the require below resolves to it + rather than to clojure.jdbc, so this namespace only does what it says once that + file is removed." + (:require [db.jdbc-shim :as shim] + [jdbc.proto :as proto] + [jdbc.core])) + +;; DriverManager and DataSource have nothing to load here, so a dbspec map or uri +;; string builds a shim connection over the native driver instead. Registered after +;; jdbc.impl's own extensions so these take precedence. +(extend-protocol proto/IConnection + java.lang.String + (connection [s] (shim/connection s)) + + clojure.lang.IPersistentMap + (connection [m] (shim/connection m))) diff --git a/clj/db/jdbc_shim.clj b/clj/db/jdbc_shim.clj new file mode 100644 index 0000000..3562a03 --- /dev/null +++ b/clj/db/jdbc_shim.clj @@ -0,0 +1,433 @@ +(ns db.jdbc-shim + "The java.sql surface clojure.jdbc drives, over the native drivers in db.sqlite + and db.pg, so the real clojure.jdbc runs on jolt unchanged rather than being + reimplemented here. Registered through jolt's host-shim hooks + (__register-class-statics! / __register-class-methods! / + __register-instance-check!), the same way jolt-lang/http-client stands in for + java.net.URL so clj-http-lite runs as published. + + Load order matters: clojure.jdbc's namespaces resolve the java.sql constants when + they compile, so this namespace has to load before jdbc.core. Requiring db.jdbc + does that in the right order. + + Shim objects are host tagged-tables whose fields are read and written with + jolt.host/ref-get and ref-put!. Only the surface clojure.jdbc actually touches is + implemented; anything else is deliberately absent so a gap shows up as a missing + method rather than as a silently wrong answer." + (:require [clojure.string :as str] + [db.sqlite :as sqlite])) + +;; --- java.sql constants ------------------------------------------------------ +;; jdbc.constants maps its keyword options onto these, so they have to read as the +;; same ints the JVM uses: a caller who passes :serializable through to +;; setTransactionIsolation gets 8 either way. + +(clojure.core/__register-class-statics! "java.sql.ResultSet" + {"TYPE_FORWARD_ONLY" 1003 + "TYPE_SCROLL_INSENSITIVE" 1004 + "TYPE_SCROLL_SENSITIVE" 1005 + "CONCUR_READ_ONLY" 1007 + "CONCUR_UPDATABLE" 1008 + "HOLD_CURSORS_OVER_COMMIT" 1 + "CLOSE_CURSORS_AT_COMMIT" 2 + "FETCH_FORWARD" 1000 + "FETCH_REVERSE" 1001 + "FETCH_UNKNOWN" 1002}) + +(clojure.core/__register-class-statics! "java.sql.Connection" + {"TRANSACTION_NONE" 0 + "TRANSACTION_READ_UNCOMMITTED" 1 + "TRANSACTION_READ_COMMITTED" 2 + "TRANSACTION_REPEATABLE_READ" 4 + "TRANSACTION_SERIALIZABLE" 8}) + +(clojure.core/__register-class-statics! "java.sql.Statement" + {"RETURN_GENERATED_KEYS" 1 + "NO_GENERATED_KEYS" 2 + "CLOSE_CURRENT_RESULT" 1 + "KEEP_CURRENT_RESULT" 2 + "CLOSE_ALL_RESULTS" 3 + "SUCCESS_NO_INFO" -2 + "EXECUTE_FAILED" -3}) + +;; --- shim object plumbing ---------------------------------------------------- +(defn- tt [tag] (jolt.host/tagged-table tag)) +(defn- tget [t k] (jolt.host/ref-get t k)) +(defn- tput! [t k v] (jolt.host/ref-put! t k v)) +(defn- table? [x] (jolt.host/table? x)) + +(defn- tagged? [x tag] (and (table? x) (= tag (tget x :jolt/type)))) + +(defn- sql-error + "Throw as java.sql.SQLException by class, so a caller's (catch SQLException ...) + matches on the class rather than on anything we put in ex-data." + [msg] + (throw (jolt.host/throwable "java.sql.SQLException" (str msg)))) + +;; The drivers report failures as ex-info carrying :jdbc/sql-error. Re-throw those +;; as typed SQLExceptions at the shim boundary so clojure.jdbc and its callers see +;; the class they expect. +(defn- as-sql-error [e] + (if (:jdbc/sql-error (ex-data e)) + (sql-error (ex-message e)) + (throw e))) + +(defmacro ^:private sql-try [& body] + `(try ~@body (catch Exception e# (as-sql-error e#)))) + +;; db.pg is required lazily, only for a postgres connection, so a sqlite-only app +;; never needs libpq. Resolve its fns at runtime for the same reason jdbc.core did. +(defn- pgfn [n] (deref (resolve (symbol "db.pg" n)))) + +;; --- driver-facing operations ------------------------------------------------ +(defn- vendor [conn] (tget conn :vendor)) +(defn- handle [conn] (tget conn :handle)) + +(defn- run-query + "Execute `sql` and return {:labels [...] :rows [[v ...]]}." + [conn sql params] + (sql-try + (case (vendor conn) + :sqlite (sqlite/query-raw (handle conn) sql params) + :postgresql ((pgfn "all-raw") (handle conn) sql params)))) + +(defn- run-update + "Execute `sql` and return the number of rows it affected." + [conn sql params] + (sql-try + (case (vendor conn) + :sqlite (do (sqlite/query-raw (handle conn) sql params) + (sqlite/changes (handle conn))) + :postgresql ((pgfn "exec") (handle conn) sql params)))) + +;; --- java.sql.ResultSetMetaData ---------------------------------------------- +(defn- make-rsmeta [labels] + (let [t (tt :jdbc/rsmeta)] (tput! t :labels labels) t)) + +(clojure.core/__register-class-methods! :jdbc/rsmeta + {"getColumnCount" (fn [self] (count (tget self :labels))) + ;; JDBC indexes columns from 1 + "getColumnLabel" (fn [self i] (nth (tget self :labels) (dec i))) + "getColumnName" (fn [self i] (nth (tget self :labels) (dec i)))}) + +;; --- java.sql.ResultSet ------------------------------------------------------ +;; The drivers hand back every row at once, so this is a cursor over a vector +;; rather than a live server-side cursor. .next walks it; a fetch that streamed on +;; the JVM is eager here, which is a real difference and not just an internal one. +(defn- make-resultset [{:keys [labels rows]}] + (let [t (tt :jdbc/resultset)] + (tput! t :labels (or labels [])) + (tput! t :rows (or rows [])) + (tput! t :pos -1) + (tput! t :closed false) + t)) + +(defn- rs-current [self] + (let [pos (tget self :pos) rows (tget self :rows)] + (when (and (>= pos 0) (< pos (count rows))) (nth rows pos)))) + +(clojure.core/__register-class-methods! :jdbc/resultset + {"next" (fn [self] + (let [pos (inc (tget self :pos))] + (tput! self :pos pos) + (< pos (count (tget self :rows))))) + "getMetaData" (fn [self] (make-rsmeta (tget self :labels))) + "getObject" (fn [self i] + (let [row (or (rs-current self) (sql-error "ResultSet not positioned on a row"))] + (if (number? i) + (nth row (dec i)) + ;; by label, case-insensitively, as JDBC does + (let [labels (tget self :labels) + idx (first (keep-indexed + (fn [n l] (when (= (str/lower-case l) + (str/lower-case (str i))) n)) + labels))] + (if idx (nth row idx) (sql-error (str "no such column: " i))))))) + "close" (fn [self] (tput! self :closed true) nil) + "isClosed" (fn [self] (tget self :closed))}) + +;; --- java.sql.PreparedStatement ---------------------------------------------- +;; Params arrive one at a time through .setObject at 1-based indexes, so collect +;; them in a map and flatten to a vector at execute time. That way a caller who +;; sets them out of order still gets them in order. +(defn- make-prepared [conn sql opts] + (let [t (tt :jdbc/prepared)] + (tput! t :conn conn) + (tput! t :sql sql) + (tput! t :params {}) + (tput! t :returning (:returning opts)) + (tput! t :max-rows (:max-rows opts)) + (tput! t :batch []) + (tput! t :keys nil) + (tput! t :closed false) + t)) + +(defn- param-vec [self] + (let [m (tget self :params)] + (if (empty? m) + [] + (mapv (fn [i] (get m i)) (range 1 (inc (apply max (keys m)))))))) + +(defn- limit-rows [self {:keys [labels rows]}] + (let [n (tget self :max-rows)] + {:labels labels :rows (if (and n (pos? n)) (vec (take n rows)) rows)})) + +;; RETURNING is how the generated keys come back, since neither driver has a +;; JDBC-style generated-keys channel. :all / true asks for the whole row, which is +;; what postgres' own driver gives for RETURN_GENERATED_KEYS; a sequence of names +;; asks for those columns. +(defn- returning-sql [self] + (let [r (tget self :returning) + sql (str/trimr (str/replace (tget self :sql) #";\s*$" ""))] + (cond + (or (true? r) (= :all r)) (str sql " RETURNING *") + (sequential? r) (str sql " RETURNING " + (str/join ", " (map name r))) + :else nil))) + +(clojure.core/__register-class-methods! :jdbc/prepared + {"setObject" (fn [self i v] (tput! self :params (assoc (tget self :params) i v)) nil) + "setString" (fn [self i v] (tput! self :params (assoc (tget self :params) i v)) nil) + "setNull" (fn [self i & _] (tput! self :params (assoc (tget self :params) i nil)) nil) + + "executeQuery" (fn [self] + (make-resultset + (limit-rows self (run-query (tget self :conn) (tget self :sql) + (param-vec self))))) + + "executeUpdate" (fn [self] + (let [conn (tget self :conn) + params (param-vec self)] + (if-let [rsql (returning-sql self)] + ;; run it as a query so the RETURNING rows can be handed + ;; back from getGeneratedKeys, and report the row count + (let [res (run-query conn rsql params)] + (tput! self :keys res) + (count (:rows res))) + (do (tput! self :keys nil) + (run-update conn (tget self :sql) params))))) + + ;; An empty ResultSet when nothing was requested is what makes insert! fall back + ;; to the update count, which is how it behaves on a driver without generated + ;; keys. + "getGeneratedKeys" (fn [self] + (make-resultset (or (tget self :keys) {:labels [] :rows []}))) + + "addBatch" (fn [self & _] + (tput! self :batch (conj (tget self :batch) (param-vec self))) + (tput! self :params {}) + nil) + "executeBatch" (fn [self] + (let [conn (tget self :conn) sql (tget self :sql)] + (mapv (fn [ps] (run-update conn sql ps)) (tget self :batch)))) + + "setQueryTimeout" (fn [self _] nil) + "setFetchSize" (fn [self _] nil) + "setMaxRows" (fn [self n] (tput! self :max-rows n) nil) + "close" (fn [self] (tput! self :closed true) nil) + "isClosed" (fn [self] (tget self :closed))}) + +;; --- java.sql.Statement ------------------------------------------------------ +;; createStatement is only used for the no-parameter execute path, which batches a +;; single SQL string. +(defn- make-statement [conn] + (let [t (tt :jdbc/statement)] + (tput! t :conn conn) (tput! t :batch []) (tput! t :closed false) t)) + +(clojure.core/__register-class-methods! :jdbc/statement + {"addBatch" (fn [self sql] (tput! self :batch (conj (tget self :batch) sql)) nil) + "executeBatch" (fn [self] + (let [conn (tget self :conn)] + (mapv (fn [sql] (run-update conn sql [])) (tget self :batch)))) + "executeUpdate" (fn [self sql] (run-update (tget self :conn) sql [])) + "executeQuery" (fn [self sql] (make-resultset (run-query (tget self :conn) sql []))) + "setQueryTimeout" (fn [self _] nil) + "close" (fn [self] (tput! self :closed true) nil)}) + +;; --- java.sql.DatabaseMetaData ----------------------------------------------- +(defn- make-dbmeta [conn] + (let [t (tt :jdbc/dbmeta)] (tput! t :conn conn) t)) + +(clojure.core/__register-class-methods! :jdbc/dbmeta + {"getDatabaseProductName" (fn [self] + (case (vendor (tget self :conn)) + :sqlite "SQLite" + :postgresql "PostgreSQL")) + "getConnection" (fn [self] (tget self :conn))}) + +;; --- java.sql.Connection ----------------------------------------------------- +;; Transactions go through the same BEGIN / SAVEPOINT sequence the drivers already +;; understand. Autocommit off means a transaction is open, so BEGIN is issued on +;; the transition rather than eagerly. +(defn- make-connection [vendor handle close-fn] + (let [t (tt :jdbc/connection)] + (tput! t :vendor vendor) + (tput! t :handle handle) + (tput! t :close-fn close-fn) + (tput! t :autocommit true) + (tput! t :readonly false) + (tput! t :isolation 2) ; TRANSACTION_READ_COMMITTED + (tput! t :savepoints []) + (tput! t :closed false) + t)) + +(defn- exec! [conn sql] (run-update conn sql [])) + +(clojure.core/__register-class-methods! :jdbc/connection + {"createStatement" (fn [self & _] (make-statement self)) + ;; the overloads differ only in how generated keys are asked for: an int is + ;; RETURN_GENERATED_KEYS, an array of names asks for those columns + "prepareStatement" (fn [self sql & args] + (let [a (first args)] + (make-prepared self sql + (cond + (nil? a) {} + (number? a) (if (= 1 a) {:returning :all} {}) + (sequential? a) {:returning (vec a)} + :else {})))) + + "setAutoCommit" (fn [self v] + (let [v (boolean v)] + (when (not= v (tget self :autocommit)) + (if v + (when-not (tget self :closed) (exec! self "COMMIT")) + (exec! self "BEGIN")) + (tput! self :autocommit v)) + nil)) + "getAutoCommit" (fn [self] (tget self :autocommit)) + + "commit" (fn [self] + (exec! self "COMMIT") + (when-not (tget self :autocommit) (exec! self "BEGIN")) + nil) + "rollback" (fn [self & [sp]] + (if sp + (exec! self (str "ROLLBACK TO SAVEPOINT " (tget sp :name))) + (do (exec! self "ROLLBACK") + (when-not (tget self :autocommit) (exec! self "BEGIN")))) + nil) + + "setSavepoint" (fn [self & [nm]] + (let [n (count (tget self :savepoints)) + name (or nm (str "jdbc_sp_" n)) + sp (tt :jdbc/savepoint)] + (tput! sp :name name) + (tput! self :savepoints (conj (tget self :savepoints) name)) + (exec! self (str "SAVEPOINT " name)) + sp)) + "releaseSavepoint" (fn [self sp] + (exec! self (str "RELEASE SAVEPOINT " (tget sp :name))) + nil) + + "setReadOnly" (fn [self v] (tput! self :readonly (boolean v)) nil) + "isReadOnly" (fn [self] (tget self :readonly)) + "setTransactionIsolation" (fn [self v] (tput! self :isolation v) nil) + "getTransactionIsolation" (fn [self] (tget self :isolation)) + "setSchema" (fn [self s] + (when (and s (= :postgresql (vendor self))) + (exec! self (str "SET search_path TO " s))) + nil) + + "getMetaData" (fn [self] (make-dbmeta self)) + "isClosed" (fn [self] (tget self :closed)) + "close" (fn [self] + (when-not (tget self :closed) + ((tget self :close-fn)) + (tput! self :closed true)) + nil)}) + +(clojure.core/__register-class-methods! :jdbc/savepoint + {"getSavepointName" (fn [self] (tget self :name))}) + +;; --- instance? / catch ------------------------------------------------------- +;; clojure.jdbc dispatches protocols on these classes and uses with-open, so the +;; shim values have to answer instance? for them. +(def ^:private class-tags + {"java.sql.Connection" :jdbc/connection + "java.sql.PreparedStatement" :jdbc/prepared + "java.sql.Statement" :jdbc/statement + "java.sql.ResultSet" :jdbc/resultset + "java.sql.ResultSetMetaData" :jdbc/rsmeta + "java.sql.DatabaseMetaData" :jdbc/dbmeta + "java.sql.Savepoint" :jdbc/savepoint}) + +(clojure.core/__register-instance-check! + (fn [cn val] + (when-let [tag (get class-tags cn)] + ;; a PreparedStatement is a Statement too + (boolean (or (tagged? val tag) + (and (= cn "java.sql.Statement") (tagged? val :jdbc/prepared))))))) + +;; Report the java.sql class name for (class x) and, more importantly, so a +;; protocol extended to java.sql.Connection dispatches on these values. +;; clojure.jdbc extends IConnection to java.sql.Connection returning `this`, and +;; without this that arm never fires. +(def ^:private tag->class + (into {} (map (fn [[c t]] [t c]) class-tags))) + +(clojure.core/__register-class! + (fn [x] (and (table? x) (contains? tag->class (tget x :jolt/type)))) + (fn [x] (get tag->class (tget x :jolt/type))) + (fn [x] (let [c (get tag->class (tget x :jolt/type))] + (if (= c "java.sql.PreparedStatement") + ["java.sql.PreparedStatement" "java.sql.Statement"] + [c])))) + +;; --- connection construction ------------------------------------------------- +(defn- sqlite-connection [name] + (let [h (sqlite/open name)] + (sqlite/query-raw h "PRAGMA foreign_keys=1;" []) + (make-connection :sqlite h (fn [] (sqlite/close h))))) + +(defn- pg-connection [uri] + (require '[db.pg]) + (let [h ((pgfn "connect") uri)] + (make-connection :postgresql h (fn [] ((pgfn "close") h))))) + +(defn- pg-uri [{:keys [subname host port user password dbname] :as spec}] + (let [;; subname is JDBC's //host:port/db + sn (or subname "") + sn (if (str/starts-with? sn "//") (subs sn 2) sn) + [hostport db] (let [i (str/index-of sn "/")] + (if i [(subs sn 0 i) (subs sn (inc i))] ["" sn])) + [db qs] (let [i (str/index-of (or db "") "?")] + (if i [(subs db 0 i) (subs db (inc i))] [db nil])) + params (when qs + (into {} (map (fn [kv] + (let [[k v] (str/split kv #"=" 2)] [k v])) + (str/split qs #"&")))) + user (or user (get params "user")) + password (or password (get params "password"))] + (str "postgres://" + (when user (str user (when password (str ":" password)) "@")) + (if (str/blank? hostport) (str (or host "127.0.0.1") + (when port (str ":" port))) + hostport) + "/" (or (when-not (str/blank? db) db) dbname (:name spec))))) + +(defn connection + "Open a java.sql.Connection shim for a clojure.jdbc dbspec. Recognises the + classic :subprotocol/:subname form, the pretty :vendor/:name form, and a uri + string; anything else is not a spec this library can serve." + [spec] + (cond + (tagged? spec :jdbc/connection) spec + + (string? spec) + (let [s spec] + (cond + (str/starts-with? s "postgres") (pg-connection s) + (str/starts-with? s "sqlite:") (sqlite-connection (subs s 7)) + :else (sqlite-connection s))) + + (map? spec) + (let [v (or (:subprotocol spec) (:vendor spec)) + v (str/lower-case (str v))] + (cond + (contains? #{"postgresql" "postgres" "pgsql"} v) (pg-connection (pg-uri spec)) + (contains? #{"sqlite" "sqlite3"} v) + (sqlite-connection (let [n (or (:subname spec) (:name spec))] + (if (str/starts-with? (str n) "//") (subs (str n) 2) (str n)))) + :else (sql-error (str "unsupported vendor for this driver: " v)))) + + :else (sql-error (str "invalid dbspec: " (pr-str spec))))) diff --git a/clj/db/pg.clj b/clj/db/pg.clj index 26d53a3..a175388 100644 --- a/clj/db/pg.clj +++ b/clj/db/pg.clj @@ -3,7 +3,8 @@ the surface jdbc.core needs: connect / close / exec / all (rows as keyword-keyed maps, numeric columns coerced to jolt numbers). Loaded lazily by jdbc.core, so a sqlite-only app never needs libpq present." - (:require [jolt.ffi :as ffi])) + (:require [jolt.ffi :as ffi] + [clojure.string :as str])) ;; libpq is declared in deps.edn (:jolt/native, :optional) and loaded by jolt at ;; startup when present; jdbc.core only requires this namespace for a postgres @@ -89,6 +90,128 @@ (hex->bytes src 2) (escape->bytes src)))) +;;; ? -> $N rewriting +;; +;; Which ? counts as a placeholder decides which parameter lands where, so a ? +;; that only looks like one has to be skipped without consuming a number. That +;; means recognising the constructs a ? can hide in: string literals, quoted +;; identifiers, line and block comments, dollar-quoted bodies, and E'' escape +;; strings. Each is skipped whole by the scanner below. + +(defn- at + "The character at `i`, or nil past the end, so callers can compare without + bounds-checking first." + [sql len i] + (when (< i len) (nth sql i))) + +(defn- digit? [c] (let [x (int c)] (and (>= x 48) (<= x 57)))) + +(defn- ident-char? [c] + (let [x (int c)] + (or (and (>= x 97) (<= x 122)) ; a-z + (and (>= x 65) (<= x 90)) ; A-Z + (and (>= x 48) (<= x 57)) ; 0-9 + (= x 95) ; _ + (> x 127)))) ; postgres allows non-ascii here + +(defn- token-start? + "True when `i` begins a token rather than continuing an identifier. Postgres + allows $ inside an identifier after the first character, so a$b$c is one name + and not a dollar quote opening, and E only introduces an escape string when it + stands alone rather than ending a word like date'2020-01-01'. Its own lexer + draws the line in the same place." + [sql i] + (or (zero? i) + (let [p (nth sql (dec i))] + (not (or (ident-char? p) (= p \$)))))) + +(defn- skip-quoted + "Index just past the run of quote character `q` opening at `i`. A doubled quote + is an escaped one; `escapes?` additionally honours backslash escapes, which is + what distinguishes E'...' from a plain literal. An unterminated run ends at the + end of the statement rather than throwing." + [sql len i q escapes?] + (loop [j (inc i)] + (cond + (>= j len) len + (and escapes? (= (nth sql j) \\)) (recur (+ j 2)) + (not= (nth sql j) q) (recur (inc j)) + (= (at sql len (inc j)) q) (recur (+ j 2)) + :else (inc j)))) + +(defn- skip-line-comment [sql len i] + (loop [j (+ i 2)] + (cond (>= j len) len + (= (nth sql j) \newline) j + :else (recur (inc j))))) + +(defn- skip-block-comment + "Index just past the /* */ comment opening at `i`. Postgres nests these, so + track depth rather than stopping at the first */." + [sql len i] + (loop [j (+ i 2) depth 1] + (cond + (>= j len) len + (and (= (nth sql j) \/) (= (at sql len (inc j)) \*)) (recur (+ j 2) (inc depth)) + (and (= (nth sql j) \*) (= (at sql len (inc j)) \/)) (if (= depth 1) + (+ j 2) + (recur (+ j 2) (dec depth))) + :else (recur (inc j) depth)))) + +(defn- dollar-tag-len + "Length of the $tag$ that opens at `i`, or nil when this $ does not open a + dollar quote. The tag follows unquoted-identifier rules, so it cannot start + with a digit, which is what keeps a positional $1 from being read as one." + [sql len i] + (loop [j (inc i)] + (let [c (at sql len j)] + (cond + (nil? c) nil + (= c \$) (- (inc j) i) + (and (= j (inc i)) (digit? c)) nil + (ident-char? c) (recur (inc j)) + :else nil)))) + +(defn- skip-dollar-quoted [sql len i taglen] + (let [tag (subs sql i (+ i taglen))] + (if-let [close (str/index-of sql tag (+ i taglen))] + (+ close taglen) + len))) + +(defn pg-placeholders + "JDBC ? placeholders -> postgres $1..$N. A ? inside a string literal, quoted + identifier, comment, dollar-quoted body or escape string is left as it is and + does not consume a number. Collects the pieces and joins them once, so the cost + is linear in the length of the statement." + [sql] + (let [len (count sql)] + (loop [i 0 from 0 pnum 1 pieces (transient [])] + (if (>= i len) + (str/join (persistent! (conj! pieces (subs sql from len)))) + (let [c (nth sql i) + nxt (at sql len (inc i))] + (cond + (= c \?) + (recur (inc i) (inc i) (inc pnum) + (conj! (conj! pieces (subs sql from i)) (str "$" pnum))) + + (= c \') (recur (skip-quoted sql len i \' false) from pnum pieces) + (= c \") (recur (skip-quoted sql len i \" false) from pnum pieces) + + ;; E'...' / e'...', where a backslash escapes the next character + (and (or (= c \E) (= c \e)) (= nxt \') (token-start? sql i)) + (recur (skip-quoted sql len (inc i) \' true) from pnum pieces) + + (and (= c \-) (= nxt \-)) (recur (skip-line-comment sql len i) from pnum pieces) + (and (= c \/) (= nxt \*)) (recur (skip-block-comment sql len i) from pnum pieces) + + (= c \$) + (if-let [taglen (and (token-start? sql i) (dollar-tag-len sql len i))] + (recur (skip-dollar-quoted sql len i taglen) from pnum pieces) + (recur (inc i) from pnum pieces)) + + :else (recur (inc i) from pnum pieces))))))) + ;; --- parameters -------------------------------------------------------------- ;; PQexecParams takes four parallel per-parameter arrays: types (Oids), values, ;; lengths, and formats. Everything goes over as text with its type left for @@ -144,7 +267,9 @@ (defn- run [conn sql params] (let [[types values lengths formats owned] (param-arrays params) - res (PQexecParams conn sql (count params) types values lengths formats 0)] + ;; callers write JDBC ? placeholders; postgres wants $1..$N + res (PQexecParams conn (pg-placeholders sql) (count params) + types values lengths formats 0)] (doseq [p owned] (ffi/free p)) (let [st (PQresultStatus res)] (when-not (or (= st PGRES-COMMAND-OK) (= st PGRES-TUPLES-OK)) @@ -170,16 +295,26 @@ (= bytea-oid oid) (bytea->bytes s) :else s)) -(defn all [conn sql params] +(defn all-raw + "Run `sql` and return {:labels [col-name ...] :rows [[v ...]]}, keeping column + order for a caller that reads a row by index. `all` is this with the rows turned + into maps." + [conn sql params] (let [res (run conn sql params) nrows (PQntuples res) ncols (PQnfields res) - cols (mapv (fn [c] [(keyword (PQfname res c)) (PQftype res c)]) (range ncols)) + labels (mapv (fn [c] (PQfname res c)) (range ncols)) + oids (mapv (fn [c] (PQftype res c)) (range ncols)) rows (mapv (fn [r] - (reduce (fn [m c] - (let [[k oid] (nth cols c)] - (assoc m k (if (zero? (PQgetisnull res r c)) (coerce oid (PQgetvalue res r c)) nil)))) - {} (range ncols))) + (mapv (fn [c] + (when (zero? (PQgetisnull res r c)) + (coerce (nth oids c) (PQgetvalue res r c)))) + (range ncols))) (range nrows))] (PQclear res) - rows)) + {:labels labels :rows rows})) + +(defn all [conn sql params] + (let [{:keys [labels rows]} (all-raw conn sql params) + ks (mapv keyword labels)] + (mapv (fn [vs] (zipmap ks vs)) rows))) diff --git a/clj/db/sqlite.clj b/clj/db/sqlite.clj index a37f82c..e4b125e 100644 --- a/clj/db/sqlite.clj +++ b/clj/db/sqlite.clj @@ -74,24 +74,24 @@ :else (sqlite3-bind-text stmt i (str v) -1 SQLITE-TRANSIENT))) (recur (inc i) (next ps))))) -(defn- read-row [stmt n] - (loop [i 0 m {}] - (if (= i n) - m - (let [k (keyword (sqlite3-column-name stmt i)) - ty (sqlite3-column-type stmt i) - v (cond - (= ty TY-INT) (sqlite3-column-int64 stmt i) - (= ty TY-FLOAT) (sqlite3-column-double stmt i) - (= ty TY-BLOB) (let [n (sqlite3-column-bytes stmt i)] - (ffi/read-array (sqlite3-column-blob stmt i) n)) - (= ty TY-NULL) nil - :else (sqlite3-column-text stmt i))] - (recur (inc i) (assoc m k v)))))) +(defn- read-value [stmt i] + (let [ty (sqlite3-column-type stmt i)] + (cond + (= ty TY-INT) (sqlite3-column-int64 stmt i) + (= ty TY-FLOAT) (sqlite3-column-double stmt i) + (= ty TY-BLOB) (let [n (sqlite3-column-bytes stmt i)] + (ffi/read-array (sqlite3-column-blob stmt i) n)) + (= ty TY-NULL) nil + :else (sqlite3-column-text stmt i)))) -(defn query - "Run `sql` with `params` (a seq); return a vector of keyword-keyed row maps - (empty for a non-SELECT)." +(defn- read-values [stmt n] + (loop [i 0 acc (transient [])] + (if (= i n) (persistent! acc) (recur (inc i) (conj! acc (read-value stmt i)))))) + +(defn query-raw + "Run `sql` with `params` (a seq); return {:labels [col-name ...] :rows [[v ...]]}. + Column order is preserved, which a JDBC-shaped caller needs to read a row by + index. `query` is this with the rows turned into maps." [db sql params] (let [pp (ffi/alloc (ffi/sizeof :pointer)) rc (sqlite3-prepare db sql -1 pp ffi/null) @@ -101,16 +101,26 @@ (throw (ex-info (str "sqlite prepare failed: " (sqlite3-errmsg db) " — " sql) {:jdbc/sql-error true}))) (bind-params! stmt params) - (let [ncol (sqlite3-column-count stmt)] + (let [ncol (sqlite3-column-count stmt) + labels (mapv (fn [i] (sqlite3-column-name stmt i)) (range ncol))] (loop [rows (transient [])] (let [r (sqlite3-step stmt)] (cond - (= r SQLITE-ROW) (recur (conj! rows (read-row stmt ncol))) - (= r SQLITE-DONE) (do (sqlite3-finalize stmt) (persistent! rows)) + (= r SQLITE-ROW) (recur (conj! rows (read-values stmt ncol))) + (= r SQLITE-DONE) (do (sqlite3-finalize stmt) + {:labels labels :rows (persistent! rows)}) :else (let [msg (sqlite3-errmsg db)] (sqlite3-finalize stmt) (throw (ex-info (str "sqlite step failed: " msg) {:rc r :jdbc/sql-error true}))))))))) +(defn query + "Run `sql` with `params` (a seq); return a vector of keyword-keyed row maps + (empty for a non-SELECT)." + [db sql params] + (let [{:keys [labels rows]} (query-raw db sql params) + ks (mapv keyword labels)] + (mapv (fn [vs] (zipmap ks vs)) rows))) + (defn changes [db] (sqlite3-changes db)) (defn last-insert-rowid [db] (sqlite3-last-rowid db)) diff --git a/clj/jdbc/core.clj b/clj/jdbc/core.clj index 7869b12..f811c3d 100644 --- a/clj/jdbc/core.clj +++ b/clj/jdbc/core.clj @@ -87,128 +87,6 @@ (vector? q) [(first q) (vec (rest q))] :else (throw (ex-info "query must be a string or sqlvec" {:q q})))) -;;; ? -> $N rewriting -;; -;; Which ? counts as a placeholder decides which parameter lands where, so a ? -;; that only looks like one has to be skipped without consuming a number. That -;; means recognising the constructs a ? can hide in: string literals, quoted -;; identifiers, line and block comments, dollar-quoted bodies, and E'' escape -;; strings. Each is skipped whole by the scanner below. - -(defn- at - "The character at `i`, or nil past the end, so callers can compare without - bounds-checking first." - [sql len i] - (when (< i len) (nth sql i))) - -(defn- digit? [c] (let [x (int c)] (and (>= x 48) (<= x 57)))) - -(defn- ident-char? [c] - (let [x (int c)] - (or (and (>= x 97) (<= x 122)) ; a-z - (and (>= x 65) (<= x 90)) ; A-Z - (and (>= x 48) (<= x 57)) ; 0-9 - (= x 95) ; _ - (> x 127)))) ; postgres allows non-ascii here - -(defn- token-start? - "True when `i` begins a token rather than continuing an identifier. Postgres - allows $ inside an identifier after the first character, so a$b$c is one name - and not a dollar quote opening, and E only introduces an escape string when it - stands alone rather than ending a word like date'2020-01-01'. Its own lexer - draws the line in the same place." - [sql i] - (or (zero? i) - (let [p (nth sql (dec i))] - (not (or (ident-char? p) (= p \$)))))) - -(defn- skip-quoted - "Index just past the run of quote character `q` opening at `i`. A doubled quote - is an escaped one; `escapes?` additionally honours backslash escapes, which is - what distinguishes E'...' from a plain literal. An unterminated run ends at the - end of the statement rather than throwing." - [sql len i q escapes?] - (loop [j (inc i)] - (cond - (>= j len) len - (and escapes? (= (nth sql j) \\)) (recur (+ j 2)) - (not= (nth sql j) q) (recur (inc j)) - (= (at sql len (inc j)) q) (recur (+ j 2)) - :else (inc j)))) - -(defn- skip-line-comment [sql len i] - (loop [j (+ i 2)] - (cond (>= j len) len - (= (nth sql j) \newline) j - :else (recur (inc j))))) - -(defn- skip-block-comment - "Index just past the /* */ comment opening at `i`. Postgres nests these, so - track depth rather than stopping at the first */." - [sql len i] - (loop [j (+ i 2) depth 1] - (cond - (>= j len) len - (and (= (nth sql j) \/) (= (at sql len (inc j)) \*)) (recur (+ j 2) (inc depth)) - (and (= (nth sql j) \*) (= (at sql len (inc j)) \/)) (if (= depth 1) - (+ j 2) - (recur (+ j 2) (dec depth))) - :else (recur (inc j) depth)))) - -(defn- dollar-tag-len - "Length of the $tag$ that opens at `i`, or nil when this $ does not open a - dollar quote. The tag follows unquoted-identifier rules, so it cannot start - with a digit, which is what keeps a positional $1 from being read as one." - [sql len i] - (loop [j (inc i)] - (let [c (at sql len j)] - (cond - (nil? c) nil - (= c \$) (- (inc j) i) - (and (= j (inc i)) (digit? c)) nil - (ident-char? c) (recur (inc j)) - :else nil)))) - -(defn- skip-dollar-quoted [sql len i taglen] - (let [tag (subs sql i (+ i taglen))] - (if-let [close (str/index-of sql tag (+ i taglen))] - (+ close taglen) - len))) - -(defn- pg-placeholders - "JDBC ? placeholders -> postgres $1..$N. A ? inside a string literal, quoted - identifier, comment, dollar-quoted body or escape string is left as it is and - does not consume a number. Collects the pieces and joins them once, so the cost - is linear in the length of the statement." - [sql] - (let [len (count sql)] - (loop [i 0 from 0 pnum 1 pieces (transient [])] - (if (>= i len) - (str/join (persistent! (conj! pieces (subs sql from len)))) - (let [c (nth sql i) - nxt (at sql len (inc i))] - (cond - (= c \?) - (recur (inc i) (inc i) (inc pnum) - (conj! (conj! pieces (subs sql from i)) (str "$" pnum))) - - (= c \') (recur (skip-quoted sql len i \' false) from pnum pieces) - (= c \") (recur (skip-quoted sql len i \" false) from pnum pieces) - - ;; E'...' / e'...', where a backslash escapes the next character - (and (or (= c \E) (= c \e)) (= nxt \') (token-start? sql i)) - (recur (skip-quoted sql len (inc i) \' true) from pnum pieces) - - (and (= c \-) (= nxt \-)) (recur (skip-line-comment sql len i) from pnum pieces) - (and (= c \/) (= nxt \*)) (recur (skip-block-comment sql len i) from pnum pieces) - - (= c \$) - (if-let [taglen (and (token-start? sql i) (dollar-tag-len sql len i))] - (recur (skip-dollar-quoted sql len i taglen) from pnum pieces) - (recur (inc i) from pnum pieces)) - - :else (recur (inc i) from pnum pieces))))))) - (defn- sqlite-eval [conn sql params] (sqlite/query (:handle conn) sql params)) @@ -217,7 +95,7 @@ (defn- pgfn [n] (deref (resolve (symbol "db.pg" n)))) (defn- pg-eval [conn sql params] - ((pgfn "exec") (:handle conn) (pg-placeholders sql) params)) + ((pgfn "exec") (:handle conn) sql params)) (defn fetch "Run a query (string or sqlvec), return a vector of keyword-keyed row maps." @@ -226,7 +104,7 @@ (let [[sql params] (sqlvec q) rows (case (:vendor conn) :sqlite (sqlite-eval conn sql params) - :postgresql ((pgfn "all") (:handle conn) (pg-placeholders sql) params))] + :postgresql ((pgfn "all") (:handle conn) sql params))] (if-let [n (:max-rows opts)] (vec (take n rows)) rows)))) (defn fetch-one