Mercurial > urweb

comparison src/postgres.sml @ 867:e7f80d78075b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Moved query code into Settings
author Adam Chlipala <adamc@hcoop.net>
date Sun, 28 Jun 2009 16:03:00 -0400
parents 03e7f111fe99
children 06497beb265b
comparison
equal deleted inserted replaced
866:03e7f111fe99 867:e7f80d78075b
187 newline, 187 newline,
188 string "uw_db_prepare(ctx);", 188 string "uw_db_prepare(ctx);",
189 newline, 189 newline,
190 string "}"] 190 string "}"]
191 191
192 fun p_getcol {wontLeakStrings, col = i, typ = t} =
193 let
194 fun p_unsql t e eLen =
195 case t of
196 Int => box [string "uw_Basis_stringToInt_error(ctx, ", e, string ")"]
197 | Float => box [string "uw_Basis_stringToFloat_error(ctx, ", e, string ")"]
198 | String =>
199 if wontLeakStrings then
200 e
201 else
202 box [string "uw_strdup(ctx, ", e, string ")"]
203 | Bool => box [string "uw_Basis_stringToBool_error(ctx, ", e, string ")"]
204 | Time => box [string "uw_Basis_stringToTime_error(ctx, ", e, string ")"]
205 | Blob => box [string "uw_Basis_stringToBlob_error(ctx, ",
206 e,
207 string ", ",
208 eLen,
209 string ")"]
210 | Channel => box [string "uw_Basis_stringToChannel_error(ctx, ", e, string ")"]
211 | Client => box [string "uw_Basis_stringToClient_error(ctx, ", e, string ")"]
212
213 | Nullable _ => raise Fail "Postgres: Recursive Nullable"
214
215 fun getter t =
216 case t of
217 Nullable t =>
218 box [string "(PQgetisnull(res, i, ",
219 string (Int.toString i),
220 string ") ? NULL : ",
221 case t of
222 String => getter t
223 | _ => box [string "({",
224 newline,
225 p_sql_type t,
226 space,
227 string "*tmp = uw_malloc(ctx, sizeof(",
228 p_sql_type t,
229 string "));",
230 newline,
231 string "*tmp = ",
232 getter t,
233 string ";",
234 newline,
235 string "tmp;",
236 newline,
237 string "})"],
238 string ")"]
239 | _ =>
240 box [string "(PQgetisnull(res, i, ",
241 string (Int.toString i),
242 string ") ? ",
243 box [string "({",
244 p_sql_type t,
245 space,
246 string "tmp;",
247 newline,
248 string "uw_error(ctx, FATAL, \"Unexpectedly NULL field #",
249 string (Int.toString i),
250 string "\");",
251 newline,
252 string "tmp;",
253 newline,
254 string "})"],
255 string " : ",
256 p_unsql t
257 (box [string "PQgetvalue(res, i, ",
258 string (Int.toString i),
259 string ")"])
260 (box [string "PQgetlength(res, i, ",
261 string (Int.toString i),
262 string ")"]),
263 string ")"]
264 in
265 getter t
266 end
267
268 fun queryCommon {loc, query, numCols, doCols} =
269 box [string "int n, i;",
270 newline,
271 newline,
272
273 string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating query result.\");",
274 newline,
275 newline,
276
277 string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {",
278 newline,
279 box [string "PQclear(res);",
280 newline,
281 string "uw_error(ctx, FATAL, \"",
282 string (ErrorMsg.spanToString loc),
283 string ": Query failed:\\n%s\\n%s\", ",
284 query,
285 string ", PQerrorMessage(conn));",
286 newline],
287 string "}",
288 newline,
289 newline,
290
291 string "if (PQnfields(res) != ",
292 string (Int.toString numCols),
293 string ") {",
294 newline,
295 box [string "int nf = PQnfields(res);",
296 newline,
297 string "PQclear(res);",
298 newline,
299 string "uw_error(ctx, FATAL, \"",
300 string (ErrorMsg.spanToString loc),
301 string ": Query returned %d columns instead of ",
302 string (Int.toString numCols),
303 string ":\\n%s\\n%s\", nf, ",
304 query,
305 string ", PQerrorMessage(conn));",
306 newline],
307 string "}",
308 newline,
309 newline,
310
311 string "uw_end_region(ctx);",
312 newline,
313 string "uw_push_cleanup(ctx, (void (*)(void *))PQclear, res);",
314 newline,
315 string "n = PQntuples(res);",
316 newline,
317 string "for (i = 0; i < n; ++i) {",
318 newline,
319 doCols p_getcol,
320 string "}",
321 newline,
322 newline,
323 string "uw_pop_cleanup(ctx);",
324 newline]
325
326 fun query {loc, numCols, doCols} =
327 box [string "PGconn *conn = uw_get_db(ctx);",
328 newline,
329 string "PGresult *res = PQexecParams(conn, query, 0, NULL, NULL, NULL, NULL, 0);",
330 newline,
331 newline,
332 queryCommon {loc = loc, numCols = numCols, doCols = doCols, query = string "query"}]
333
334 fun p_ensql t e =
335 case t of
336 Int => box [string "uw_Basis_attrifyInt(ctx, ", e, string ")"]
337 | Float => box [string "uw_Basis_attrifyFloat(ctx, ", e, string ")"]
338 | String => e
339 | Bool => box [string "(", e, string " ? \"TRUE\" : \"FALSE\")"]
340 | Time => box [string "uw_Basis_attrifyTime(ctx, ", e, string ")"]
341 | Blob => box [e, string ".data"]
342 | Channel => box [string "uw_Basis_attrifyChannel(ctx, ", e, string ")"]
343 | Client => box [string "uw_Basis_attrifyClient(ctx, ", e, string ")"]
344 | Nullable String => e
345 | Nullable t => box [string "(",
346 e,
347 string " == NULL ? NULL : ",
348 p_ensql t (box [string "(*", e, string ")"]),
349 string ")"]
350
351 fun queryPrepared {loc, id, query, inputs, numCols, doCols} =
352 box [string "PGconn *conn = uw_get_db(ctx);",
353 newline,
354 string "const int paramFormats[] = { ",
355 p_list_sep (box [string ",", space])
356 (fn t => if isBlob t then string "1" else string "0") inputs,
357 string " };",
358 newline,
359 string "const int paramLengths[] = { ",
360 p_list_sepi (box [string ",", space])
361 (fn i => fn Blob => string ("arg" ^ Int.toString (i + 1) ^ ".size")
362 | Nullable Blob => string ("arg" ^ Int.toString (i + 1)
363 ^ "?arg" ^ Int.toString (i + 1) ^ "->size:0")
364 | _ => string "0") inputs,
365 string " };",
366 newline,
367 string "const char *paramValues[] = { ",
368 p_list_sepi (box [string ",", space])
369 (fn i => fn t => p_ensql t (box [string "arg",
370 string (Int.toString (i + 1))]))
371 inputs,
372 string " };",
373 newline,
374 newline,
375 string "PGresult *res = ",
376 if #persistent (Settings.currentProtocol ()) then
377 box [string "PQexecPrepared(conn, \"uw",
378 string (Int.toString id),
379 string "\", ",
380 string (Int.toString (length inputs)),
381 string ", paramValues, paramLengths, paramFormats, 0);"]
382 else
383 box [string "PQexecParams(conn, \"",
384 string (String.toString query),
385 string "\", ",
386 string (Int.toString (length inputs)),
387 string ", NULL, paramValues, paramLengths, paramFormats, 0);"],
388 newline,
389 newline,
390 queryCommon {loc = loc, numCols = numCols, doCols = doCols, query = box [string "\"",
391 string (String.toString query),
392 string "\""]}]
393
192 val () = addDbms {name = "postgres", 394 val () = addDbms {name = "postgres",
193 header = "postgresql/libpq-fe.h", 395 header = "postgresql/libpq-fe.h",
194 link = "-lpq", 396 link = "-lpq",
195 global_init = box [string "void uw_client_init() { }", 397 global_init = box [string "void uw_client_init() { }",
196 newline], 398 newline],
197 init = init} 399 init = init,
400 query = query,
401 queryPrepared = queryPrepared}
198 val () = setDbms "postgres" 402 val () = setDbms "postgres"
199 403
200 end 404 end