diff options
author | 2009-06-28 16:22:17 -0400 | |
---|---|---|
committer | 2009-06-28 16:22:17 -0400 | |
commit | b6bb5d0ed06785194ec9a717232fc95618758c66 (patch) | |
tree | a60c8ed4fb8703fb61d9844d7b02129464c2c6be /src | |
parent | cc79a0b5321ef71d4e1e3aaeb0f33afcb08e974b (diff) |
Moved dml code into Settings
Diffstat (limited to 'src')
-rw-r--r-- | src/cjr_print.sml | 85 | ||||
-rw-r--r-- | src/mysql.sml | 6 | ||||
-rw-r--r-- | src/postgres.sml | 85 | ||||
-rw-r--r-- | src/settings.sig | 5 | ||||
-rw-r--r-- | src/settings.sml | 9 |
5 files changed, 110 insertions, 80 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml index 92e15b51..ee9011b7 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -1696,16 +1696,16 @@ fun p_exp' par env (e, loc) = | EDml {dml, prepared} => box [string "(uw_begin_region(ctx), ({", newline, - string "PGconn *conn = uw_get_db(ctx);", - newline, case prepared of NONE => box [string "char *dml = ", p_exp env dml, string ";", - newline] - | SOME _ => + newline, + newline, + #dml (Settings.currentDbms ()) loc] + | SOME (id, dml') => let - val ets = getPargs dml + val inputs = getPargs dml in box [p_list_sepi newline (fn i => fn (e, t) => @@ -1718,83 +1718,18 @@ fun p_exp' par env (e, loc) = space, p_exp env e, string ";"]) - ets, + inputs, newline, newline, - string "const int paramFormats[] = { ", - p_list_sep (box [string ",", space]) - (fn (_, t) => if isBlob t then string "1" else string "0") ets, - string " };", - newline, - string "const int paramLengths[] = { ", - p_list_sepi (box [string ",", space]) - (fn i => fn (_, Blob) => string ("arg" ^ Int.toString (i + 1) ^ ".size") - | (_, Nullable Blob) => string ("arg" ^ Int.toString (i + 1) - ^ "?arg" ^ Int.toString (i + 1) ^ "->size:0") - | _ => string "0") ets, - string " };", - newline, - string "const char *paramValues[] = { ", - p_list_sepi (box [string ",", space]) - (fn i => fn (_, t) => p_ensql t (box [string "arg", - string (Int.toString (i + 1))])) - ets, - string " };", - newline, - newline] + #dmlPrepared (Settings.currentDbms ()) {loc = loc, + id = id, + dml = dml', + inputs = map #2 inputs}] end, newline, newline, - string "PGresult *res = ", - case prepared of - NONE => string "PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);" - | SOME (n, s) => - if #persistent (Settings.currentProtocol ()) then - box [string "PQexecPrepared(conn, \"uw", - string (Int.toString n), - string "\", ", - string (Int.toString (length (getPargs dml))), - string ", paramValues, paramLengths, paramFormats, 0);"] - else - box [string "PQexecParams(conn, \"", - string (String.toString s), - string "\", ", - string (Int.toString (length (getPargs dml))), - string ", NULL, paramValues, paramLengths, paramFormats, 0);"], - newline, - newline, - - string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");", - newline, - newline, - string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {", - newline, - box [string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {", - box [newline, - string "PQclear(res);", - newline, - string "uw_error(ctx, UNLIMITED_RETRY, \"Serialization failure\");", - newline], - string "}", - newline, - string "PQclear(res);", - newline, - string "uw_error(ctx, FATAL, \"", - string (ErrorMsg.spanToString loc), - string ": DML failed:\\n%s\\n%s\", ", - case prepared of - NONE => string "dml" - | SOME _ => p_exp env dml, - string ", PQerrorMessage(conn));", - newline], - string "}", - newline, - newline, - - string "PQclear(res);", - newline, string "uw_end_region(ctx);", newline, string "uw_unit_v;", diff --git a/src/mysql.sml b/src/mysql.sml index 976fefef..27b4ca77 100644 --- a/src/mysql.sml +++ b/src/mysql.sml @@ -255,6 +255,8 @@ fun init (dbstring, ss) = fun query _ = raise Fail "MySQL query" fun queryPrepared _ = raise Fail "MySQL queryPrepared" +fun dml _ = raise Fail "MySQL dml" +fun dmlPrepared _ = raise Fail "MySQL dmlPrepared" val () = addDbms {name = "mysql", header = "mysql/mysql.h", @@ -273,6 +275,8 @@ val () = addDbms {name = "mysql", newline], init = init, query = query, - queryPrepared = queryPrepared} + queryPrepared = queryPrepared, + dml = dml, + dmlPrepared = dmlPrepared} end diff --git a/src/postgres.sml b/src/postgres.sml index 8239ec93..01777843 100644 --- a/src/postgres.sml +++ b/src/postgres.sml @@ -391,6 +391,87 @@ fun queryPrepared {loc, id, query, inputs, numCols, doCols} = string (String.toString query), string "\""]}] +fun dmlCommon {loc, dml} = + box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");", + newline, + newline, + + string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {", + newline, + box [string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {", + box [newline, + string "PQclear(res);", + newline, + string "uw_error(ctx, UNLIMITED_RETRY, \"Serialization failure\");", + newline], + string "}", + newline, + string "PQclear(res);", + newline, + string "uw_error(ctx, FATAL, \"", + string (ErrorMsg.spanToString loc), + string ": DML failed:\\n%s\\n%s\", ", + dml, + string ", PQerrorMessage(conn));", + newline], + string "}", + newline, + newline, + + string "PQclear(res);", + newline] + +fun dml loc = + box [string "PGconn *conn = uw_get_db(ctx);", + newline, + string "PGresult *res = PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);", + newline, + newline, + dmlCommon {loc = loc, dml = string "dml"}] + +fun dmlPrepared {loc, id, dml, inputs} = + box [string "PGconn *conn = uw_get_db(ctx);", + newline, + string "const int paramFormats[] = { ", + p_list_sep (box [string ",", space]) + (fn t => if isBlob t then string "1" else string "0") inputs, + string " };", + newline, + string "const int paramLengths[] = { ", + p_list_sepi (box [string ",", space]) + (fn i => fn Blob => string ("arg" ^ Int.toString (i + 1) ^ ".size") + | Nullable Blob => string ("arg" ^ Int.toString (i + 1) + ^ "?arg" ^ Int.toString (i + 1) ^ "->size:0") + | _ => string "0") inputs, + string " };", + newline, + string "const char *paramValues[] = { ", + p_list_sepi (box [string ",", space]) + (fn i => fn t => p_ensql t (box [string "arg", + string (Int.toString (i + 1))])) + inputs, + string " };", + newline, + newline, + string "PGresult *res = ", + if #persistent (Settings.currentProtocol ()) then + box [string "PQexecPrepared(conn, \"uw", + string (Int.toString id), + string "\", ", + string (Int.toString (length inputs)), + string ", paramValues, paramLengths, paramFormats, 0);"] + else + box [string "PQexecParams(conn, \"", + string (String.toString dml), + string "\", ", + string (Int.toString (length inputs)), + string ", NULL, paramValues, paramLengths, paramFormats, 0);"], + newline, + newline, + dmlCommon {loc = loc, dml = box [string "\"", + string (String.toString dml), + string "\""]}] + val () = addDbms {name = "postgres", header = "postgresql/libpq-fe.h", link = "-lpq", @@ -398,7 +479,9 @@ val () = addDbms {name = "postgres", newline], init = init, query = query, - queryPrepared = queryPrepared} + queryPrepared = queryPrepared, + dml = dml, + dmlPrepared = dmlPrepared} val () = setDbms "postgres" end diff --git a/src/settings.sig b/src/settings.sig index 536f6a1f..9912b0e1 100644 --- a/src/settings.sig +++ b/src/settings.sig @@ -135,7 +135,10 @@ signature SETTINGS = sig inputs : sql_type list, numCols : int, doCols : ({wontLeakStrings : bool, col : int, typ : sql_type} -> Print.PD.pp_desc) -> Print.PD.pp_desc} - -> Print.PD.pp_desc + -> Print.PD.pp_desc, + dml : ErrorMsg.span -> Print.PD.pp_desc, + dmlPrepared : {loc : ErrorMsg.span, id : int, dml : string, + inputs : sql_type list} -> Print.PD.pp_desc } val addDbms : dbms -> unit diff --git a/src/settings.sml b/src/settings.sml index 2e0a5ac8..86d8afa9 100644 --- a/src/settings.sml +++ b/src/settings.sml @@ -321,7 +321,10 @@ type dbms = { inputs : sql_type list, numCols : int, doCols : ({wontLeakStrings : bool, col : int, typ : sql_type} -> Print.PD.pp_desc) -> Print.PD.pp_desc} - -> Print.PD.pp_desc + -> Print.PD.pp_desc, + dml : ErrorMsg.span -> Print.PD.pp_desc, + dmlPrepared : {loc : ErrorMsg.span, id : int, dml : string, + inputs : sql_type list} -> Print.PD.pp_desc } val dbmses = ref ([] : dbms list) @@ -331,7 +334,9 @@ val curDb = ref ({name = "", global_init = Print.box [], init = fn _ => Print.box [], query = fn _ => Print.box [], - queryPrepared = fn _ => Print.box []} : dbms) + queryPrepared = fn _ => Print.box [], + dml = fn _ => Print.box [], + dmlPrepared = fn _ => Print.box []} : dbms) fun addDbms v = dbmses := v :: !dbmses fun setDbms s = |