From 0db8b05ea92e64291b38ecc5a3b1e76afd7320bf Mon Sep 17 00:00:00 2001 From: Yogthos Date: Tue, 11 Aug 2026 14:44:41 -0400 Subject: [PATCH 1/3] Register the java.sql constants clojure.jdbc compiles against First step towards running the real clojure.jdbc on jolt instead of reimplementing its API here. jdbc.constants maps clojure.jdbc's keyword options onto java.sql static fields, and those were the only thing stopping its namespaces from compiling: with ResultSet, Connection and Statement registered through __register-class-statics!, every clojure.jdbc namespace loads under jolt and jdbc.core/prepared-statement resolves from the dependency. The values match the JVM's, since callers pass these through. :serializable has to reach setTransactionIsolation as 8 either way. Nothing requires this namespace yet, so it is inert and the existing suite is unaffected. Wiring it to db.sqlite and db.pg, and routing connection creation away from DriverManager, comes next. --- clj/db/jdbc_shim.clj | 47 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) create mode 100644 clj/db/jdbc_shim.clj diff --git a/clj/db/jdbc_shim.clj b/clj/db/jdbc_shim.clj new file mode 100644 index 0000000..f35e063 --- /dev/null +++ b/clj/db/jdbc_shim.clj @@ -0,0 +1,47 @@ +(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-ctor! / __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 these classes when they + compile, so this namespace has to be loaded 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!.") + +;; --- 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}) From f3dc6c4454d78a7317e4d6ce69375694c57d336a Mon Sep 17 00:00:00 2001 From: Yogthos Date: Tue, 11 Aug 2026 14:53:05 -0400 Subject: [PATCH 2/3] Give the drivers ordered row access, and move ? rewriting into db.pg Groundwork for the java.sql shim, kept separate so it can be reviewed on its own. A JDBC ResultSet is read by column index, and ResultSetMetaData reports labels by index, but both drivers returned keyword-keyed maps with column order already lost. query-raw and all-raw now return {:labels [...] :rows [[v ...]]} and query and all build their maps from that, so the map-shaped API is unchanged while an indexed reader has something to work with. The ? to $N rewriter also moves from jdbc.core into db.pg, which is where it belongs: it is a postgres concern, and db.pg/run now applies it so every caller gets it rather than each one remembering to. That also keeps it available once jdbc.core goes away, since the shim needs it. Its lexer table moved with it and still runs in the sqlite-only build, which is why the test namespace now requires db.pg directly. Loading db.pg has never needed libpq present, only calling it does. --- clj-test/jdbc/core_test.clj | 8 +- clj/db/pg.clj | 153 +++++++++++++++++++++++++++++++++--- clj/db/sqlite.clj | 50 +++++++----- clj/jdbc/core.clj | 126 +---------------------------- 4 files changed, 182 insertions(+), 155 deletions(-) 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/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 From 7d08259682021fd6d796dd07b91739f80dfabe0e Mon Sep 17 00:00:00 2001 From: Yogthos Date: Tue, 11 Aug 2026 14:57:20 -0400 Subject: [PATCH 3/3] Add the java.sql shim clojure.jdbc runs on The object surface clojure.jdbc drives, over db.sqlite and db.pg: Connection, Statement, PreparedStatement, ResultSet, ResultSetMetaData, DatabaseMetaData and Savepoint, as host tagged-tables with their methods registered through __register-class-methods!. __register-class! reports the java.sql class names so that clojure.jdbc's protocols, which are extended to java.sql.Connection and friends, dispatch on these values at all, and __register-instance-check! answers instance? for them. db.jdbc is the entry point. It fixes load order, since clojure.jdbc resolves the java.sql constants when its namespaces compile, and then re-extends IConnection so a dbspec builds a connection over the native drivers instead of reaching for DriverManager, which has nothing to load here. Extending after jdbc.impl is what makes ours win. Two things worth naming. Generated keys are RETURNING underneath, because neither driver has a JDBC generated-keys channel: :all or true asks for the whole row, which is what postgres' own driver gives, and a sequence of names asks for those columns. An empty ResultSet when nothing was requested is deliberate, since that is what makes insert! fall back to the update count the way it does on a driver without generated keys. And a ResultSet here is a cursor over rows the driver has already materialised, so a fetch that streams on the JVM is eager on this shim. Real clojure.jdbc already runs execute!, fetch and fetch-one on sqlite through this. Nothing in the repo requires it yet, so the existing suite is untouched. --- clj/db/jdbc.clj | 33 ++++ clj/db/jdbc_shim.clj | 394 ++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 423 insertions(+), 4 deletions(-) create mode 100644 clj/db/jdbc.clj 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 index f35e063..3562a03 100644 --- a/clj/db/jdbc_shim.clj +++ b/clj/db/jdbc_shim.clj @@ -2,16 +2,20 @@ "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-ctor! / __register-class-methods! / + (__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 these classes when they - compile, so this namespace has to be loaded before jdbc.core. Requiring db.jdbc + 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!.") + 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 @@ -45,3 +49,385 @@ "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)))))