adam@1295
|
1 (* Copyright (c) 2008-2010, Adam Chlipala
|
adamc@866
|
2 * All rights reserved.
|
adamc@866
|
3 *
|
adamc@866
|
4 * Redistribution and use in source and binary forms, with or without
|
adamc@866
|
5 * modification, are permitted provided that the following conditions are met:
|
adamc@866
|
6 *
|
adamc@866
|
7 * - Redistributions of source code must retain the above copyright notice,
|
adamc@866
|
8 * this list of conditions and the following disclaimer.
|
adamc@866
|
9 * - Redistributions in binary form must reproduce the above copyright notice,
|
adamc@866
|
10 * this list of conditions and the following disclaimer in the documentation
|
adamc@866
|
11 * and/or other materials provided with the distribution.
|
adamc@866
|
12 * - The names of contributors may not be used to endorse or promote products
|
adamc@866
|
13 * derived from this software without specific prior written permission.
|
adamc@866
|
14 *
|
adamc@866
|
15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
adamc@866
|
16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
adamc@866
|
17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
adamc@866
|
18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
|
adamc@866
|
19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
adamc@866
|
20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
adamc@866
|
21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
adamc@866
|
22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
adamc@866
|
23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
adamc@866
|
24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
adamc@866
|
25 * POSSIBILITY OF SUCH DAMAGE.
|
adamc@866
|
26 *)
|
adamc@866
|
27
|
adamc@866
|
28 structure Postgres :> POSTGRES = struct
|
adamc@866
|
29
|
adamc@866
|
30 open Settings
|
adamc@866
|
31 open Print.PD
|
adamc@866
|
32 open Print
|
adamc@866
|
33
|
adamc@870
|
34 val ident = String.translate (fn #"'" => "PRIME"
|
adamc@870
|
35 | ch => str ch)
|
adamc@870
|
36
|
adamc@873
|
37 fun p_sql_type t =
|
adamc@873
|
38 case t of
|
adamc@873
|
39 Int => "int8"
|
adamc@873
|
40 | Float => "float8"
|
adamc@873
|
41 | String => "text"
|
adamc@1011
|
42 | Char => "char"
|
adamc@873
|
43 | Bool => "bool"
|
adamc@873
|
44 | Time => "timestamp"
|
adamc@873
|
45 | Blob => "bytea"
|
adamc@873
|
46 | Channel => "int8"
|
adamc@873
|
47 | Client => "int4"
|
adamc@873
|
48 | Nullable t => p_sql_type t
|
adamc@873
|
49
|
adamc@870
|
50 fun p_sql_type_base t =
|
adamc@870
|
51 case t of
|
adamc@871
|
52 Int => "bigint"
|
adamc@871
|
53 | Float => "double precision"
|
adamc@870
|
54 | String => "text"
|
adamc@1011
|
55 | Char => "character"
|
adamc@871
|
56 | Bool => "boolean"
|
adamc@871
|
57 | Time => "timestamp without time zone"
|
adamc@870
|
58 | Blob => "bytea"
|
adamc@871
|
59 | Channel => "bigint"
|
adamc@871
|
60 | Client => "integer"
|
adamc@870
|
61 | Nullable t => p_sql_type_base t
|
adamc@870
|
62
|
adamc@872
|
63 fun checkRel (table, checkNullable) (s, xts) =
|
adamc@871
|
64 let
|
adamc@871
|
65 val sl = CharVector.map Char.toLower s
|
adamc@871
|
66
|
adamc@872
|
67 val q = "SELECT COUNT(*) FROM information_schema." ^ table ^ " WHERE table_name = '"
|
adamc@871
|
68 ^ sl ^ "'"
|
adamc@871
|
69
|
adamc@871
|
70 val q' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE table_name = '",
|
adamc@871
|
71 sl,
|
adamc@871
|
72 "' AND (",
|
adamc@871
|
73 String.concatWith " OR "
|
adamc@871
|
74 (map (fn (x, t) =>
|
adamc@871
|
75 String.concat ["(column_name = 'uw_",
|
adamc@871
|
76 CharVector.map
|
adamc@871
|
77 Char.toLower (ident x),
|
adamc@871
|
78 "' AND data_type = '",
|
adamc@871
|
79 p_sql_type_base t,
|
adamc@872
|
80 "'",
|
adamc@872
|
81 if checkNullable then
|
adamc@872
|
82 (" AND is_nullable = '"
|
adamc@872
|
83 ^ (if isNotNull t then
|
adamc@872
|
84 "NO"
|
adamc@872
|
85 else
|
adamc@872
|
86 "YES")
|
adamc@872
|
87 ^ "'")
|
adamc@871
|
88 else
|
adamc@872
|
89 "",
|
adamc@872
|
90 ")"]) xts),
|
adamc@871
|
91 ")"]
|
adamc@871
|
92
|
adamc@871
|
93 val q'' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE table_name = '",
|
adamc@871
|
94 sl,
|
adamc@871
|
95 "' AND column_name LIKE 'uw_%'"]
|
adamc@871
|
96 in
|
adamc@871
|
97 box [string "res = PQexec(conn, \"",
|
adamc@871
|
98 string q,
|
adamc@871
|
99 string "\");",
|
adamc@871
|
100 newline,
|
adamc@871
|
101 newline,
|
adamc@871
|
102 string "if (res == NULL) {",
|
adamc@871
|
103 newline,
|
adamc@871
|
104 box [string "PQfinish(conn);",
|
adamc@871
|
105 newline,
|
adamc@871
|
106 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
|
adamc@871
|
107 newline],
|
adamc@871
|
108 string "}",
|
adamc@871
|
109 newline,
|
adamc@871
|
110 newline,
|
adamc@871
|
111 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
|
adamc@871
|
112 newline,
|
adamc@871
|
113 box [string "char msg[1024];",
|
adamc@871
|
114 newline,
|
adamc@871
|
115 string "strncpy(msg, PQerrorMessage(conn), 1024);",
|
adamc@871
|
116 newline,
|
adamc@871
|
117 string "msg[1023] = 0;",
|
adamc@871
|
118 newline,
|
adamc@871
|
119 string "PQclear(res);",
|
adamc@871
|
120 newline,
|
adamc@871
|
121 string "PQfinish(conn);",
|
adamc@871
|
122 newline,
|
adamc@871
|
123 string "uw_error(ctx, FATAL, \"Query failed:\\n",
|
adamc@871
|
124 string q,
|
adamc@871
|
125 string "\\n%s\", msg);",
|
adamc@871
|
126 newline],
|
adamc@871
|
127 string "}",
|
adamc@871
|
128 newline,
|
adamc@871
|
129 newline,
|
adamc@871
|
130 string "if (strcmp(PQgetvalue(res, 0, 0), \"1\")) {",
|
adamc@871
|
131 newline,
|
adamc@871
|
132 box [string "PQclear(res);",
|
adamc@871
|
133 newline,
|
adamc@871
|
134 string "PQfinish(conn);",
|
adamc@871
|
135 newline,
|
adamc@871
|
136 string "uw_error(ctx, FATAL, \"Table '",
|
adamc@871
|
137 string s,
|
adamc@871
|
138 string "' does not exist.\");",
|
adamc@871
|
139 newline],
|
adamc@871
|
140 string "}",
|
adamc@871
|
141 newline,
|
adamc@871
|
142 newline,
|
adamc@871
|
143 string "PQclear(res);",
|
adamc@871
|
144 newline,
|
adamc@871
|
145
|
adamc@871
|
146 string "res = PQexec(conn, \"",
|
adamc@871
|
147 string q',
|
adamc@871
|
148 string "\");",
|
adamc@871
|
149 newline,
|
adamc@871
|
150 newline,
|
adamc@871
|
151 string "if (res == NULL) {",
|
adamc@871
|
152 newline,
|
adamc@871
|
153 box [string "PQfinish(conn);",
|
adamc@871
|
154 newline,
|
adamc@871
|
155 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
|
adamc@871
|
156 newline],
|
adamc@871
|
157 string "}",
|
adamc@871
|
158 newline,
|
adamc@871
|
159 newline,
|
adamc@871
|
160 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
|
adamc@871
|
161 newline,
|
adamc@871
|
162 box [string "char msg[1024];",
|
adamc@871
|
163 newline,
|
adamc@871
|
164 string "strncpy(msg, PQerrorMessage(conn), 1024);",
|
adamc@871
|
165 newline,
|
adamc@871
|
166 string "msg[1023] = 0;",
|
adamc@871
|
167 newline,
|
adamc@871
|
168 string "PQclear(res);",
|
adamc@871
|
169 newline,
|
adamc@871
|
170 string "PQfinish(conn);",
|
adamc@871
|
171 newline,
|
adamc@871
|
172 string "uw_error(ctx, FATAL, \"Query failed:\\n",
|
adamc@871
|
173 string q',
|
adamc@871
|
174 string "\\n%s\", msg);",
|
adamc@871
|
175 newline],
|
adamc@871
|
176 string "}",
|
adamc@871
|
177 newline,
|
adamc@871
|
178 newline,
|
adamc@871
|
179 string "if (strcmp(PQgetvalue(res, 0, 0), \"",
|
adamc@871
|
180 string (Int.toString (length xts)),
|
adamc@871
|
181 string "\")) {",
|
adamc@871
|
182 newline,
|
adamc@871
|
183 box [string "PQclear(res);",
|
adamc@871
|
184 newline,
|
adamc@871
|
185 string "PQfinish(conn);",
|
adamc@871
|
186 newline,
|
adamc@871
|
187 string "uw_error(ctx, FATAL, \"Table '",
|
adamc@871
|
188 string s,
|
adamc@871
|
189 string "' has the wrong column types.\");",
|
adamc@871
|
190 newline],
|
adamc@871
|
191 string "}",
|
adamc@871
|
192 newline,
|
adamc@871
|
193 newline,
|
adamc@871
|
194 string "PQclear(res);",
|
adamc@871
|
195 newline,
|
adamc@871
|
196 newline,
|
adamc@871
|
197
|
adamc@871
|
198 string "res = PQexec(conn, \"",
|
adamc@871
|
199 string q'',
|
adamc@871
|
200 string "\");",
|
adamc@871
|
201 newline,
|
adamc@871
|
202 newline,
|
adamc@871
|
203 string "if (res == NULL) {",
|
adamc@871
|
204 newline,
|
adamc@871
|
205 box [string "PQfinish(conn);",
|
adamc@871
|
206 newline,
|
adamc@871
|
207 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
|
adamc@871
|
208 newline],
|
adamc@871
|
209 string "}",
|
adamc@871
|
210 newline,
|
adamc@871
|
211 newline,
|
adamc@871
|
212 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
|
adamc@871
|
213 newline,
|
adamc@871
|
214 box [string "char msg[1024];",
|
adamc@871
|
215 newline,
|
adamc@871
|
216 string "strncpy(msg, PQerrorMessage(conn), 1024);",
|
adamc@871
|
217 newline,
|
adamc@871
|
218 string "msg[1023] = 0;",
|
adamc@871
|
219 newline,
|
adamc@871
|
220 string "PQclear(res);",
|
adamc@871
|
221 newline,
|
adamc@871
|
222 string "PQfinish(conn);",
|
adamc@871
|
223 newline,
|
adamc@871
|
224 string "uw_error(ctx, FATAL, \"Query failed:\\n",
|
adamc@871
|
225 string q'',
|
adamc@871
|
226 string "\\n%s\", msg);",
|
adamc@871
|
227 newline],
|
adamc@871
|
228 string "}",
|
adamc@871
|
229 newline,
|
adamc@871
|
230 newline,
|
adamc@871
|
231 string "if (strcmp(PQgetvalue(res, 0, 0), \"",
|
adamc@871
|
232 string (Int.toString (length xts)),
|
adamc@871
|
233 string "\")) {",
|
adamc@871
|
234 newline,
|
adamc@871
|
235 box [string "PQclear(res);",
|
adamc@871
|
236 newline,
|
adamc@871
|
237 string "PQfinish(conn);",
|
adamc@871
|
238 newline,
|
adamc@871
|
239 string "uw_error(ctx, FATAL, \"Table '",
|
adamc@871
|
240 string s,
|
adamc@871
|
241 string "' has extra columns.\");",
|
adamc@871
|
242 newline],
|
adamc@871
|
243 string "}",
|
adamc@871
|
244 newline,
|
adamc@871
|
245 newline,
|
adamc@871
|
246 string "PQclear(res);",
|
adamc@871
|
247 newline]
|
adamc@871
|
248 end
|
adamc@871
|
249
|
adamc@872
|
250 fun init {dbstring, prepared = ss, tables, views, sequences} =
|
adamc@866
|
251 box [if #persistent (currentProtocol ()) then
|
adamc@1094
|
252 box [string "static void uw_db_validate(uw_context ctx) {",
|
adamc@870
|
253 newline,
|
adamc@870
|
254 string "PGconn *conn = uw_get_db(ctx);",
|
adamc@870
|
255 newline,
|
adamc@870
|
256 string "PGresult *res;",
|
adamc@870
|
257 newline,
|
adamc@870
|
258 newline,
|
adamc@872
|
259 p_list_sep newline (checkRel ("tables", true)) tables,
|
adamc@872
|
260 p_list_sep newline (checkRel ("views", false)) views,
|
adamc@870
|
261
|
adamc@870
|
262 p_list_sep newline
|
adamc@870
|
263 (fn s =>
|
adamc@870
|
264 let
|
adamc@870
|
265 val sl = CharVector.map Char.toLower s
|
adamc@870
|
266
|
adamc@870
|
267 val q = "SELECT COUNT(*) FROM pg_class WHERE relname = '"
|
adamc@870
|
268 ^ sl ^ "' AND relkind = 'S'"
|
adamc@870
|
269 in
|
adamc@870
|
270 box [string "res = PQexec(conn, \"",
|
adamc@870
|
271 string q,
|
adamc@870
|
272 string "\");",
|
adamc@870
|
273 newline,
|
adamc@870
|
274 newline,
|
adamc@870
|
275 string "if (res == NULL) {",
|
adamc@870
|
276 newline,
|
adamc@870
|
277 box [string "PQfinish(conn);",
|
adamc@870
|
278 newline,
|
adamc@870
|
279 string "uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
|
adamc@870
|
280 newline],
|
adamc@870
|
281 string "}",
|
adamc@870
|
282 newline,
|
adamc@870
|
283 newline,
|
adamc@870
|
284 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
|
adamc@870
|
285 newline,
|
adamc@870
|
286 box [string "char msg[1024];",
|
adamc@870
|
287 newline,
|
adamc@870
|
288 string "strncpy(msg, PQerrorMessage(conn), 1024);",
|
adamc@870
|
289 newline,
|
adamc@870
|
290 string "msg[1023] = 0;",
|
adamc@870
|
291 newline,
|
adamc@870
|
292 string "PQclear(res);",
|
adamc@870
|
293 newline,
|
adamc@870
|
294 string "PQfinish(conn);",
|
adamc@870
|
295 newline,
|
adamc@870
|
296 string "uw_error(ctx, FATAL, \"Query failed:\\n",
|
adamc@870
|
297 string q,
|
adamc@870
|
298 string "\\n%s\", msg);",
|
adamc@870
|
299 newline],
|
adamc@870
|
300 string "}",
|
adamc@870
|
301 newline,
|
adamc@870
|
302 newline,
|
adamc@870
|
303 string "if (strcmp(PQgetvalue(res, 0, 0), \"1\")) {",
|
adamc@870
|
304 newline,
|
adamc@870
|
305 box [string "PQclear(res);",
|
adamc@870
|
306 newline,
|
adamc@870
|
307 string "PQfinish(conn);",
|
adamc@870
|
308 newline,
|
adamc@870
|
309 string "uw_error(ctx, FATAL, \"Sequence '",
|
adamc@870
|
310 string s,
|
adamc@870
|
311 string "' does not exist.\");",
|
adamc@870
|
312 newline],
|
adamc@870
|
313 string "}",
|
adamc@870
|
314 newline,
|
adamc@870
|
315 newline,
|
adamc@870
|
316 string "PQclear(res);",
|
adamc@870
|
317 newline]
|
adamc@870
|
318 end) sequences,
|
adamc@870
|
319
|
adamc@870
|
320 string "}",
|
adamc@870
|
321
|
adamc@870
|
322 string "static void uw_db_prepare(uw_context ctx) {",
|
adamc@866
|
323 newline,
|
adamc@866
|
324 string "PGconn *conn = uw_get_db(ctx);",
|
adamc@866
|
325 newline,
|
adamc@866
|
326 string "PGresult *res;",
|
adamc@866
|
327 newline,
|
adamc@866
|
328 newline,
|
adamc@866
|
329
|
adamc@866
|
330 p_list_sepi newline (fn i => fn (s, n) =>
|
adamc@866
|
331 box [string "res = PQprepare(conn, \"uw",
|
adamc@866
|
332 string (Int.toString i),
|
adamc@866
|
333 string "\", \"",
|
adam@1285
|
334 string (String.toCString s),
|
adamc@866
|
335 string "\", ",
|
adamc@866
|
336 string (Int.toString n),
|
adamc@866
|
337 string ", NULL);",
|
adamc@866
|
338 newline,
|
adamc@866
|
339 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
|
adamc@866
|
340 newline,
|
adamc@866
|
341 box [string "char msg[1024];",
|
adamc@866
|
342 newline,
|
adamc@866
|
343 string "strncpy(msg, PQerrorMessage(conn), 1024);",
|
adamc@866
|
344 newline,
|
adamc@866
|
345 string "msg[1023] = 0;",
|
adamc@866
|
346 newline,
|
adamc@866
|
347 string "PQclear(res);",
|
adamc@866
|
348 newline,
|
adamc@866
|
349 string "PQfinish(conn);",
|
adamc@866
|
350 newline,
|
adamc@866
|
351 string "uw_error(ctx, FATAL, \"Unable to create prepared statement:\\n",
|
adam@1285
|
352 string (String.toCString s),
|
adamc@866
|
353 string "\\n%s\", msg);",
|
adamc@866
|
354 newline],
|
adamc@866
|
355 string "}",
|
adamc@866
|
356 newline,
|
adamc@866
|
357 string "PQclear(res);",
|
adamc@866
|
358 newline])
|
adamc@866
|
359 ss,
|
adamc@866
|
360
|
adamc@866
|
361 string "}",
|
adamc@866
|
362 newline,
|
adamc@866
|
363 newline]
|
adamc@866
|
364 else
|
adamc@870
|
365 box [string "static void uw_db_validate(uw_context ctx) { }",
|
adamc@870
|
366 newline,
|
adamc@870
|
367 string "static void uw_db_prepare(uw_context ctx) { }"],
|
adamc@870
|
368
|
adamc@1094
|
369 string "static void uw_client_init(void) {",
|
adamc@1094
|
370 newline,
|
adamc@1094
|
371 box [string "uw_sqlfmtInt = \"%lld::int8%n\";",
|
adamc@1094
|
372 newline,
|
adamc@1094
|
373 string "uw_sqlfmtFloat = \"%g::float8%n\";",
|
adamc@1094
|
374 newline,
|
adamc@1094
|
375 string "uw_Estrings = 1;",
|
adamc@1094
|
376 newline,
|
adamc@1094
|
377 string "uw_sqlsuffixString = \"::text\";",
|
adamc@1094
|
378 newline,
|
adamc@1094
|
379 string "uw_sqlsuffixChar = \"::char\";",
|
adamc@1094
|
380 newline,
|
adamc@1094
|
381 string "uw_sqlsuffixBlob = \"::bytea\";",
|
adamc@1094
|
382 newline,
|
adamc@1094
|
383 string "uw_sqlfmtUint4 = \"%u::int4%n\";",
|
adamc@1094
|
384 newline],
|
adamc@1094
|
385 string "}",
|
adamc@866
|
386 newline,
|
adamc@866
|
387 newline,
|
adamc@866
|
388
|
adamc@1094
|
389 string "static void uw_db_close(uw_context ctx) {",
|
adamc@1094
|
390 newline,
|
adamc@1094
|
391 string "PQfinish(uw_get_db(ctx));",
|
adamc@1094
|
392 newline,
|
adamc@1094
|
393 string "}",
|
adamc@1094
|
394 newline,
|
adamc@1094
|
395 newline,
|
adamc@1094
|
396
|
adamc@1094
|
397 string "static int uw_db_begin(uw_context ctx) {",
|
adamc@1094
|
398 newline,
|
adamc@1094
|
399 string "PGconn *conn = uw_get_db(ctx);",
|
adamc@1094
|
400 newline,
|
adamc@1094
|
401 string "PGresult *res = PQexec(conn, \"BEGIN ISOLATION LEVEL SERIALIZABLE\");",
|
adamc@1094
|
402 newline,
|
adamc@1094
|
403 newline,
|
adamc@1094
|
404 string "if (res == NULL) return 1;",
|
adamc@1094
|
405 newline,
|
adamc@1094
|
406 newline,
|
adamc@1094
|
407 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
|
adamc@1094
|
408 box [string "PQclear(res);",
|
adamc@1094
|
409 newline,
|
adamc@1094
|
410 string "return 1;",
|
adamc@1094
|
411 newline],
|
adamc@1094
|
412 string "}",
|
adamc@1094
|
413 newline,
|
adamc@1144
|
414 string "PQclear(res);",
|
adamc@1144
|
415 newline,
|
adamc@1094
|
416 string "return 0;",
|
adamc@1094
|
417 newline,
|
adamc@1094
|
418 string "}",
|
adamc@1094
|
419 newline,
|
adamc@1094
|
420 newline,
|
adamc@1094
|
421
|
adamc@1094
|
422 string "static int uw_db_commit(uw_context ctx) {",
|
adamc@1094
|
423 newline,
|
adamc@1094
|
424 string "PGconn *conn = uw_get_db(ctx);",
|
adamc@1094
|
425 newline,
|
adamc@1094
|
426 string "PGresult *res = PQexec(conn, \"COMMIT\");",
|
adamc@1094
|
427 newline,
|
adamc@1094
|
428 newline,
|
adamc@1094
|
429 string "if (res == NULL) return 1;",
|
adamc@1094
|
430 newline,
|
adamc@1094
|
431 newline,
|
adamc@1094
|
432 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
|
adamc@1094
|
433 box [string "PQclear(res);",
|
adamc@1094
|
434 newline,
|
adamc@1094
|
435 string "return 1;",
|
adamc@1094
|
436 newline],
|
adamc@1094
|
437 string "}",
|
adamc@1094
|
438 newline,
|
adamc@1144
|
439 string "PQclear(res);",
|
adamc@1144
|
440 newline,
|
adamc@1094
|
441 string "return 0;",
|
adamc@1094
|
442 newline,
|
adamc@1094
|
443 string "}",
|
adamc@1094
|
444 newline,
|
adamc@1094
|
445 newline,
|
adamc@1094
|
446
|
adamc@1094
|
447 string "static int uw_db_rollback(uw_context ctx) {",
|
adamc@1094
|
448 newline,
|
adamc@1094
|
449 string "PGconn *conn = uw_get_db(ctx);",
|
adamc@1094
|
450 newline,
|
adamc@1094
|
451 string "PGresult *res = PQexec(conn, \"ROLLBACK\");",
|
adamc@1094
|
452 newline,
|
adamc@1094
|
453 newline,
|
adamc@1094
|
454 string "if (res == NULL) return 1;",
|
adamc@1094
|
455 newline,
|
adamc@1094
|
456 newline,
|
adamc@1094
|
457 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
|
adamc@1094
|
458 box [string "PQclear(res);",
|
adamc@1094
|
459 newline,
|
adamc@1094
|
460 string "return 1;",
|
adamc@1094
|
461 newline],
|
adamc@1094
|
462 string "}",
|
adamc@1094
|
463 newline,
|
adamc@1144
|
464 string "PQclear(res);",
|
adamc@1144
|
465 newline,
|
adamc@1094
|
466 string "return 0;",
|
adamc@1094
|
467 newline,
|
adamc@1094
|
468 string "}",
|
adamc@1094
|
469
|
adamc@1094
|
470 newline,
|
adamc@1094
|
471 newline,
|
adamc@1094
|
472
|
adamc@1094
|
473 string "static void uw_db_init(uw_context ctx) {",
|
adamc@866
|
474 newline,
|
adamc@866
|
475 string "PGconn *conn = PQconnectdb(\"",
|
adam@1285
|
476 string (String.toCString dbstring),
|
adamc@866
|
477 string "\");",
|
adamc@866
|
478 newline,
|
adamc@866
|
479 string "if (conn == NULL) uw_error(ctx, FATAL, ",
|
adamc@866
|
480 string "\"libpq can't allocate a connection.\");",
|
adamc@866
|
481 newline,
|
adamc@866
|
482 string "if (PQstatus(conn) != CONNECTION_OK) {",
|
adamc@866
|
483 newline,
|
adamc@866
|
484 box [string "char msg[1024];",
|
adamc@866
|
485 newline,
|
adamc@866
|
486 string "strncpy(msg, PQerrorMessage(conn), 1024);",
|
adamc@866
|
487 newline,
|
adamc@866
|
488 string "msg[1023] = 0;",
|
adamc@866
|
489 newline,
|
adamc@866
|
490 string "PQfinish(conn);",
|
adamc@866
|
491 newline,
|
adamc@866
|
492 string "uw_error(ctx, BOUNDED_RETRY, ",
|
adamc@866
|
493 string "\"Connection to Postgres server failed: %s\", msg);"],
|
adamc@866
|
494 newline,
|
adamc@866
|
495 string "}",
|
adamc@866
|
496 newline,
|
adamc@866
|
497 string "uw_set_db(ctx, conn);",
|
adamc@866
|
498 newline,
|
adamc@866
|
499 string "uw_db_validate(ctx);",
|
adamc@866
|
500 newline,
|
adamc@866
|
501 string "uw_db_prepare(ctx);",
|
adamc@866
|
502 newline,
|
adamc@866
|
503 string "}"]
|
adamc@866
|
504
|
adamc@880
|
505 fun p_getcol {loc, wontLeakStrings, col = i, typ = t} =
|
adamc@867
|
506 let
|
adamc@867
|
507 fun p_unsql t e eLen =
|
adamc@867
|
508 case t of
|
adamc@867
|
509 Int => box [string "uw_Basis_stringToInt_error(ctx, ", e, string ")"]
|
adamc@867
|
510 | Float => box [string "uw_Basis_stringToFloat_error(ctx, ", e, string ")"]
|
adamc@867
|
511 | String =>
|
adamc@867
|
512 if wontLeakStrings then
|
adamc@867
|
513 e
|
adamc@867
|
514 else
|
adamc@867
|
515 box [string "uw_strdup(ctx, ", e, string ")"]
|
adamc@1011
|
516 | Char => box [e, string "[0]"]
|
adamc@867
|
517 | Bool => box [string "uw_Basis_stringToBool_error(ctx, ", e, string ")"]
|
adamc@939
|
518 | Time => box [string "uw_Basis_unsqlTime(ctx, ", e, string ")"]
|
adamc@867
|
519 | Blob => box [string "uw_Basis_stringToBlob_error(ctx, ",
|
adamc@867
|
520 e,
|
adamc@867
|
521 string ", ",
|
adamc@867
|
522 eLen,
|
adamc@867
|
523 string ")"]
|
adamc@867
|
524 | Channel => box [string "uw_Basis_stringToChannel_error(ctx, ", e, string ")"]
|
adamc@867
|
525 | Client => box [string "uw_Basis_stringToClient_error(ctx, ", e, string ")"]
|
adamc@867
|
526
|
adamc@867
|
527 | Nullable _ => raise Fail "Postgres: Recursive Nullable"
|
adamc@867
|
528
|
adamc@867
|
529 fun getter t =
|
adamc@867
|
530 case t of
|
adamc@867
|
531 Nullable t =>
|
adamc@867
|
532 box [string "(PQgetisnull(res, i, ",
|
adamc@867
|
533 string (Int.toString i),
|
adamc@867
|
534 string ") ? NULL : ",
|
adamc@867
|
535 case t of
|
adamc@867
|
536 String => getter t
|
adamc@867
|
537 | _ => box [string "({",
|
adamc@867
|
538 newline,
|
adamc@874
|
539 string (p_sql_ctype t),
|
adamc@867
|
540 space,
|
adamc@867
|
541 string "*tmp = uw_malloc(ctx, sizeof(",
|
adamc@874
|
542 string (p_sql_ctype t),
|
adamc@867
|
543 string "));",
|
adamc@867
|
544 newline,
|
adamc@867
|
545 string "*tmp = ",
|
adamc@867
|
546 getter t,
|
adamc@867
|
547 string ";",
|
adamc@867
|
548 newline,
|
adamc@867
|
549 string "tmp;",
|
adamc@867
|
550 newline,
|
adamc@867
|
551 string "})"],
|
adamc@867
|
552 string ")"]
|
adamc@867
|
553 | _ =>
|
adamc@867
|
554 box [string "(PQgetisnull(res, i, ",
|
adamc@867
|
555 string (Int.toString i),
|
adamc@867
|
556 string ") ? ",
|
adamc@867
|
557 box [string "({",
|
adamc@874
|
558 string (p_sql_ctype t),
|
adamc@867
|
559 space,
|
adamc@867
|
560 string "tmp;",
|
adamc@867
|
561 newline,
|
adamc@880
|
562 string "uw_error(ctx, FATAL, \"",
|
adamc@880
|
563 string (ErrorMsg.spanToString loc),
|
adamc@880
|
564 string ": Unexpectedly NULL field #",
|
adamc@867
|
565 string (Int.toString i),
|
adamc@867
|
566 string "\");",
|
adamc@867
|
567 newline,
|
adamc@867
|
568 string "tmp;",
|
adamc@867
|
569 newline,
|
adamc@867
|
570 string "})"],
|
adamc@867
|
571 string " : ",
|
adamc@867
|
572 p_unsql t
|
adamc@867
|
573 (box [string "PQgetvalue(res, i, ",
|
adamc@867
|
574 string (Int.toString i),
|
adamc@867
|
575 string ")"])
|
adamc@867
|
576 (box [string "PQgetlength(res, i, ",
|
adamc@867
|
577 string (Int.toString i),
|
adamc@867
|
578 string ")"]),
|
adamc@867
|
579 string ")"]
|
adamc@867
|
580 in
|
adamc@867
|
581 getter t
|
adamc@867
|
582 end
|
adamc@867
|
583
|
adamc@873
|
584 fun queryCommon {loc, query, cols, doCols} =
|
adamc@867
|
585 box [string "int n, i;",
|
adamc@867
|
586 newline,
|
adamc@867
|
587 newline,
|
adamc@867
|
588
|
adamc@867
|
589 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
|
adamc@867
|
590 newline,
|
adamc@867
|
591 newline,
|
adamc@867
|
592
|
adamc@867
|
593 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
|
adamc@867
|
594 newline,
|
adamc@867
|
595 box [string "PQclear(res);",
|
adamc@867
|
596 newline,
|
adamc@867
|
597 string "uw_error(ctx, FATAL, \"",
|
adamc@867
|
598 string (ErrorMsg.spanToString loc),
|
adamc@867
|
599 string ": Query failed:\\n%s\\n%s\", ",
|
adamc@867
|
600 query,
|
adamc@867
|
601 string ", PQerrorMessage(conn));",
|
adamc@867
|
602 newline],
|
adamc@867
|
603 string "}",
|
adamc@867
|
604 newline,
|
adamc@867
|
605 newline,
|
adamc@867
|
606
|
adamc@867
|
607 string "if (PQnfields(res) != ",
|
adamc@873
|
608 string (Int.toString (length cols)),
|
adamc@867
|
609 string ") {",
|
adamc@867
|
610 newline,
|
adamc@867
|
611 box [string "int nf = PQnfields(res);",
|
adamc@867
|
612 newline,
|
adamc@867
|
613 string "PQclear(res);",
|
adamc@867
|
614 newline,
|
adamc@867
|
615 string "uw_error(ctx, FATAL, \"",
|
adamc@867
|
616 string (ErrorMsg.spanToString loc),
|
adamc@867
|
617 string ": Query returned %d columns instead of ",
|
adamc@873
|
618 string (Int.toString (length cols)),
|
adamc@867
|
619 string ":\\n%s\\n%s\", nf, ",
|
adamc@867
|
620 query,
|
adamc@867
|
621 string ", PQerrorMessage(conn));",
|
adamc@867
|
622 newline],
|
adamc@867
|
623 string "}",
|
adamc@867
|
624 newline,
|
adamc@867
|
625 newline,
|
adamc@867
|
626
|
adamc@867
|
627 string "uw_end_region(ctx);",
|
adamc@867
|
628 newline,
|
adamc@867
|
629 string "uw_push_cleanup(ctx, (void (*)(void *))PQclear, res);",
|
adamc@867
|
630 newline,
|
adamc@867
|
631 string "n = PQntuples(res);",
|
adamc@867
|
632 newline,
|
adamc@867
|
633 string "for (i = 0; i < n; ++i) {",
|
adamc@867
|
634 newline,
|
adamc@867
|
635 doCols p_getcol,
|
adamc@867
|
636 string "}",
|
adamc@867
|
637 newline,
|
adamc@867
|
638 newline,
|
adamc@867
|
639 string "uw_pop_cleanup(ctx);",
|
adamc@867
|
640 newline]
|
adamc@867
|
641
|
adamc@873
|
642 fun query {loc, cols, doCols} =
|
adamc@867
|
643 box [string "PGconn *conn = uw_get_db(ctx);",
|
adamc@867
|
644 newline,
|
adamc@867
|
645 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
|
adamc@867
|
646 newline,
|
adamc@867
|
647 newline,
|
adamc@873
|
648 queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"}]
|
adamc@867
|
649
|
adamc@867
|
650 fun p_ensql t e =
|
adamc@867
|
651 case t of
|
adamc@867
|
652 Int => box [string "uw_Basis_attrifyInt(ctx, ", e, string ")"]
|
adamc@867
|
653 | Float => box [string "uw_Basis_attrifyFloat(ctx, ", e, string ")"]
|
adamc@867
|
654 | String => e
|
adamc@1011
|
655 | Char => box [string "uw_Basis_attrifyChar(ctx, ", e, string ")"]
|
adamc@867
|
656 | Bool => box [string "(", e, string " ? \"TRUE\" : \"FALSE\")"]
|
adamc@867
|
657 | Time => box [string "uw_Basis_attrifyTime(ctx, ", e, string ")"]
|
adamc@867
|
658 | Blob => box [e, string ".data"]
|
adamc@867
|
659 | Channel => box [string "uw_Basis_attrifyChannel(ctx, ", e, string ")"]
|
adamc@867
|
660 | Client => box [string "uw_Basis_attrifyClient(ctx, ", e, string ")"]
|
adamc@867
|
661 | Nullable String => e
|
adamc@867
|
662 | Nullable t => box [string "(",
|
adamc@867
|
663 e,
|
adamc@867
|
664 string " == NULL ? NULL : ",
|
adamc@867
|
665 p_ensql t (box [string "(*", e, string ")"]),
|
adamc@867
|
666 string ")"]
|
adamc@867
|
667
|
adamc@879
|
668 fun queryPrepared {loc, id, query, inputs, cols, doCols, nested = _} =
|
adamc@867
|
669 box [string "PGconn *conn = uw_get_db(ctx);",
|
adamc@867
|
670 newline,
|
adamc@867
|
671 string "const int paramFormats[] = { ",
|
adamc@867
|
672 p_list_sep (box [string ",", space])
|
adamc@867
|
673 (fn t => if isBlob t then string "1" else string "0") inputs,
|
adamc@867
|
674 string " };",
|
adamc@867
|
675 newline,
|
adamc@867
|
676 string "const int paramLengths[] = { ",
|
adamc@867
|
677 p_list_sepi (box [string ",", space])
|
adamc@867
|
678 (fn i => fn Blob => string ("arg" ^ Int.toString (i + 1) ^ ".size")
|
adamc@867
|
679 | Nullable Blob => string ("arg" ^ Int.toString (i + 1)
|
adamc@867
|
680 ^ "?arg" ^ Int.toString (i + 1) ^ "->size:0")
|
adamc@867
|
681 | _ => string "0") inputs,
|
adamc@867
|
682 string " };",
|
adamc@867
|
683 newline,
|
adamc@867
|
684 string "const char *paramValues[] = { ",
|
adamc@867
|
685 p_list_sepi (box [string ",", space])
|
adamc@867
|
686 (fn i => fn t => p_ensql t (box [string "arg",
|
adamc@867
|
687 string (Int.toString (i + 1))]))
|
adamc@867
|
688 inputs,
|
adamc@867
|
689 string " };",
|
adamc@867
|
690 newline,
|
adamc@867
|
691 newline,
|
adamc@867
|
692 string "PGresult *res = ",
|
adamc@867
|
693 if #persistent (Settings.currentProtocol ()) then
|
adamc@867
|
694 box [string "PQexecPrepared(conn, \"uw",
|
adamc@867
|
695 string (Int.toString id),
|
adamc@867
|
696 string "\", ",
|
adamc@867
|
697 string (Int.toString (length inputs)),
|
adamc@867
|
698 string ", paramValues, paramLengths, paramFormats, 0);"]
|
adamc@867
|
699 else
|
adamc@867
|
700 box [string "PQexecParams(conn, \"",
|
adam@1285
|
701 string (String.toCString query),
|
adamc@867
|
702 string "\", ",
|
adamc@867
|
703 string (Int.toString (length inputs)),
|
adamc@867
|
704 string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
|
adamc@867
|
705 newline,
|
adamc@867
|
706 newline,
|
adamc@873
|
707 queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
|
adam@1285
|
708 string (String.toCString query),
|
adamc@873
|
709 string "\""]}]
|
adamc@867
|
710
|
adam@1293
|
711 fun dmlCommon {loc, dml, mode} =
|
adamc@868
|
712 box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
|
adamc@868
|
713 newline,
|
adamc@868
|
714 newline,
|
adamc@868
|
715
|
adamc@868
|
716 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
|
adamc@868
|
717 newline,
|
adamc@868
|
718 box [string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {",
|
adamc@868
|
719 box [newline,
|
adamc@868
|
720 string "PQclear(res);",
|
adamc@868
|
721 newline,
|
adamc@868
|
722 string "uw_error(ctx, UNLIMITED_RETRY, \"Serialization failure\");",
|
adamc@868
|
723 newline],
|
adamc@868
|
724 string "}",
|
adamc@868
|
725 newline,
|
adam@1293
|
726 case mode of
|
adam@1293
|
727 Settings.Error => box [string "PQclear(res);",
|
adam@1293
|
728 newline,
|
adam@1293
|
729 string "uw_error(ctx, FATAL, \"",
|
adam@1293
|
730 string (ErrorMsg.spanToString loc),
|
adam@1293
|
731 string ": DML failed:\\n%s\\n%s\", ",
|
adam@1293
|
732 dml,
|
adam@1293
|
733 string ", PQerrorMessage(conn));"]
|
adam@1295
|
734 | Settings.None => box [string "uw_set_error_message(ctx, PQerrorMessage(conn));",
|
adam@1295
|
735 newline,
|
adam@1295
|
736 newline,
|
adam@1295
|
737
|
adam@1295
|
738 string "res = PQexec(conn, \"ROLLBACK TO s\");",
|
adam@1295
|
739 newline,
|
adam@1295
|
740 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
|
adam@1295
|
741 newline,
|
adam@1295
|
742 newline,
|
adam@1295
|
743
|
adam@1295
|
744 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
|
adam@1295
|
745 newline,
|
adam@1295
|
746 box [string "PQclear(res);",
|
adam@1295
|
747 newline,
|
adam@1295
|
748 string "uw_error(ctx, FATAL, \"",
|
adam@1295
|
749 string (ErrorMsg.spanToString loc),
|
adam@1295
|
750 string ": ROLLBACK TO failed:\\n%s\\n%s\", ",
|
adam@1295
|
751 dml,
|
adam@1295
|
752 string ", PQerrorMessage(conn));",
|
adam@1295
|
753 newline,
|
adam@1295
|
754 string "}"],
|
adam@1295
|
755 newline,
|
adam@1295
|
756
|
adam@1295
|
757 string "PQclear(res);",
|
adam@1295
|
758 newline],
|
adamc@868
|
759 newline],
|
adamc@868
|
760 string "}",
|
adamc@868
|
761
|
adam@1295
|
762 case mode of
|
adam@1295
|
763 Error => box [newline,
|
adam@1295
|
764 newline,
|
adam@1295
|
765 string "PQclear(res);",
|
adam@1295
|
766 newline]
|
adam@1295
|
767 | None => box[string " else {",
|
adam@1295
|
768 newline,
|
adam@1295
|
769 box [string "PQclear(res);",
|
adam@1295
|
770 newline,
|
adam@1295
|
771 string "res = PQexec(conn, \"RELEASE s\");",
|
adam@1295
|
772 newline,
|
adam@1295
|
773 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
|
adam@1295
|
774 newline,
|
adam@1295
|
775 newline,
|
adam@1295
|
776
|
adam@1295
|
777 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
|
adam@1295
|
778 newline,
|
adam@1295
|
779 box [string "PQclear(res);",
|
adam@1295
|
780 newline,
|
adam@1295
|
781 string "uw_error(ctx, FATAL, \"",
|
adam@1295
|
782 string (ErrorMsg.spanToString loc),
|
adam@1295
|
783 string ": RELEASE failed:\\n%s\\n%s\", ",
|
adam@1295
|
784 dml,
|
adam@1295
|
785 string ", PQerrorMessage(conn));",
|
adam@1295
|
786 newline],
|
adam@1295
|
787 string "}",
|
adam@1295
|
788 newline,
|
adam@1295
|
789 string "PQclear(res);",
|
adam@1295
|
790 newline],
|
adam@1295
|
791 string "}",
|
adam@1295
|
792 newline]]
|
adam@1295
|
793
|
adam@1295
|
794 fun makeSavepoint mode =
|
adam@1295
|
795 case mode of
|
adam@1295
|
796 Error => box []
|
adam@1295
|
797 | None => box [string "res = PQexec(conn, \"SAVEPOINT s\");",
|
adam@1295
|
798 newline,
|
adam@1295
|
799 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
|
adam@1295
|
800 newline,
|
adam@1295
|
801 newline,
|
adam@1295
|
802 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
|
adam@1295
|
803 box [newline,
|
adam@1295
|
804 string "PQclear(res);",
|
adam@1295
|
805 newline,
|
adam@1295
|
806 string "uw_error(ctx, FATAL, \"Error creating SAVEPOINT\");",
|
adam@1295
|
807 newline],
|
adam@1295
|
808 string "}",
|
adam@1295
|
809 newline,
|
adam@1295
|
810 string "PQclear(res);",
|
adam@1295
|
811 newline,
|
adam@1295
|
812 newline]
|
adamc@868
|
813
|
adam@1293
|
814 fun dml (loc, mode) =
|
adamc@868
|
815 box [string "PGconn *conn = uw_get_db(ctx);",
|
adamc@868
|
816 newline,
|
adam@1295
|
817 string "PGresult *res;",
|
adam@1295
|
818 newline,
|
adam@1295
|
819
|
adam@1295
|
820 makeSavepoint mode,
|
adam@1295
|
821
|
adam@1295
|
822 string "res = PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);",
|
adamc@868
|
823 newline,
|
adamc@868
|
824 newline,
|
adam@1293
|
825 dmlCommon {loc = loc, dml = string "dml", mode = mode}]
|
adamc@868
|
826
|
adam@1293
|
827 fun dmlPrepared {loc, id, dml, inputs, mode} =
|
adamc@868
|
828 box [string "PGconn *conn = uw_get_db(ctx);",
|
adamc@868
|
829 newline,
|
adamc@868
|
830 string "const int paramFormats[] = { ",
|
adamc@868
|
831 p_list_sep (box [string ",", space])
|
adamc@868
|
832 (fn t => if isBlob t then string "1" else string "0") inputs,
|
adamc@868
|
833 string " };",
|
adamc@868
|
834 newline,
|
adamc@868
|
835 string "const int paramLengths[] = { ",
|
adamc@868
|
836 p_list_sepi (box [string ",", space])
|
adamc@868
|
837 (fn i => fn Blob => string ("arg" ^ Int.toString (i + 1) ^ ".size")
|
adamc@868
|
838 | Nullable Blob => string ("arg" ^ Int.toString (i + 1)
|
adamc@868
|
839 ^ "?arg" ^ Int.toString (i + 1) ^ "->size:0")
|
adamc@868
|
840 | _ => string "0") inputs,
|
adamc@868
|
841 string " };",
|
adamc@868
|
842 newline,
|
adamc@868
|
843 string "const char *paramValues[] = { ",
|
adamc@868
|
844 p_list_sepi (box [string ",", space])
|
adamc@868
|
845 (fn i => fn t => p_ensql t (box [string "arg",
|
adamc@868
|
846 string (Int.toString (i + 1))]))
|
adamc@868
|
847 inputs,
|
adamc@868
|
848 string " };",
|
adamc@868
|
849 newline,
|
adamc@868
|
850 newline,
|
adam@1295
|
851 string "PGresult *res;",
|
adam@1295
|
852 newline,
|
adam@1295
|
853 newline,
|
adam@1295
|
854
|
adam@1295
|
855 makeSavepoint mode,
|
adam@1295
|
856
|
adam@1295
|
857 string "res = ",
|
adamc@868
|
858 if #persistent (Settings.currentProtocol ()) then
|
adamc@868
|
859 box [string "PQexecPrepared(conn, \"uw",
|
adamc@868
|
860 string (Int.toString id),
|
adamc@868
|
861 string "\", ",
|
adamc@868
|
862 string (Int.toString (length inputs)),
|
adamc@868
|
863 string ", paramValues, paramLengths, paramFormats, 0);"]
|
adamc@868
|
864 else
|
adamc@868
|
865 box [string "PQexecParams(conn, \"",
|
adam@1285
|
866 string (String.toCString dml),
|
adamc@868
|
867 string "\", ",
|
adamc@868
|
868 string (Int.toString (length inputs)),
|
adamc@868
|
869 string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
|
adamc@868
|
870 newline,
|
adamc@868
|
871 newline,
|
adamc@868
|
872 dmlCommon {loc = loc, dml = box [string "\"",
|
adam@1285
|
873 string (String.toCString dml),
|
adam@1293
|
874 string "\""], mode = mode}]
|
adamc@868
|
875
|
adamc@869
|
876 fun nextvalCommon {loc, query} =
|
adamc@869
|
877 box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating nextval result.\");",
|
adamc@869
|
878 newline,
|
adamc@869
|
879 newline,
|
adamc@869
|
880
|
adamc@869
|
881 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
|
adamc@869
|
882 newline,
|
adamc@869
|
883 box [string "PQclear(res);",
|
adamc@869
|
884 newline,
|
adamc@869
|
885 string "uw_error(ctx, FATAL, \"",
|
adamc@869
|
886 string (ErrorMsg.spanToString loc),
|
adamc@869
|
887 string ": Query failed:\\n%s\\n%s\", ",
|
adamc@869
|
888 query,
|
adamc@869
|
889 string ", PQerrorMessage(conn));",
|
adamc@869
|
890 newline],
|
adamc@869
|
891 string "}",
|
adamc@869
|
892 newline,
|
adamc@869
|
893 newline,
|
adamc@869
|
894
|
adamc@869
|
895 string "n = PQntuples(res);",
|
adamc@869
|
896 newline,
|
adamc@869
|
897 string "if (n != 1) {",
|
adamc@869
|
898 newline,
|
adamc@869
|
899 box [string "PQclear(res);",
|
adamc@869
|
900 newline,
|
adamc@869
|
901 string "uw_error(ctx, FATAL, \"",
|
adamc@869
|
902 string (ErrorMsg.spanToString loc),
|
adamc@869
|
903 string ": Wrong number of result rows:\\n%s\\n%s\", ",
|
adamc@869
|
904 query,
|
adamc@869
|
905 string ", PQerrorMessage(conn));",
|
adamc@869
|
906 newline],
|
adamc@869
|
907 string "}",
|
adamc@869
|
908 newline,
|
adamc@869
|
909 newline,
|
adamc@869
|
910
|
adamc@869
|
911 string "n = uw_Basis_stringToInt_error(ctx, PQgetvalue(res, 0, 0));",
|
adamc@869
|
912 newline,
|
adamc@869
|
913 string "PQclear(res);",
|
adamc@869
|
914 newline]
|
adamc@869
|
915
|
adamc@878
|
916 open Cjr
|
adamc@878
|
917
|
adamc@878
|
918 fun nextval {loc, seqE, seqName} =
|
adamc@878
|
919 let
|
adamc@878
|
920 val query = case seqName of
|
adamc@878
|
921 SOME s =>
|
adamc@879
|
922 string ("\"SELECT NEXTVAL('" ^ s ^ "')\"")
|
adamc@878
|
923 | _ => box [string "uw_Basis_strcat(ctx, \"SELECT NEXTVAL('\", uw_Basis_strcat(ctx, ",
|
adamc@878
|
924 seqE,
|
adamc@878
|
925 string ", \"')\"))"]
|
adamc@878
|
926 in
|
adamc@878
|
927 box [string "char *query = ",
|
adamc@878
|
928 query,
|
adamc@878
|
929 string ";",
|
adamc@878
|
930 newline,
|
adamc@878
|
931 string "PGconn *conn = uw_get_db(ctx);",
|
adamc@878
|
932 newline,
|
adamc@878
|
933 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
|
adamc@878
|
934 newline,
|
adamc@878
|
935 newline,
|
adamc@878
|
936 nextvalCommon {loc = loc, query = string "query"}]
|
adamc@878
|
937 end
|
adamc@869
|
938
|
adamc@869
|
939 fun nextvalPrepared {loc, id, query} =
|
adamc@869
|
940 box [string "PGconn *conn = uw_get_db(ctx);",
|
adamc@869
|
941 newline,
|
adamc@869
|
942 newline,
|
adamc@869
|
943 string "PGresult *res = ",
|
adamc@869
|
944 if #persistent (Settings.currentProtocol ()) then
|
adamc@869
|
945 box [string "PQexecPrepared(conn, \"uw",
|
adamc@869
|
946 string (Int.toString id),
|
adamc@869
|
947 string "\", 0, NULL, NULL, NULL, 0);"]
|
adamc@869
|
948 else
|
adamc@869
|
949 box [string "PQexecParams(conn, \"",
|
adam@1285
|
950 string (String.toCString query),
|
adamc@869
|
951 string "\", 0, NULL, NULL, NULL, NULL, 0);"],
|
adamc@869
|
952 newline,
|
adamc@869
|
953 newline,
|
adamc@869
|
954 nextvalCommon {loc = loc, query = box [string "\"",
|
adam@1285
|
955 string (String.toCString query),
|
adamc@869
|
956 string "\""]}]
|
adamc@869
|
957
|
adamc@1073
|
958 fun setvalCommon {loc, query} =
|
adamc@1073
|
959 box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating setval result.\");",
|
adamc@1073
|
960 newline,
|
adamc@1073
|
961 newline,
|
adamc@1073
|
962
|
adamc@1073
|
963 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
|
adamc@1073
|
964 newline,
|
adamc@1073
|
965 box [string "PQclear(res);",
|
adamc@1073
|
966 newline,
|
adamc@1073
|
967 string "uw_error(ctx, FATAL, \"",
|
adamc@1073
|
968 string (ErrorMsg.spanToString loc),
|
adamc@1073
|
969 string ": Query failed:\\n%s\\n%s\", ",
|
adamc@1073
|
970 query,
|
adamc@1073
|
971 string ", PQerrorMessage(conn));",
|
adamc@1073
|
972 newline],
|
adamc@1073
|
973 string "}",
|
adamc@1073
|
974 newline,
|
adamc@1073
|
975 newline,
|
adamc@1073
|
976
|
adamc@1073
|
977 string "PQclear(res);",
|
adamc@1073
|
978 newline]
|
adamc@1073
|
979
|
adamc@1073
|
980 fun setval {loc, seqE, count} =
|
adamc@1073
|
981 let
|
adamc@1073
|
982 val query = box [string "uw_Basis_strcat(ctx, \"SELECT SETVAL('\", uw_Basis_strcat(ctx, ",
|
adamc@1073
|
983 seqE,
|
adamc@1073
|
984 string ", uw_Basis_strcat(ctx, \"', \", uw_Basis_strcat(ctx, uw_Basis_sqlifyInt(ctx, ",
|
adamc@1073
|
985 count,
|
adamc@1073
|
986 string "), \")\"))))"]
|
adamc@1073
|
987 in
|
adamc@1073
|
988 box [string "char *query = ",
|
adamc@1073
|
989 query,
|
adamc@1073
|
990 string ";",
|
adamc@1073
|
991 newline,
|
adamc@1073
|
992 string "PGconn *conn = uw_get_db(ctx);",
|
adamc@1073
|
993 newline,
|
adamc@1073
|
994 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
|
adamc@1073
|
995 newline,
|
adamc@1073
|
996 newline,
|
adamc@1073
|
997 setvalCommon {loc = loc, query = string "query"}]
|
adamc@1073
|
998 end
|
adamc@1073
|
999
|
adamc@874
|
1000 fun sqlifyString s = "E'" ^ String.translate (fn #"'" => "\\'"
|
adamc@874
|
1001 | #"\\" => "\\\\"
|
adamc@874
|
1002 | ch =>
|
adamc@874
|
1003 if Char.isPrint ch then
|
adamc@874
|
1004 str ch
|
adamc@874
|
1005 else
|
adamc@874
|
1006 "\\" ^ StringCvt.padLeft #"0" 3
|
adamc@874
|
1007 (Int.fmt StringCvt.OCT (ord ch)))
|
adam@1285
|
1008 (String.toCString s) ^ "'::text"
|
adamc@874
|
1009
|
adamc@874
|
1010 fun p_cast (s, t) = s ^ "::" ^ p_sql_type t
|
adamc@874
|
1011
|
adamc@874
|
1012 fun p_blank (n, t) = p_cast ("$" ^ Int.toString n, t)
|
adamc@874
|
1013
|
adamc@866
|
1014 val () = addDbms {name = "postgres",
|
adamc@866
|
1015 header = "postgresql/libpq-fe.h",
|
adamc@866
|
1016 link = "-lpq",
|
adamc@873
|
1017 p_sql_type = p_sql_type,
|
adamc@867
|
1018 init = init,
|
adamc@867
|
1019 query = query,
|
adamc@868
|
1020 queryPrepared = queryPrepared,
|
adamc@868
|
1021 dml = dml,
|
adamc@869
|
1022 dmlPrepared = dmlPrepared,
|
adamc@869
|
1023 nextval = nextval,
|
adamc@874
|
1024 nextvalPrepared = nextvalPrepared,
|
adamc@1073
|
1025 setval = setval,
|
adamc@874
|
1026 sqlifyString = sqlifyString,
|
adamc@874
|
1027 p_cast = p_cast,
|
adamc@874
|
1028 p_blank = p_blank,
|
adamc@877
|
1029 supportsDeleteAs = true,
|
adamc@886
|
1030 supportsUpdateAs = true,
|
adamc@877
|
1031 createSequence = fn s => "CREATE SEQUENCE " ^ s,
|
adamc@878
|
1032 textKeysNeedLengths = false,
|
adamc@879
|
1033 supportsNextval = true,
|
adamc@882
|
1034 supportsNestedPrepared = true,
|
adamc@890
|
1035 sqlPrefix = "",
|
adamc@1014
|
1036 supportsOctetLength = true,
|
adamc@1014
|
1037 trueString = "TRUE",
|
adamc@1196
|
1038 falseString = "FALSE",
|
adamc@1196
|
1039 onlyUnion = false,
|
adamc@1196
|
1040 nestedRelops = true}
|
adamc@874
|
1041
|
adamc@866
|
1042 val () = setDbms "postgres"
|
adamc@866
|
1043
|
adamc@866
|
1044 end
|