-
Notifications
You must be signed in to change notification settings - Fork 0
/
core.clj
168 lines (149 loc) · 6.8 KB
/
core.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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
;; Copyright (c) 2015-2024 Michael Schaeffer
;;
;; Licensed as below.
;;
;; Portions Copyright (c) 2014 KSM Technology Partners
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;; http://www.apache.org/licenses/LICENSE-2.0
;;
;; The license is also includes at the root of the project in the file
;; LICENSE.
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.
;;
;; You must not remove this notice, or any other, from this software.
(ns sql-file.core
(:use sql-file.sql-util)
(:require [clojure.tools.logging :as log]
[clojure.java.jdbc :as jdbc]
[sql-file.script :as script]
[hikari-cp.core :as hikari-cp]))
(defn- schema-path [ conn ]
(conj (get conn :schema-path []) ""))
(defn- locate-schema-script [ conn schema-name schema-version ]
"Locate the schema script to install the given schema name and
version. If there is no such script, throws an exception."
(let [basename (format "schema-%s-%s.sql" schema-name schema-version)]
(or (some identity
(map #(clojure.java.io/resource (format "%s%s" % basename))
(schema-path conn)))
(throw (Exception. (str "Cannot find schema script: " basename " in search path " (schema-path conn)))))))
(defn do-statements [ conn stmts ]
"Execute a sequence of statements against the given DB connection."
(jdbc/with-db-connection [ cdb conn ]
(doseq [ stmt stmts ]
(log/debug "Executing SQL:" (str (:url stmt) "(" (:line stmt) ":" (:column stmt) ")") (:statement stmt))
(try
(jdbc/db-do-prepared cdb (:statement stmt))
(catch Exception ex
(throw (Exception. (str "Error running statement: " stmt) ex)))))))
(defn- run-script [ conn script-url ]
"Run the database script at the given URL against a specific
database connection."
(log/info "Run DB script:" (str script-url))
(let [ script-text (slurp script-url) ]
(do-statements conn (map #(assoc % :url script-url)
(script/sql-statements script-text)))))
(defn get-schema-version [ conn schema-name ]
"Retrieves the current version of a schema within a database managed
by sql-file. If there is no such schema, this function returns nil. If
the version cannot be identified due to an exception an error message
is logged with the stack trace and the function returns nil."
(try
(query-scalar conn [(str "SELECT schema_version"
" FROM sql_file_schema"
" WHERE schema_name=?")
schema-name])
(catch Exception ex
(when (log/enabled? :debug)
(log/error ex "Error while attempting to identify version of schema:" schema-name))
nil)))
(defn set-schema-version! [ conn schema-name req-schema-version ]
"Sets the version of a schema within a database managed by
sql-file."
(if-let [ cur-schema-version (get-schema-version conn schema-name) ]
(when (not= cur-schema-version req-schema-version)
(jdbc/update! conn :sql_file_schema
{:schema_version req-schema-version}
["schema_name=?" schema-name]))
(jdbc/insert! conn :sql_file_schema
{:schema_name schema-name
:schema_version req-schema-version})))
(defn- install-schema [ conn schema ]
"Locate and run the script necessary to install the specified
schema in the target database instance."
(log/info "Installing schema:" schema)
(let [ [schema-name schema-version ] schema ]
(try
(run-script conn (locate-schema-script conn schema-name schema-version))
(catch Exception ex
(throw (Exception. (str "Error installing schema: " schema) ex))))
(set-schema-version! conn schema-name schema-version)))
;; Public Entry points
(defn hsqldb-conn [ desc ]
"Construct a connection map for an HSQLDB database with the given
filename and schema. A name with a \"mem:\" prefix may be used to
request a memory database."
(cond-> {:classname "org.hsqldb.jdbc.JDBCDriver"
:subprotocol "hsqldb"
:subname (:name desc)}
(:schema-path desc) (assoc :schema-path (:schema-path desc))))
(defn ensure-schema [ conn schema ]
"Locate and run the scripts necessary to install the specified
schema in the target database instance."
(log/debug "Ensuring schema:" schema)
(let [[req-schema-name req-schema-version] schema]
(loop []
(let [cur-schema-version (or (get-schema-version conn req-schema-name) -1)]
(if (= cur-schema-version req-schema-version)
(log/debug "Schema" schema "confirmed present.")
(do
(if (< cur-schema-version req-schema-version)
(install-schema conn [req-schema-name (+ cur-schema-version 1)])
(throw (Exception. (str "Cannot downgrade schema " req-schema-name " from version " cur-schema-version " to " req-schema-version))))
(recur)))))
conn))
(defn backup-to-file-blocking [ conn output-path ]
(jdbc/db-do-prepared conn (str "BACKUP DATABASE TO '" output-path "' BLOCKING")))
(defn backup-to-file-online [ conn output-path ]
(jdbc/db-do-prepared conn (str "BACKUP DATABASE TO '" output-path "' NOT BLOCKING")))
(defn start-sqltool-shell [ conn ]
(.flush *out*)
(doto (org.hsqldb.cmdline.SqlFile. *in* "stdin" System/out
"UTF-8" true
(java.net.URL. "file:."))
(.setConnection (:connection conn))
(.execute)))
(defn open-local [ desc ]
(log/info "Opening sql-file:" desc)
(let [conn (-> (hsqldb-conn desc)
(ensure-schema [ "sql-file" 0 ]))]
(doseq [ schema (get desc :schemas []) ]
(ensure-schema conn schema))
conn))
(defn open-pool [ desc ]
(log/info "Opening sql-file (pooled):" desc)
(let [conn (open-local desc)
datasource (hikari-cp/make-datasource (merge {:driver-class-name (:classname conn)
:jdbc-url (str "jdbc:hsqldb:" (:subname conn))
:maximum-pool-size (get desc :pool-size 4)}
(get desc :pool {})))]
(assoc conn :datasource datasource)))
(defn close-pool [ pool ]
(hikari-cp/close-datasource (:datasource pool)))
(defn call-with-pool [ f desc ]
(let [pool (open-pool desc)]
(try
(f pool)
(finally
(close-pool pool)))))
(defmacro with-pool [ [ var desc ] & body ]
`(call-with-pool (fn [ ~var ] ~@body) ~desc))