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