-
-
Notifications
You must be signed in to change notification settings - Fork 97
/
sql.clj
125 lines (110 loc) · 4.21 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
(ns migratus.migration.sql
(:require
[clojure.java.jdbc :as sql]
[clojure.string :as str]
[clojure.tools.logging :as log]
[migratus.protocols :as proto])
(:import
java.sql.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 execute-command [config t-con tx? expect-results? commands]
(log/trace "executing" commands)
(cond->
(try
(sql/db-do-commands t-con tx? (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 tx? expect-results? commands direction]
(log/debug "found" (count commands) (name direction) "migrations")
(doseq [c commands]
(execute-command config conn tx? 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)
(sql/with-db-transaction
[t-con (or conn db)]
(run-sql* config t-con true expect-results? commands direction))
(sql/with-db-connection
[t-con (or conn db)]
(run-sql* config t-con false 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)]))