-
-
Notifications
You must be signed in to change notification settings - Fork 97
/
sql.clj
138 lines (122 loc) · 4.88 KB
/
sql.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
(ns migratus.migration.sql
(:require [next.jdbc :as jdbc]
[next.jdbc.prepare :as prepare]
[clojure.string :as str]
[clojure.tools.logging :as log]
[migratus.protocols :as proto])
(:import
(java.sql Connection
SQLException)
java.util.regex.Pattern))
(def ^Pattern sep (Pattern/compile "^.*--;;.*\r?\n" Pattern/MULTILINE))
(def ^Pattern sql-comment (Pattern/compile "^--.*" Pattern/MULTILINE))
(def ^Pattern sql-comment-without-expect (Pattern/compile "^--((?! *expect).)*$" Pattern/MULTILINE))
(def ^Pattern empty-line (Pattern/compile "^[ ]+" Pattern/MULTILINE))
(defn use-tx? [sql]
(not (str/starts-with? sql "-- :disable-transaction")))
(defn sanitize [command expect-results?]
(-> command
(clojure.string/replace (if expect-results? sql-comment-without-expect sql-comment) "")
(clojure.string/replace empty-line "")))
(defn split-commands [commands expect-results?]
(->> (.split sep commands)
(map #(sanitize % expect-results?))
(remove empty?)
(not-empty)))
(defn check-expectations [result c]
(let [[full-str expect-str command] (re-matches #"(?sm).*\s*-- expect (.*);;\n+(.*)" c)]
(assert expect-str (str "No expectation on command: " c))
(let [expected (some-> expect-str Long/parseLong)
actual (some-> result first)
different? (not= actual expected)
message (format "%s %d"
(some-> command (clojure.string/split #"\s+" 2) first clojure.string/upper-case)
actual)]
(if different?
(log/error message "Expected" expected)
(log/info message)))))
(defn wrap-modify-sql-fn [old-modify-fn]
(fn [sql]
(let [modify-fn (or old-modify-fn identity)
result (modify-fn sql)]
(if (string? result)
[result]
result))))
(defn parse-commands-sql [{:keys [command-separator]} commands]
(if command-separator
(->>
(str/split commands (re-pattern command-separator))
(map str/trim)
(remove empty?))
commands))
(defn do-commands
"Adapt db-do-commands to jdbc
https://cljdoc.org/d/com.github.seancorfield/next.jdbc/1.2.780/doc/migration-from-clojure-java-jdbc"
[connectable commands]
(if (instance? Connection connectable)
(with-open [stmt (prepare/statement connectable)]
;; We test for (string? commands) because migratus.test.migrations.sql tests fails otherwise.
;; Perhaps it is a bug in migratus.test.mock implementation ?!
(if (string? commands)
(run! #(.addBatch stmt %) [commands])
(run! #(.addBatch stmt %) commands))
(into [] (.executeBatch stmt)))
(with-open [conn (jdbc/get-connection connectable)]
(do-commands conn commands))))
(defn execute-command [config t-con expect-results? commands]
(log/trace "executing" commands)
(cond->
(try
(do-commands t-con (parse-commands-sql config commands))
(catch SQLException e
(log/error (format "failed to execute command:\n %s" commands))
(loop [e e]
(if-let [next-e (.getNextException e)]
(recur next-e)
(log/error (.getMessage e))))
(throw e))
(catch Throwable t
(log/error (format "failed to execute command:\n %s\nFailure: %s" commands (.getMessage t)))
(throw t)))
expect-results? (check-expectations commands)))
(defn- run-sql*
[config conn expect-results? commands direction]
(log/debug "found" (count commands) (name direction) "migrations")
(doseq [c commands]
(execute-command config conn expect-results? c)))
(defn run-sql
[{:keys [conn db modify-sql-fn expect-results?] :as config} sql direction]
(when-let [commands (mapcat (wrap-modify-sql-fn modify-sql-fn) (split-commands sql expect-results?))]
(if (use-tx? sql)
(jdbc/with-transaction [t-con (or conn db)]
(run-sql* config t-con expect-results? commands direction))
(run-sql* config (or conn db) expect-results? commands direction))))
(defrecord SqlMigration [id name up down]
proto/Migration
(id [this]
id)
(name [this]
name)
(tx? [this direction]
(if-let [sql (get this direction)]
(use-tx? sql)
(throw (Exception. (format "SQL %s commands not found for %d" direction id)))))
(up [this config]
(if up
(run-sql config up :up)
(throw (Exception. (format "Up commands not found for %d" id)))))
(down [this config]
(if down
(run-sql config down :down)
(throw (Exception. (format "Down commands not found for %d" id))))))
(defmethod proto/make-migration* :sql
[_ mig-id mig-name payload config]
(->SqlMigration mig-id mig-name (:up payload) (:down payload)))
(defmethod proto/get-extension* :sql
[_]
"sql")
(defmethod proto/migration-files* :sql
[x migration-name]
(let [ext (proto/get-extension* x)]
[(str migration-name ".up." ext)
(str migration-name ".down." ext)]))