Mercurial > urweb
changeset 874:3c7b48040dcf
MySQL demo/sql succeeds in reading no rows
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sun, 12 Jul 2009 15:05:40 -0400 |
| parents | 41971801b62d |
| children | c50101ddf7fa |
| files | include/urweb.h src/c/urweb.c src/cjr_print.sml src/mono_opt.sml src/monoize.sml src/mysql.sml src/postgres.sml src/prepare.sml src/settings.sig src/settings.sml |
| diffstat | 10 files changed, 520 insertions(+), 97 deletions(-) [+] |
line wrap: on
line diff
--- a/include/urweb.h Sun Jul 12 13:16:05 2009 -0400 +++ b/include/urweb.h Sun Jul 12 15:05:40 2009 -0400 @@ -205,4 +205,6 @@ char *uw_heap_front(uw_context); void uw_set_heap_front(uw_context, char*); +uw_Basis_string uw_Basis_unAs(uw_context, uw_Basis_string); + #endif
--- a/src/c/urweb.c Sun Jul 12 13:16:05 2009 -0400 +++ b/src/c/urweb.c Sun Jul 12 15:05:40 2009 -0400 @@ -2742,3 +2742,38 @@ longjmp(ctx->jmp_buf, RETURN_BLOB); } + +uw_Basis_string uw_Basis_unAs(uw_context ctx, uw_Basis_string s) { + uw_Basis_string r = uw_malloc(ctx, strlen(s) + 1); + + for (; *s; ++s) { + if (s[0] == '\'') { + *r++ = '\''; + for (++s; *s; ++s) { + if (s[0] == '\'') { + *r++ = '\''; + break; + } else if (s[0] == '\\') { + if (s[1] == '\\') { + *r++ = '\\'; + *r++ = '\\'; + ++s; + } else if (s[1] == '\'') { + *r++ = '\\'; + *r++ = '\''; + ++s; + } else + *r++ = '\''; + } else + *r++ = s[0]; + } + if (*s == 0) break; + } else if (s[0] == 'T' && s[1] == '.') + ++s; + else + *r++ = s[0]; + } + + return r; +} +
--- a/src/cjr_print.sml Sun Jul 12 13:16:05 2009 -0400 +++ b/src/cjr_print.sml Sun Jul 12 15:05:40 2009 -0400 @@ -2794,11 +2794,17 @@ string s, string "(", p_list (fn (x, t) => - box [string "uw_", - string (CharVector.map Char.toLower x), - space, - string (#p_sql_type (Settings.currentDbms ()) - (sql_type_in env t))]) xts, + let + val t = sql_type_in env t + in + box [string "uw_", + string (CharVector.map Char.toLower x), + space, + string (#p_sql_type (Settings.currentDbms ()) t), + case t of + Nullable _ => box [] + | _ => string " NOT NULL"] + end) xts, case (pk, csts) of ("", []) => box [] | _ => string ",",
--- a/src/mono_opt.sml Sun Jul 12 13:16:05 2009 -0400 +++ b/src/mono_opt.sml Sun Jul 12 15:05:40 2009 -0400 @@ -83,18 +83,30 @@ "%" ^ hexIt ch) -fun sqlifyInt n = attrifyInt n ^ "::int8" -fun sqlifyFloat n = attrifyFloat n ^ "::float8" +fun sqlifyInt n = attrifyInt n ^ "::" ^ #p_sql_type (Settings.currentDbms ()) Settings.Int +fun sqlifyFloat n = attrifyFloat n ^ "::" ^ #p_sql_type (Settings.currentDbms ()) Settings.Float -fun sqlifyString s = "E'" ^ String.translate (fn #"'" => "\\'" - | #"\\" => "\\\\" - | ch => - if Char.isPrint ch then - str ch - else - "\\" ^ StringCvt.padLeft #"0" 3 - (Int.fmt StringCvt.OCT (ord ch))) - (String.toString s) ^ "'::text" +fun sqlifyString s = #sqlifyString (Settings.currentDbms ()) s + +fun unAs s = + let + fun doChars (cs, acc) = + case cs of + #"T" :: #"." :: cs => doChars (cs, acc) + | #"'" :: cs => doString (cs, acc) + | ch :: cs => doChars (cs, ch :: acc) + | [] => String.implode (rev acc) + + and doString (cs, acc) = + case cs of + #"\\" :: #"\\" :: cs => doString (cs, #"\\" :: #"\\" :: acc) + | #"\\" :: #"'" :: cs => doString (cs, #"'" :: #"\\" :: acc) + | #"'" :: cs => doChars (cs, #"'" :: acc) + | ch :: cs => doString (cs, ch :: acc) + | [] => String.implode (rev acc) + in + doChars (String.explode s, []) + end fun exp e = case e of @@ -442,6 +454,33 @@ EPrim (Prim.String s) end + | EFfiApp ("Basis", "unAs", [(EPrim (Prim.String s), _)]) => + EPrim (Prim.String (unAs s)) + | EFfiApp ("Basis", "unAs", [e']) => + let + fun parts (e as (_, loc)) = + case #1 e of + EStrcat (s1, s2) => + (case (parts s1, parts s2) of + (SOME p1, SOME p2) => SOME (p1 @ p2) + | _ => NONE) + | EPrim (Prim.String s) => SOME [(EPrim (Prim.String (unAs s)), loc)] + | EFfiApp ("Basis", f, [_]) => + if String.isPrefix "sqlify" f then + SOME [e] + else + NONE + | _ => NONE + in + case parts e' of + SOME [e] => #1 e + | SOME es => + (case rev es of + (e as (_, loc)) :: es => #1 (foldl (fn (e, es) => (EStrcat (e, es), loc)) e es) + | [] => raise Fail "MonoOpt impossible nil") + | NONE => e + end + | _ => e and optExp e = #1 (U.Exp.map {typ = typ, exp = exp} e)
--- a/src/monoize.sml Sun Jul 12 13:16:05 2009 -0400 +++ b/src/monoize.sml Sun Jul 12 15:05:40 2009 -0400 @@ -1604,10 +1604,16 @@ in ((L'.EAbs ("tab", s, (L'.TFun (s, s), loc), (L'.EAbs ("e", s, s, - strcat [sc "DELETE FROM ", - (L'.ERel 1, loc), - sc " AS T WHERE ", - (L'.ERel 0, loc)]), loc)), loc), + if #supportsDeleteAs (Settings.currentDbms ()) then + strcat [sc "DELETE FROM ", + (L'.ERel 1, loc), + sc " AS T WHERE ", + (L'.ERel 0, loc)] + else + strcat [sc "DELETE FROM ", + (L'.ERel 1, loc), + sc " WHERE ", + (L'.EFfiApp ("Basis", "unAs", [(L'.ERel 0, loc)]), loc)]), loc)), loc), fm) end
--- a/src/mysql.sml Sun Jul 12 13:16:05 2009 -0400 +++ b/src/mysql.sml Sun Jul 12 15:05:40 2009 -0400 @@ -55,6 +55,278 @@ | Client => "MYSQL_TYPE_LONG" | Nullable t => p_buffer_type t +fun p_sql_type_base t = + case t of + Int => "bigint" + | Float => "double" + | String => "longtext" + | Bool => "tinyint" + | Time => "timestamp" + | Blob => "longblob" + | Channel => "bigint" + | Client => "int" + | Nullable t => p_sql_type_base t + +val ident = String.translate (fn #"'" => "PRIME" + | ch => str ch) + +fun checkRel (table, checkNullable) (s, xts) = + let + val sl = CharVector.map Char.toLower s + + val q = "SELECT COUNT(*) FROM information_schema." ^ table ^ " WHERE table_name = '" + ^ sl ^ "'" + + val q' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE table_name = '", + sl, + "' AND (", + String.concatWith " OR " + (map (fn (x, t) => + String.concat ["(column_name = 'uw_", + CharVector.map + Char.toLower (ident x), + "' AND data_type = '", + p_sql_type_base t, + "'", + if checkNullable then + (" AND is_nullable = '" + ^ (if isNotNull t then + "NO" + else + "YES") + ^ "'") + else + "", + ")"]) xts), + ")"] + + val q'' = String.concat ["SELECT COUNT(*) FROM information_schema.columns WHERE table_name = '", + sl, + "' AND column_name LIKE 'uw_%'"] + in + box [string "if (mysql_query(conn->conn, \"", + string q, + string "\")) {", + newline, + box [string "mysql_close(conn->conn);", + newline, + string "uw_error(ctx, FATAL, \"Query failed:\\n", + string q, + string "\");", + newline], + string "}", + newline, + newline, + + string "if ((res = mysql_store_result(conn->conn)) == NULL) {", + newline, + box [string "mysql_free_result(res);", + newline, + string "mysql_close(conn->conn);", + newline, + string "uw_error(ctx, FATAL, \"Result store failed:\\n", + string q, + string "\");", + newline], + string "}", + newline, + newline, + + string "if (mysql_num_fields(res) != 1) {", + newline, + box [string "mysql_free_result(res);", + newline, + string "mysql_close(conn->conn);", + newline, + string "uw_error(ctx, FATAL, \"Bad column count:\\n", + string q, + string "\");", + newline], + string "}", + newline, + newline, + + string "if ((row = mysql_fetch_row(res)) == NULL) {", + newline, + box [string "mysql_free_result(res);", + newline, + string "mysql_close(conn->conn);", + newline, + string "uw_error(ctx, FATAL, \"Row fetch failed:\\n", + string q, + string "\");", + newline], + string "}", + newline, + newline, + + string "if (strcmp(row[0], \"1\")) {", + newline, + box [string "mysql_free_result(res);", + newline, + string "mysql_close(conn->conn);", + newline, + string "uw_error(ctx, FATAL, \"Table '", + string s, + string "' does not exist.\");", + newline], + string "}", + newline, + newline, + string "mysql_free_result(res);", + newline, + newline, + + string "if (mysql_query(conn->conn, \"", + string q', + string "\")) {", + newline, + box [string "mysql_close(conn->conn);", + newline, + string "uw_error(ctx, FATAL, \"Query failed:\\n", + string q', + string "\");", + newline], + string "}", + newline, + newline, + + string "if ((res = mysql_store_result(conn->conn)) == NULL) {", + newline, + box [string "mysql_free_result(res);", + newline, + string "mysql_close(conn->conn);", + newline, + string "uw_error(ctx, FATAL, \"Result store failed:\\n", + string q', + string "\");", + newline], + string "}", + newline, + newline, + + string "if (mysql_num_fields(res) != 1) {", + newline, + box [string "mysql_free_result(res);", + newline, + string "mysql_close(conn->conn);", + newline, + string "uw_error(ctx, FATAL, \"Bad column count:\\n", + string q', + string "\");", + newline], + string "}", + newline, + newline, + + string "if ((row = mysql_fetch_row(res)) == NULL) {", + newline, + box [string "mysql_free_result(res);", + newline, + string "mysql_close(conn->conn);", + newline, + string "uw_error(ctx, FATAL, \"Row fetch failed:\\n", + string q', + string "\");", + newline], + string "}", + newline, + newline, + + string "if (strcmp(row[0], \"", + string (Int.toString (length xts)), + string "\")) {", + newline, + box [string "mysql_free_result(res);", + newline, + string "mysql_close(conn->conn);", + newline, + string "uw_error(ctx, FATAL, \"Table '", + string s, + string "' has the wrong column types.\");", + newline], + string "}", + newline, + newline, + string "mysql_free_result(res);", + newline, + newline, + + string "if (mysql_query(conn->conn, \"", + string q'', + string "\")) {", + newline, + box [string "mysql_close(conn->conn);", + newline, + string "uw_error(ctx, FATAL, \"Query failed:\\n", + string q'', + string "\");", + newline], + string "}", + newline, + newline, + + string "if ((res = mysql_store_result(conn->conn)) == NULL) {", + newline, + box [string "mysql_free_result(res);", + newline, + string "mysql_close(conn->conn);", + newline, + string "uw_error(ctx, FATAL, \"Result store failed:\\n", + string q'', + string "\");", + newline], + string "}", + newline, + newline, + + string "if (mysql_num_fields(res) != 1) {", + newline, + box [string "mysql_free_result(res);", + newline, + string "mysql_close(conn->conn);", + newline, + string "uw_error(ctx, FATAL, \"Bad column count:\\n", + string q'', + string "\");", + newline], + string "}", + newline, + newline, + + string "if ((row = mysql_fetch_row(res)) == NULL) {", + newline, + box [string "mysql_free_result(res);", + newline, + string "mysql_close(conn->conn);", + newline, + string "uw_error(ctx, FATAL, \"Row fetch failed:\\n", + string q'', + string "\");", + newline], + string "}", + newline, + newline, + + string "if (strcmp(row[0], \"", + string (Int.toString (length xts)), + string "\")) {", + newline, + box [string "mysql_free_result(res);", + newline, + string "mysql_close(conn->conn);", + newline, + string "uw_error(ctx, FATAL, \"Table '", + string s, + string "' has extra columns.\");", + newline], + string "}", + newline, + newline, + string "mysql_free_result(res);", + newline] + end + fun init {dbstring, prepared = ss, tables, views, sequences} = let val host = ref NONE @@ -102,8 +374,37 @@ newline, newline, + string "void uw_client_init(void) {", + newline, + box [string "if (mysql_library_init(0, NULL, NULL)) {", + newline, + box [string "fprintf(stderr, \"Could not initialize MySQL library\\n\");", + newline, + string "exit(1);", + newline], + string "}", + newline], + string "}", + newline, + newline, + if #persistent (currentProtocol ()) then - box [string "static void uw_db_prepare(uw_context ctx) {", + box [string "static void uw_db_validate(uw_context ctx) {", + newline, + string "uw_conn *conn = uw_get_db(ctx);", + newline, + string "MYSQL_RES *res;", + newline, + string "MYSQL_ROW row;", + newline, + newline, + p_list_sep newline (checkRel ("tables", true)) tables, + p_list_sep newline (checkRel ("views", false)) views, + string "}", + newline, + newline, + + string "static void uw_db_prepare(uw_context ctx) {", newline, string "uw_conn *conn = uw_get_db(ctx);", newline, @@ -147,6 +448,10 @@ uhoh false "Out of memory allocating prepared statement" [], string "}", newline, + string "conn->p", + string (Int.toString i), + string " = stmt;", + newline, string "if (mysql_stmt_prepare(stmt, \"", string (String.toString s), @@ -162,10 +467,6 @@ newline, uhoh true "Error preparing statement: %s" ["msg"]], string "}", - newline, - string "conn->p", - string (Int.toString i), - string " = stmt;", newline] end) ss, @@ -199,7 +500,7 @@ | SOME n => string (Int.toString n), string ", ", stringOf unix_socket, - string ", 0)) {", + string ", 0) == NULL) {", newline, box [string "char msg[1024];", newline, @@ -214,7 +515,7 @@ newline, string "}", newline, - string "conn = calloc(1, sizeof(conn));", + string "conn = calloc(1, sizeof(uw_conn));", newline, string "conn->conn = mysql;", newline, @@ -471,19 +772,19 @@ string "if (mysql_stmt_execute(stmt)) uw_error(ctx, FATAL, \"", string (ErrorMsg.spanToString loc), - string ": Error executing query\");", + string ": Error executing query: %s\", mysql_error(conn->conn));", newline, newline, string "if (mysql_stmt_store_result(stmt)) uw_error(ctx, FATAL, \"", string (ErrorMsg.spanToString loc), - string ": Error storing query result\");", + string ": Error storing query result: %s\", mysql_error(conn->conn));", newline, newline, string "if (mysql_stmt_bind_result(stmt, out)) uw_error(ctx, FATAL, \"", string (ErrorMsg.spanToString loc), - string ": Error binding query result\");", + string ": Error binding query result: %s\", mysql_error(conn->conn));", newline, newline, @@ -496,9 +797,9 @@ newline, newline, - string "if (r != MYSQL_NO_DATA) uw_error(ctx, FATAL, \"", + string "if (r == 1) uw_error(ctx, FATAL, \"", string (ErrorMsg.spanToString loc), - string ": query result fetching failed\");", + string ": query result fetching failed (%d): %s\", r, mysql_error(conn->conn));", newline] fun query {loc, cols, doCols} = @@ -514,7 +815,7 @@ newline, string "if (mysql_stmt_prepare(stmt, query, strlen(query))) uw_error(ctx, FATAL, \"", string (ErrorMsg.spanToString loc), - string "\");", + string ": error preparing statement: %s\", mysql_error(conn->conn));", newline, newline, @@ -760,21 +1061,24 @@ fun nextval _ = box [] fun nextvalPrepared _ = box [] +fun sqlifyString s = "CAST('" ^ String.translate (fn #"'" => "\\'" + | #"\\" => "\\\\" + | ch => + if Char.isPrint ch then + str ch + else + (ErrorMsg.error + "Non-printing character found in SQL string literal"; + "")) + (String.toString s) ^ "' AS longtext)" + +fun p_cast (s, t) = "CAST(" ^ s ^ " AS " ^ p_sql_type t ^ ")" + +fun p_blank _ = "?" + val () = addDbms {name = "mysql", header = "mysql/mysql.h", link = "-lmysqlclient", - global_init = box [string "void uw_client_init() {", - newline, - box [string "if (mysql_library_init(0, NULL, NULL)) {", - newline, - box [string "fprintf(stderr, \"Could not initialize MySQL library\\n\");", - newline, - string "exit(1);", - newline], - string "}", - newline], - string "}", - newline], init = init, p_sql_type = p_sql_type, query = query, @@ -782,6 +1086,10 @@ dml = dml, dmlPrepared = dmlPrepared, nextval = nextval, - nextvalPrepared = nextvalPrepared} + nextvalPrepared = nextvalPrepared, + sqlifyString = sqlifyString, + p_cast = p_cast, + p_blank = p_blank, + supportsDeleteAs = false} end
--- a/src/postgres.sml Sun Jul 12 13:16:05 2009 -0400 +++ b/src/postgres.sml Sun Jul 12 15:05:40 2009 -0400 @@ -247,7 +247,11 @@ fun init {dbstring, prepared = ss, tables, views, sequences} = box [if #persistent (currentProtocol ()) then - box [string "static void uw_db_validate(uw_context ctx) {", + box [string "void uw_client_init() { }", + newline, + newline, + + string "static void uw_db_validate(uw_context ctx) {", newline, string "PGconn *conn = uw_get_db(ctx);", newline, @@ -509,10 +513,10 @@ String => getter t | _ => box [string "({", newline, - string (p_sql_type t), + string (p_sql_ctype t), space, string "*tmp = uw_malloc(ctx, sizeof(", - string (p_sql_type t), + string (p_sql_ctype t), string "));", newline, string "*tmp = ", @@ -528,7 +532,7 @@ string (Int.toString i), string ") ? ", box [string "({", - string (p_sql_type t), + string (p_sql_ctype t), space, string "tmp;", newline, @@ -828,11 +832,23 @@ string (String.toString query), string "\""]}] +fun sqlifyString s = "E'" ^ String.translate (fn #"'" => "\\'" + | #"\\" => "\\\\" + | ch => + if Char.isPrint ch then + str ch + else + "\\" ^ StringCvt.padLeft #"0" 3 + (Int.fmt StringCvt.OCT (ord ch))) + (String.toString s) ^ "'::text" + +fun p_cast (s, t) = s ^ "::" ^ p_sql_type t + +fun p_blank (n, t) = p_cast ("$" ^ Int.toString n, t) + val () = addDbms {name = "postgres", header = "postgresql/libpq-fe.h", link = "-lpq", - global_init = box [string "void uw_client_init() { }", - newline], p_sql_type = p_sql_type, init = init, query = query, @@ -840,7 +856,12 @@ dml = dml, dmlPrepared = dmlPrepared, nextval = nextval, - nextvalPrepared = nextvalPrepared} + nextvalPrepared = nextvalPrepared, + sqlifyString = sqlifyString, + p_cast = p_cast, + p_blank = p_blank, + supportsDeleteAs = true} + val () = setDbms "postgres" end
--- a/src/prepare.sml Sun Jul 12 13:16:05 2009 -0400 +++ b/src/prepare.sml Sun Jul 12 15:05:40 2009 -0400 @@ -28,47 +28,45 @@ structure Prepare :> PREPARE = struct open Cjr +open Settings fun prepString (e, ss, n) = - case #1 e of - EPrim (Prim.String s) => - SOME (s :: ss, n) - | EFfiApp ("Basis", "strcat", [e1, e2]) => - (case prepString (e1, ss, n) of - NONE => NONE - | SOME (ss, n) => prepString (e2, ss, n)) - | EFfiApp ("Basis", "sqlifyInt", [e]) => - SOME ("$" ^ Int.toString (n + 1) ^ "::int8" :: ss, n + 1) - | EFfiApp ("Basis", "sqlifyFloat", [e]) => - SOME ("$" ^ Int.toString (n + 1) ^ "::float8" :: ss, n + 1) - | EFfiApp ("Basis", "sqlifyString", [e]) => - SOME ("$" ^ Int.toString (n + 1) ^ "::text" :: ss, n + 1) - | EFfiApp ("Basis", "sqlifyBool", [e]) => - SOME ("$" ^ Int.toString (n + 1) ^ "::bool" :: ss, n + 1) - | EFfiApp ("Basis", "sqlifyTime", [e]) => - SOME ("$" ^ Int.toString (n + 1) ^ "::timestamp" :: ss, n + 1) - | EFfiApp ("Basis", "sqlifyBlob", [e]) => - SOME ("$" ^ Int.toString (n + 1) ^ "::bytea" :: ss, n + 1) - | EFfiApp ("Basis", "sqlifyChannel", [e]) => - SOME ("$" ^ Int.toString (n + 1) ^ "::int8" :: ss, n + 1) - | EFfiApp ("Basis", "sqlifyClient", [e]) => - SOME ("$" ^ Int.toString (n + 1) ^ "::int4" :: ss, n + 1) + let + fun doOne t = + SOME (#p_blank (Settings.currentDbms ()) (n + 1, t) :: ss, n + 1) + in + case #1 e of + EPrim (Prim.String s) => + SOME (s :: ss, n) + | EFfiApp ("Basis", "strcat", [e1, e2]) => + (case prepString (e1, ss, n) of + NONE => NONE + | SOME (ss, n) => prepString (e2, ss, n)) + | EFfiApp ("Basis", "sqlifyInt", [e]) => doOne Int + | EFfiApp ("Basis", "sqlifyFloat", [e]) => doOne Float + | EFfiApp ("Basis", "sqlifyString", [e]) => doOne String + | EFfiApp ("Basis", "sqlifyBool", [e]) => doOne Bool + | EFfiApp ("Basis", "sqlifyTime", [e]) => doOne Time + | EFfiApp ("Basis", "sqlifyBlob", [e]) => doOne Blob + | EFfiApp ("Basis", "sqlifyChannel", [e]) => doOne Channel + | EFfiApp ("Basis", "sqlifyClient", [e]) => doOne Client - | ECase (e, - [((PNone _, _), - (EPrim (Prim.String "NULL"), _)), - ((PSome (_, (PVar _, _)), _), - (EFfiApp (m, x, [(ERel 0, _)]), _))], - _) => prepString ((EFfiApp (m, x, [e]), #2 e), ss, n) + | ECase (e, + [((PNone _, _), + (EPrim (Prim.String "NULL"), _)), + ((PSome (_, (PVar _, _)), _), + (EFfiApp (m, x, [(ERel 0, _)]), _))], + _) => prepString ((EFfiApp (m, x, [e]), #2 e), ss, n) - | ECase (e, - [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, _), _), - (EPrim (Prim.String "TRUE"), _)), - ((PCon (_, PConFfi {mod = "Basis", con = "False", ...}, _), _), - (EPrim (Prim.String "FALSE"), _))], - _) => SOME ("$" ^ Int.toString (n + 1) ^ "::bool" :: ss, n + 1) + | ECase (e, + [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, _), _), + (EPrim (Prim.String "TRUE"), _)), + ((PCon (_, PConFfi {mod = "Basis", con = "False", ...}, _), _), + (EPrim (Prim.String "FALSE"), _))], + _) => doOne Bool - | _ => NONE + | _ => NONE + end fun prepExp (e as (_, loc), sns) = case #1 e of
--- a/src/settings.sig Sun Jul 12 13:16:05 2009 -0400 +++ b/src/settings.sig Sun Jul 12 15:05:40 2009 -0400 @@ -123,15 +123,13 @@ (* Include this C header file *) link : string, (* Pass these linker arguments *) - global_init : Print.PD.pp_desc, - (* Define uw_client_init() *) p_sql_type : sql_type -> string, init : {dbstring : string, prepared : (string * int) list, tables : (string * (string * sql_type) list) list, views : (string * (string * sql_type) list) list, sequences : string list} -> Print.PD.pp_desc, - (* Define uw_db_init(), uw_db_close(), uw_db_begin(), uw_db_commit(), and uw_db_rollback() *) + (* Define uw_client_init(), uw_db_init(), uw_db_close(), uw_db_begin(), uw_db_commit(), and uw_db_rollback() *) query : {loc : ErrorMsg.span, cols : sql_type list, doCols : ({wontLeakStrings : bool, col : int, typ : sql_type} -> Print.PD.pp_desc) -> Print.PD.pp_desc} @@ -145,7 +143,11 @@ dmlPrepared : {loc : ErrorMsg.span, id : int, dml : string, inputs : sql_type list} -> Print.PD.pp_desc, nextval : ErrorMsg.span -> Print.PD.pp_desc, - nextvalPrepared : {loc : ErrorMsg.span, id : int, query : string} -> Print.PD.pp_desc + nextvalPrepared : {loc : ErrorMsg.span, id : int, query : string} -> Print.PD.pp_desc, + sqlifyString : string -> string, + p_cast : string * sql_type -> string, + p_blank : int * sql_type -> string (* Prepared statement input *), + supportsDeleteAs : bool } val addDbms : dbms -> unit
--- a/src/settings.sml Sun Jul 12 13:16:05 2009 -0400 +++ b/src/settings.sml Sun Jul 12 15:05:40 2009 -0400 @@ -314,7 +314,6 @@ name : string, header : string, link : string, - global_init : Print.PD.pp_desc, p_sql_type : sql_type -> string, init : {dbstring : string, prepared : (string * int) list, @@ -334,14 +333,17 @@ dmlPrepared : {loc : ErrorMsg.span, id : int, dml : string, inputs : sql_type list} -> Print.PD.pp_desc, nextval : ErrorMsg.span -> Print.PD.pp_desc, - nextvalPrepared : {loc : ErrorMsg.span, id : int, query : string} -> Print.PD.pp_desc + nextvalPrepared : {loc : ErrorMsg.span, id : int, query : string} -> Print.PD.pp_desc, + sqlifyString : string -> string, + p_cast : string * sql_type -> string, + p_blank : int * sql_type -> string, + supportsDeleteAs : bool } val dbmses = ref ([] : dbms list) val curDb = ref ({name = "", header = "", link = "", - global_init = Print.box [], p_sql_type = fn _ => "", init = fn _ => Print.box [], query = fn _ => Print.box [], @@ -349,7 +351,11 @@ dml = fn _ => Print.box [], dmlPrepared = fn _ => Print.box [], nextval = fn _ => Print.box [], - nextvalPrepared = fn _ => Print.box []} : dbms) + nextvalPrepared = fn _ => Print.box [], + sqlifyString = fn s => s, + p_cast = fn _ => "", + p_blank = fn _ => "", + supportsDeleteAs = false} : dbms) fun addDbms v = dbmses := v :: !dbmses fun setDbms s =