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,
|
as@1564
|
479 string "char *env_db_str = getenv(\"URWEB_PQ_CON\");",
|
as@1564
|
480 newline,
|
as@1564
|
481 string "PGconn *conn = PQconnectdb(env_db_str == NULL ? \"",
|
adam@1285
|
482 string (String.toCString dbstring),
|
as@1564
|
483 string "\" : env_db_str);",
|
adamc@866
|
484 newline,
|
adamc@866
|
485 string "if (conn == NULL) uw_error(ctx, FATAL, ",
|
adamc@866
|
486 string "\"libpq can't allocate a connection.\");",
|
adamc@866
|
487 newline,
|
adamc@866
|
488 string "if (PQstatus(conn) != CONNECTION_OK) {",
|
adamc@866
|
489 newline,
|
adamc@866
|
490 box [string "char msg[1024];",
|
adamc@866
|
491 newline,
|
adamc@866
|
492 string "strncpy(msg, PQerrorMessage(conn), 1024);",
|
adamc@866
|
493 newline,
|
adamc@866
|
494 string "msg[1023] = 0;",
|
adamc@866
|
495 newline,
|
adamc@866
|
496 string "PQfinish(conn);",
|
adamc@866
|
497 newline,
|
adamc@866
|
498 string "uw_error(ctx, BOUNDED_RETRY, ",
|
adamc@866
|
499 string "\"Connection to Postgres server failed: %s\", msg);"],
|
adamc@866
|
500 newline,
|
adamc@866
|
501 string "}",
|
adamc@866
|
502 newline,
|
adamc@866
|
503 string "uw_set_db(ctx, conn);",
|
adamc@866
|
504 newline,
|
adamc@866
|
505 string "uw_db_validate(ctx);",
|
adamc@866
|
506 newline,
|
adamc@866
|
507 string "uw_db_prepare(ctx);",
|
adamc@866
|
508 newline,
|
adamc@866
|
509 string "}"]
|
adamc@866
|
510
|
adamc@880
|
511 fun p_getcol {loc, wontLeakStrings, col = i, typ = t} =
|
adamc@867
|
512 let
|
adamc@867
|
513 fun p_unsql t e eLen =
|
adamc@867
|
514 case t of
|
adamc@867
|
515 Int => box [string "uw_Basis_stringToInt_error(ctx, ", e, string ")"]
|
adamc@867
|
516 | Float => box [string "uw_Basis_stringToFloat_error(ctx, ", e, string ")"]
|
adamc@867
|
517 | String =>
|
adamc@867
|
518 if wontLeakStrings then
|
adamc@867
|
519 e
|
adamc@867
|
520 else
|
adamc@867
|
521 box [string "uw_strdup(ctx, ", e, string ")"]
|
adamc@1011
|
522 | Char => box [e, string "[0]"]
|
adamc@867
|
523 | Bool => box [string "uw_Basis_stringToBool_error(ctx, ", e, string ")"]
|
adamc@939
|
524 | Time => box [string "uw_Basis_unsqlTime(ctx, ", e, string ")"]
|
adamc@867
|
525 | Blob => box [string "uw_Basis_stringToBlob_error(ctx, ",
|
adamc@867
|
526 e,
|
adamc@867
|
527 string ", ",
|
adamc@867
|
528 eLen,
|
adamc@867
|
529 string ")"]
|
adamc@867
|
530 | Channel => box [string "uw_Basis_stringToChannel_error(ctx, ", e, string ")"]
|
adamc@867
|
531 | Client => box [string "uw_Basis_stringToClient_error(ctx, ", e, string ")"]
|
adamc@867
|
532
|
adamc@867
|
533 | Nullable _ => raise Fail "Postgres: Recursive Nullable"
|
adamc@867
|
534
|
adamc@867
|
535 fun getter t =
|
adamc@867
|
536 case t of
|
adamc@867
|
537 Nullable t =>
|
adamc@867
|
538 box [string "(PQgetisnull(res, i, ",
|
adamc@867
|
539 string (Int.toString i),
|
adamc@867
|
540 string ") ? NULL : ",
|
adamc@867
|
541 case t of
|
adamc@867
|
542 String => getter t
|
adamc@867
|
543 | _ => box [string "({",
|
adamc@867
|
544 newline,
|
adamc@874
|
545 string (p_sql_ctype t),
|
adamc@867
|
546 space,
|
adamc@867
|
547 string "*tmp = uw_malloc(ctx, sizeof(",
|
adamc@874
|
548 string (p_sql_ctype t),
|
adamc@867
|
549 string "));",
|
adamc@867
|
550 newline,
|
adamc@867
|
551 string "*tmp = ",
|
adamc@867
|
552 getter t,
|
adamc@867
|
553 string ";",
|
adamc@867
|
554 newline,
|
adamc@867
|
555 string "tmp;",
|
adamc@867
|
556 newline,
|
adamc@867
|
557 string "})"],
|
adamc@867
|
558 string ")"]
|
adamc@867
|
559 | _ =>
|
adamc@867
|
560 box [string "(PQgetisnull(res, i, ",
|
adamc@867
|
561 string (Int.toString i),
|
adamc@867
|
562 string ") ? ",
|
adamc@867
|
563 box [string "({",
|
adamc@874
|
564 string (p_sql_ctype t),
|
adamc@867
|
565 space,
|
adamc@867
|
566 string "tmp;",
|
adamc@867
|
567 newline,
|
adamc@880
|
568 string "uw_error(ctx, FATAL, \"",
|
adamc@880
|
569 string (ErrorMsg.spanToString loc),
|
adamc@880
|
570 string ": Unexpectedly NULL field #",
|
adamc@867
|
571 string (Int.toString i),
|
adamc@867
|
572 string "\");",
|
adamc@867
|
573 newline,
|
adamc@867
|
574 string "tmp;",
|
adamc@867
|
575 newline,
|
adamc@867
|
576 string "})"],
|
adamc@867
|
577 string " : ",
|
adamc@867
|
578 p_unsql t
|
adamc@867
|
579 (box [string "PQgetvalue(res, i, ",
|
adamc@867
|
580 string (Int.toString i),
|
adamc@867
|
581 string ")"])
|
adamc@867
|
582 (box [string "PQgetlength(res, i, ",
|
adamc@867
|
583 string (Int.toString i),
|
adamc@867
|
584 string ")"]),
|
adamc@867
|
585 string ")"]
|
adamc@867
|
586 in
|
adamc@867
|
587 getter t
|
adamc@867
|
588 end
|
adamc@867
|
589
|
adamc@873
|
590 fun queryCommon {loc, query, cols, doCols} =
|
adamc@867
|
591 box [string "int n, i;",
|
adamc@867
|
592 newline,
|
adamc@867
|
593 newline,
|
adamc@867
|
594
|
adamc@867
|
595 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
|
adamc@867
|
596 newline,
|
adamc@867
|
597 newline,
|
adamc@867
|
598
|
adamc@867
|
599 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
|
adamc@867
|
600 newline,
|
adamc@867
|
601 box [string "PQclear(res);",
|
adamc@867
|
602 newline,
|
adamc@867
|
603 string "uw_error(ctx, FATAL, \"",
|
adamc@867
|
604 string (ErrorMsg.spanToString loc),
|
adamc@867
|
605 string ": Query failed:\\n%s\\n%s\", ",
|
adamc@867
|
606 query,
|
adamc@867
|
607 string ", PQerrorMessage(conn));",
|
adamc@867
|
608 newline],
|
adamc@867
|
609 string "}",
|
adamc@867
|
610 newline,
|
adamc@867
|
611 newline,
|
adamc@867
|
612
|
adamc@867
|
613 string "if (PQnfields(res) != ",
|
adamc@873
|
614 string (Int.toString (length cols)),
|
adamc@867
|
615 string ") {",
|
adamc@867
|
616 newline,
|
adamc@867
|
617 box [string "int nf = PQnfields(res);",
|
adamc@867
|
618 newline,
|
adamc@867
|
619 string "PQclear(res);",
|
adamc@867
|
620 newline,
|
adamc@867
|
621 string "uw_error(ctx, FATAL, \"",
|
adamc@867
|
622 string (ErrorMsg.spanToString loc),
|
adamc@867
|
623 string ": Query returned %d columns instead of ",
|
adamc@873
|
624 string (Int.toString (length cols)),
|
adamc@867
|
625 string ":\\n%s\\n%s\", nf, ",
|
adamc@867
|
626 query,
|
adamc@867
|
627 string ", PQerrorMessage(conn));",
|
adamc@867
|
628 newline],
|
adamc@867
|
629 string "}",
|
adamc@867
|
630 newline,
|
adamc@867
|
631 newline,
|
adamc@867
|
632
|
adamc@867
|
633 string "uw_end_region(ctx);",
|
adamc@867
|
634 newline,
|
adamc@867
|
635 string "uw_push_cleanup(ctx, (void (*)(void *))PQclear, res);",
|
adamc@867
|
636 newline,
|
adamc@867
|
637 string "n = PQntuples(res);",
|
adamc@867
|
638 newline,
|
adamc@867
|
639 string "for (i = 0; i < n; ++i) {",
|
adamc@867
|
640 newline,
|
adamc@867
|
641 doCols p_getcol,
|
adamc@867
|
642 string "}",
|
adamc@867
|
643 newline,
|
adamc@867
|
644 newline,
|
adamc@867
|
645 string "uw_pop_cleanup(ctx);",
|
adamc@867
|
646 newline]
|
adamc@867
|
647
|
adamc@873
|
648 fun query {loc, cols, doCols} =
|
adamc@867
|
649 box [string "PGconn *conn = uw_get_db(ctx);",
|
adamc@867
|
650 newline,
|
adamc@867
|
651 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
|
adamc@867
|
652 newline,
|
adamc@867
|
653 newline,
|
adamc@873
|
654 queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"}]
|
adamc@867
|
655
|
adamc@867
|
656 fun p_ensql t e =
|
adamc@867
|
657 case t of
|
adamc@867
|
658 Int => box [string "uw_Basis_attrifyInt(ctx, ", e, string ")"]
|
adamc@867
|
659 | Float => box [string "uw_Basis_attrifyFloat(ctx, ", e, string ")"]
|
adamc@867
|
660 | String => e
|
adamc@1011
|
661 | Char => box [string "uw_Basis_attrifyChar(ctx, ", e, string ")"]
|
adamc@867
|
662 | Bool => box [string "(", e, string " ? \"TRUE\" : \"FALSE\")"]
|
adam@1364
|
663 | Time => box [string "uw_Basis_ensqlTime(ctx, ", e, string ")"]
|
adamc@867
|
664 | Blob => box [e, string ".data"]
|
adamc@867
|
665 | Channel => box [string "uw_Basis_attrifyChannel(ctx, ", e, string ")"]
|
adamc@867
|
666 | Client => box [string "uw_Basis_attrifyClient(ctx, ", e, string ")"]
|
adamc@867
|
667 | Nullable String => e
|
adamc@867
|
668 | Nullable t => box [string "(",
|
adamc@867
|
669 e,
|
adamc@867
|
670 string " == NULL ? NULL : ",
|
adamc@867
|
671 p_ensql t (box [string "(*", e, string ")"]),
|
adamc@867
|
672 string ")"]
|
adamc@867
|
673
|
adam@1431
|
674 fun makeParams inputs =
|
adam@1431
|
675 box [string "static const int paramFormats[] = { ",
|
adamc@867
|
676 p_list_sep (box [string ",", space])
|
adamc@867
|
677 (fn t => if isBlob t then string "1" else string "0") inputs,
|
adamc@867
|
678 string " };",
|
adamc@867
|
679 newline,
|
adam@1431
|
680 if List.exists isBlob inputs then
|
adam@1431
|
681 box [string "const int *paramLengths = uw_malloc(ctx, ",
|
adam@1431
|
682 string (Int.toString (length inputs)),
|
adam@1431
|
683 string " * sizeof(int));",
|
adam@1431
|
684 newline,
|
adam@1431
|
685 p_list_sepi (box [])
|
adam@1431
|
686 (fn i => fn t =>
|
adam@1431
|
687 box [string "paramLengths[",
|
adam@1431
|
688 string (Int.toString i),
|
adam@1431
|
689 string "] = ",
|
adam@1431
|
690 case t of
|
adam@1431
|
691 Blob => string ("arg" ^ Int.toString (i + 1) ^ ".size")
|
adam@1431
|
692 | Nullable Blob => string ("arg" ^ Int.toString (i + 1)
|
adam@1431
|
693 ^ "?arg" ^ Int.toString (i + 1) ^ "->size:0")
|
adam@1431
|
694 | _ => string "0",
|
adam@1431
|
695 string ";",
|
adam@1431
|
696 newline]) inputs,
|
adam@1431
|
697 string " };",
|
adam@1431
|
698 newline]
|
adam@1431
|
699 else
|
adam@1431
|
700 box [string "const int *paramLengths = paramFormats;",
|
adam@1431
|
701 newline],
|
adam@1431
|
702
|
adam@1431
|
703 string "const char **paramValues = uw_malloc(ctx, ",
|
adam@1431
|
704 string (Int.toString (length inputs)),
|
adam@1431
|
705 string " * sizeof(char*));",
|
adamc@867
|
706 newline,
|
adam@1431
|
707 p_list_sepi (box [])
|
adam@1431
|
708 (fn i => fn t => box [string "paramValues[",
|
adam@1431
|
709 string (Int.toString i),
|
adam@1431
|
710 string "] = ",
|
adam@1431
|
711 p_ensql t (box [string "arg",
|
adam@1431
|
712 string (Int.toString (i + 1))]),
|
adam@1431
|
713 string ";",
|
adam@1431
|
714 newline])
|
adamc@867
|
715 inputs,
|
adam@1431
|
716 newline]
|
adam@1431
|
717
|
adam@1431
|
718 fun queryPrepared {loc, id, query, inputs, cols, doCols, nested = _} =
|
adam@1431
|
719 box [string "PGconn *conn = uw_get_db(ctx);",
|
adamc@867
|
720 newline,
|
adam@1431
|
721
|
adam@1431
|
722 makeParams inputs,
|
adam@1431
|
723
|
adamc@867
|
724 newline,
|
adamc@867
|
725 string "PGresult *res = ",
|
adamc@867
|
726 if #persistent (Settings.currentProtocol ()) then
|
adamc@867
|
727 box [string "PQexecPrepared(conn, \"uw",
|
adamc@867
|
728 string (Int.toString id),
|
adamc@867
|
729 string "\", ",
|
adamc@867
|
730 string (Int.toString (length inputs)),
|
adamc@867
|
731 string ", paramValues, paramLengths, paramFormats, 0);"]
|
adamc@867
|
732 else
|
adamc@867
|
733 box [string "PQexecParams(conn, \"",
|
adam@1285
|
734 string (String.toCString query),
|
adamc@867
|
735 string "\", ",
|
adamc@867
|
736 string (Int.toString (length inputs)),
|
adamc@867
|
737 string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
|
adamc@867
|
738 newline,
|
adamc@867
|
739 newline,
|
adamc@873
|
740 queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
|
adam@1285
|
741 string (String.toCString query),
|
adamc@873
|
742 string "\""]}]
|
adamc@867
|
743
|
adam@1293
|
744 fun dmlCommon {loc, dml, mode} =
|
adamc@868
|
745 box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
|
adamc@868
|
746 newline,
|
adamc@868
|
747 newline,
|
adamc@868
|
748
|
adamc@868
|
749 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
|
adamc@868
|
750 newline,
|
adamc@868
|
751 box [string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {",
|
adamc@868
|
752 box [newline,
|
adamc@868
|
753 string "PQclear(res);",
|
adamc@868
|
754 newline,
|
adamc@868
|
755 string "uw_error(ctx, UNLIMITED_RETRY, \"Serialization failure\");",
|
adamc@868
|
756 newline],
|
adamc@868
|
757 string "}",
|
adamc@868
|
758 newline,
|
adam@1550
|
759 string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40P01\")) {",
|
adam@1550
|
760 box [newline,
|
adam@1550
|
761 string "PQclear(res);",
|
adam@1550
|
762 newline,
|
adam@1550
|
763 string "uw_error(ctx, UNLIMITED_RETRY, \"Deadlock detected\");",
|
adam@1550
|
764 newline],
|
adam@1550
|
765 string "}",
|
adam@1550
|
766 newline,
|
adam@1293
|
767 case mode of
|
adam@1293
|
768 Settings.Error => box [string "PQclear(res);",
|
adam@1293
|
769 newline,
|
adam@1293
|
770 string "uw_error(ctx, FATAL, \"",
|
adam@1293
|
771 string (ErrorMsg.spanToString loc),
|
adam@1293
|
772 string ": DML failed:\\n%s\\n%s\", ",
|
adam@1293
|
773 dml,
|
adam@1293
|
774 string ", PQerrorMessage(conn));"]
|
adam@1295
|
775 | Settings.None => box [string "uw_set_error_message(ctx, PQerrorMessage(conn));",
|
adam@1295
|
776 newline,
|
adam@1295
|
777 newline,
|
adam@1295
|
778
|
adam@1295
|
779 string "res = PQexec(conn, \"ROLLBACK TO s\");",
|
adam@1295
|
780 newline,
|
adam@1295
|
781 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
|
adam@1295
|
782 newline,
|
adam@1295
|
783 newline,
|
adam@1295
|
784
|
adam@1295
|
785 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
|
adam@1295
|
786 newline,
|
adam@1295
|
787 box [string "PQclear(res);",
|
adam@1295
|
788 newline,
|
adam@1295
|
789 string "uw_error(ctx, FATAL, \"",
|
adam@1295
|
790 string (ErrorMsg.spanToString loc),
|
adam@1295
|
791 string ": ROLLBACK TO failed:\\n%s\\n%s\", ",
|
adam@1295
|
792 dml,
|
adam@1295
|
793 string ", PQerrorMessage(conn));",
|
adam@1295
|
794 newline,
|
adam@1295
|
795 string "}"],
|
adam@1295
|
796 newline,
|
adam@1295
|
797
|
adam@1295
|
798 string "PQclear(res);",
|
adam@1295
|
799 newline],
|
adamc@868
|
800 newline],
|
adamc@868
|
801 string "}",
|
adamc@868
|
802
|
adam@1295
|
803 case mode of
|
adam@1295
|
804 Error => box [newline,
|
adam@1295
|
805 newline,
|
adam@1295
|
806 string "PQclear(res);",
|
adam@1295
|
807 newline]
|
adam@1295
|
808 | None => box[string " else {",
|
adam@1295
|
809 newline,
|
adam@1295
|
810 box [string "PQclear(res);",
|
adam@1295
|
811 newline,
|
adam@1295
|
812 string "res = PQexec(conn, \"RELEASE s\");",
|
adam@1295
|
813 newline,
|
adam@1295
|
814 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
|
adam@1295
|
815 newline,
|
adam@1295
|
816 newline,
|
adam@1295
|
817
|
adam@1295
|
818 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
|
adam@1295
|
819 newline,
|
adam@1295
|
820 box [string "PQclear(res);",
|
adam@1295
|
821 newline,
|
adam@1295
|
822 string "uw_error(ctx, FATAL, \"",
|
adam@1295
|
823 string (ErrorMsg.spanToString loc),
|
adam@1295
|
824 string ": RELEASE failed:\\n%s\\n%s\", ",
|
adam@1295
|
825 dml,
|
adam@1295
|
826 string ", PQerrorMessage(conn));",
|
adam@1295
|
827 newline],
|
adam@1295
|
828 string "}",
|
adam@1295
|
829 newline,
|
adam@1295
|
830 string "PQclear(res);",
|
adam@1295
|
831 newline],
|
adam@1295
|
832 string "}",
|
adam@1295
|
833 newline]]
|
adam@1295
|
834
|
adam@1295
|
835 fun makeSavepoint mode =
|
adam@1295
|
836 case mode of
|
adam@1295
|
837 Error => box []
|
adam@1295
|
838 | None => box [string "res = PQexec(conn, \"SAVEPOINT s\");",
|
adam@1295
|
839 newline,
|
adam@1295
|
840 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
|
adam@1295
|
841 newline,
|
adam@1295
|
842 newline,
|
adam@1295
|
843 string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {",
|
adam@1295
|
844 box [newline,
|
adam@1295
|
845 string "PQclear(res);",
|
adam@1295
|
846 newline,
|
adam@1295
|
847 string "uw_error(ctx, FATAL, \"Error creating SAVEPOINT\");",
|
adam@1295
|
848 newline],
|
adam@1295
|
849 string "}",
|
adam@1295
|
850 newline,
|
adam@1295
|
851 string "PQclear(res);",
|
adam@1295
|
852 newline,
|
adam@1295
|
853 newline]
|
adamc@868
|
854
|
adam@1293
|
855 fun dml (loc, mode) =
|
adamc@868
|
856 box [string "PGconn *conn = uw_get_db(ctx);",
|
adamc@868
|
857 newline,
|
adam@1295
|
858 string "PGresult *res;",
|
adam@1295
|
859 newline,
|
adam@1295
|
860
|
adam@1295
|
861 makeSavepoint mode,
|
adam@1295
|
862
|
adam@1295
|
863 string "res = PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);",
|
adamc@868
|
864 newline,
|
adamc@868
|
865 newline,
|
adam@1293
|
866 dmlCommon {loc = loc, dml = string "dml", mode = mode}]
|
adamc@868
|
867
|
adam@1293
|
868 fun dmlPrepared {loc, id, dml, inputs, mode} =
|
adamc@868
|
869 box [string "PGconn *conn = uw_get_db(ctx);",
|
adamc@868
|
870 newline,
|
adam@1431
|
871
|
adam@1431
|
872 makeParams inputs,
|
adam@1431
|
873
|
adamc@868
|
874 newline,
|
adam@1295
|
875 string "PGresult *res;",
|
adam@1295
|
876 newline,
|
adam@1295
|
877 newline,
|
adam@1295
|
878
|
adam@1295
|
879 makeSavepoint mode,
|
adam@1295
|
880
|
adam@1295
|
881 string "res = ",
|
adamc@868
|
882 if #persistent (Settings.currentProtocol ()) then
|
adamc@868
|
883 box [string "PQexecPrepared(conn, \"uw",
|
adamc@868
|
884 string (Int.toString id),
|
adamc@868
|
885 string "\", ",
|
adamc@868
|
886 string (Int.toString (length inputs)),
|
adamc@868
|
887 string ", paramValues, paramLengths, paramFormats, 0);"]
|
adamc@868
|
888 else
|
adamc@868
|
889 box [string "PQexecParams(conn, \"",
|
adam@1285
|
890 string (String.toCString dml),
|
adamc@868
|
891 string "\", ",
|
adamc@868
|
892 string (Int.toString (length inputs)),
|
adamc@868
|
893 string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
|
adamc@868
|
894 newline,
|
adamc@868
|
895 newline,
|
adamc@868
|
896 dmlCommon {loc = loc, dml = box [string "\"",
|
adam@1285
|
897 string (String.toCString dml),
|
adam@1293
|
898 string "\""], mode = mode}]
|
adamc@868
|
899
|
adamc@869
|
900 fun nextvalCommon {loc, query} =
|
adamc@869
|
901 box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating nextval result.\");",
|
adamc@869
|
902 newline,
|
adamc@869
|
903 newline,
|
adamc@869
|
904
|
adamc@869
|
905 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
|
adamc@869
|
906 newline,
|
adamc@869
|
907 box [string "PQclear(res);",
|
adamc@869
|
908 newline,
|
adamc@869
|
909 string "uw_error(ctx, FATAL, \"",
|
adamc@869
|
910 string (ErrorMsg.spanToString loc),
|
adamc@869
|
911 string ": Query failed:\\n%s\\n%s\", ",
|
adamc@869
|
912 query,
|
adamc@869
|
913 string ", PQerrorMessage(conn));",
|
adamc@869
|
914 newline],
|
adamc@869
|
915 string "}",
|
adamc@869
|
916 newline,
|
adamc@869
|
917 newline,
|
adamc@869
|
918
|
adamc@869
|
919 string "n = PQntuples(res);",
|
adamc@869
|
920 newline,
|
adamc@869
|
921 string "if (n != 1) {",
|
adamc@869
|
922 newline,
|
adamc@869
|
923 box [string "PQclear(res);",
|
adamc@869
|
924 newline,
|
adamc@869
|
925 string "uw_error(ctx, FATAL, \"",
|
adamc@869
|
926 string (ErrorMsg.spanToString loc),
|
adamc@869
|
927 string ": Wrong number of result rows:\\n%s\\n%s\", ",
|
adamc@869
|
928 query,
|
adamc@869
|
929 string ", PQerrorMessage(conn));",
|
adamc@869
|
930 newline],
|
adamc@869
|
931 string "}",
|
adamc@869
|
932 newline,
|
adamc@869
|
933 newline,
|
adamc@869
|
934
|
adamc@869
|
935 string "n = uw_Basis_stringToInt_error(ctx, PQgetvalue(res, 0, 0));",
|
adamc@869
|
936 newline,
|
adamc@869
|
937 string "PQclear(res);",
|
adamc@869
|
938 newline]
|
adamc@869
|
939
|
adamc@878
|
940 open Cjr
|
adamc@878
|
941
|
adamc@878
|
942 fun nextval {loc, seqE, seqName} =
|
adamc@878
|
943 let
|
adamc@878
|
944 val query = case seqName of
|
adamc@878
|
945 SOME s =>
|
adamc@879
|
946 string ("\"SELECT NEXTVAL('" ^ s ^ "')\"")
|
adamc@878
|
947 | _ => box [string "uw_Basis_strcat(ctx, \"SELECT NEXTVAL('\", uw_Basis_strcat(ctx, ",
|
adamc@878
|
948 seqE,
|
adamc@878
|
949 string ", \"')\"))"]
|
adamc@878
|
950 in
|
adamc@878
|
951 box [string "char *query = ",
|
adamc@878
|
952 query,
|
adamc@878
|
953 string ";",
|
adamc@878
|
954 newline,
|
adamc@878
|
955 string "PGconn *conn = uw_get_db(ctx);",
|
adamc@878
|
956 newline,
|
adamc@878
|
957 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
|
adamc@878
|
958 newline,
|
adamc@878
|
959 newline,
|
adamc@878
|
960 nextvalCommon {loc = loc, query = string "query"}]
|
adamc@878
|
961 end
|
adamc@869
|
962
|
adamc@869
|
963 fun nextvalPrepared {loc, id, query} =
|
adamc@869
|
964 box [string "PGconn *conn = uw_get_db(ctx);",
|
adamc@869
|
965 newline,
|
adamc@869
|
966 newline,
|
adamc@869
|
967 string "PGresult *res = ",
|
adamc@869
|
968 if #persistent (Settings.currentProtocol ()) then
|
adamc@869
|
969 box [string "PQexecPrepared(conn, \"uw",
|
adamc@869
|
970 string (Int.toString id),
|
adamc@869
|
971 string "\", 0, NULL, NULL, NULL, 0);"]
|
adamc@869
|
972 else
|
adamc@869
|
973 box [string "PQexecParams(conn, \"",
|
adam@1285
|
974 string (String.toCString query),
|
adamc@869
|
975 string "\", 0, NULL, NULL, NULL, NULL, 0);"],
|
adamc@869
|
976 newline,
|
adamc@869
|
977 newline,
|
adamc@869
|
978 nextvalCommon {loc = loc, query = box [string "\"",
|
adam@1285
|
979 string (String.toCString query),
|
adamc@869
|
980 string "\""]}]
|
adamc@869
|
981
|
adamc@1073
|
982 fun setvalCommon {loc, query} =
|
adamc@1073
|
983 box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating setval result.\");",
|
adamc@1073
|
984 newline,
|
adamc@1073
|
985 newline,
|
adamc@1073
|
986
|
adamc@1073
|
987 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
|
adamc@1073
|
988 newline,
|
adamc@1073
|
989 box [string "PQclear(res);",
|
adamc@1073
|
990 newline,
|
adamc@1073
|
991 string "uw_error(ctx, FATAL, \"",
|
adamc@1073
|
992 string (ErrorMsg.spanToString loc),
|
adamc@1073
|
993 string ": Query failed:\\n%s\\n%s\", ",
|
adamc@1073
|
994 query,
|
adamc@1073
|
995 string ", PQerrorMessage(conn));",
|
adamc@1073
|
996 newline],
|
adamc@1073
|
997 string "}",
|
adamc@1073
|
998 newline,
|
adamc@1073
|
999 newline,
|
adamc@1073
|
1000
|
adamc@1073
|
1001 string "PQclear(res);",
|
adamc@1073
|
1002 newline]
|
adamc@1073
|
1003
|
adamc@1073
|
1004 fun setval {loc, seqE, count} =
|
adamc@1073
|
1005 let
|
adamc@1073
|
1006 val query = box [string "uw_Basis_strcat(ctx, \"SELECT SETVAL('\", uw_Basis_strcat(ctx, ",
|
adamc@1073
|
1007 seqE,
|
adamc@1073
|
1008 string ", uw_Basis_strcat(ctx, \"', \", uw_Basis_strcat(ctx, uw_Basis_sqlifyInt(ctx, ",
|
adamc@1073
|
1009 count,
|
adamc@1073
|
1010 string "), \")\"))))"]
|
adamc@1073
|
1011 in
|
adamc@1073
|
1012 box [string "char *query = ",
|
adamc@1073
|
1013 query,
|
adamc@1073
|
1014 string ";",
|
adamc@1073
|
1015 newline,
|
adamc@1073
|
1016 string "PGconn *conn = uw_get_db(ctx);",
|
adamc@1073
|
1017 newline,
|
adamc@1073
|
1018 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
|
adamc@1073
|
1019 newline,
|
adamc@1073
|
1020 newline,
|
adamc@1073
|
1021 setvalCommon {loc = loc, query = string "query"}]
|
adamc@1073
|
1022 end
|
adamc@1073
|
1023
|
adamc@874
|
1024 fun sqlifyString s = "E'" ^ String.translate (fn #"'" => "\\'"
|
adamc@874
|
1025 | #"\\" => "\\\\"
|
adamc@874
|
1026 | ch =>
|
adamc@874
|
1027 if Char.isPrint ch then
|
adamc@874
|
1028 str ch
|
adamc@874
|
1029 else
|
adamc@874
|
1030 "\\" ^ StringCvt.padLeft #"0" 3
|
adamc@874
|
1031 (Int.fmt StringCvt.OCT (ord ch)))
|
adam@1285
|
1032 (String.toCString s) ^ "'::text"
|
adamc@874
|
1033
|
adamc@874
|
1034 fun p_cast (s, t) = s ^ "::" ^ p_sql_type t
|
adamc@874
|
1035
|
adamc@874
|
1036 fun p_blank (n, t) = p_cast ("$" ^ Int.toString n, t)
|
adamc@874
|
1037
|
adamc@866
|
1038 val () = addDbms {name = "postgres",
|
adam@1464
|
1039 header = Config.pgheader,
|
adamc@866
|
1040 link = "-lpq",
|
adamc@873
|
1041 p_sql_type = p_sql_type,
|
adamc@867
|
1042 init = init,
|
adamc@867
|
1043 query = query,
|
adamc@868
|
1044 queryPrepared = queryPrepared,
|
adamc@868
|
1045 dml = dml,
|
adamc@869
|
1046 dmlPrepared = dmlPrepared,
|
adamc@869
|
1047 nextval = nextval,
|
adamc@874
|
1048 nextvalPrepared = nextvalPrepared,
|
adamc@1073
|
1049 setval = setval,
|
adamc@874
|
1050 sqlifyString = sqlifyString,
|
adamc@874
|
1051 p_cast = p_cast,
|
adamc@874
|
1052 p_blank = p_blank,
|
adamc@877
|
1053 supportsDeleteAs = true,
|
adamc@886
|
1054 supportsUpdateAs = true,
|
adamc@877
|
1055 createSequence = fn s => "CREATE SEQUENCE " ^ s,
|
adamc@878
|
1056 textKeysNeedLengths = false,
|
adamc@879
|
1057 supportsNextval = true,
|
adamc@882
|
1058 supportsNestedPrepared = true,
|
adamc@890
|
1059 sqlPrefix = "",
|
adamc@1014
|
1060 supportsOctetLength = true,
|
adamc@1014
|
1061 trueString = "TRUE",
|
adamc@1196
|
1062 falseString = "FALSE",
|
adamc@1196
|
1063 onlyUnion = false,
|
adamc@1196
|
1064 nestedRelops = true}
|
adamc@874
|
1065
|
adamc@866
|
1066 val () = setDbms "postgres"
|
adamc@866
|
1067
|
adamc@866
|
1068 end
|