summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/c/urweb.c30
-rw-r--r--src/mysql.sml2
-rw-r--r--src/sources3
-rw-r--r--src/sqlite.sig30
-rw-r--r--src/sqlite.sml753
5 files changed, 811 insertions, 7 deletions
diff --git a/src/c/urweb.c b/src/c/urweb.c
index cf44686a..572d1658 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -1990,12 +1990,18 @@ uw_Basis_string uw_Basis_sqlifyString(uw_context ctx, uw_Basis_string s) {
switch (c) {
case '\'':
- strcpy(s2, "\\'");
+ if (uw_Estrings)
+ strcpy(s2, "\\'");
+ else
+ strcpy(s2, "''");
s2 += 2;
break;
case '\\':
- strcpy(s2, "\\\\");
- s2 += 2;
+ if (uw_Estrings) {
+ strcpy(s2, "\\\\");
+ s2 += 2;
+ } else
+ *s2++ = '\\';
break;
default:
if (isprint(c))
@@ -2033,12 +2039,18 @@ uw_Basis_string uw_Basis_sqlifyBlob(uw_context ctx, uw_Basis_blob b) {
switch (c) {
case '\'':
- strcpy(s2, "\\'");
+ if (uw_Estrings)
+ strcpy(s2, "\\'");
+ else
+ strcpy(s2, "''");
s2 += 2;
break;
case '\\':
- strcpy(s2, "\\\\\\\\");
- s2 += 4;
+ if (uw_Estrings) {
+ strcpy(s2, "\\\\\\\\");
+ s2 += 4;
+ } else
+ *s2++ = '\\';
break;
default:
if (isprint(c))
@@ -2549,10 +2561,16 @@ void uw_commit(uw_context ctx) {
int uw_rollback(uw_context ctx) {
size_t i;
+ cleanup *cl;
if (ctx->client)
release_client(ctx->client);
+ for (cl = ctx->cleanup; cl < ctx->cleanup_front; ++cl)
+ cl->func(cl->arg);
+
+ ctx->cleanup_front = ctx->cleanup;
+
for (i = 0; i < ctx->used_transactionals; ++i)
if (ctx->transactionals[i].rollback != NULL)
ctx->transactionals[i].rollback(ctx->transactionals[i].data);
diff --git a/src/mysql.sml b/src/mysql.sml
index 49cd914c..7314f64e 100644
--- a/src/mysql.sml
+++ b/src/mysql.sml
@@ -1450,6 +1450,6 @@ val () = addDbms {name = "mysql",
textKeysNeedLengths = true,
supportsNextval = false,
supportsNestedPrepared = false,
- sqlPrefix = "SET storage_engine=InnoDB;\n"}
+ sqlPrefix = "SET storage_engine=InnoDB;\n\n"}
end
diff --git a/src/sources b/src/sources
index 48a756d9..ddc7deff 100644
--- a/src/sources
+++ b/src/sources
@@ -31,6 +31,9 @@ fastcgi.sml
mysql.sig
mysql.sml
+sqlite.sig
+sqlite.sml
+
prim.sig
prim.sml
diff --git a/src/sqlite.sig b/src/sqlite.sig
new file mode 100644
index 00000000..97475a05
--- /dev/null
+++ b/src/sqlite.sig
@@ -0,0 +1,30 @@
+(* Copyright (c) 2008-2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ * this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ * this list of conditions and the following disclaimer in the documentation
+ * and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ * derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature SQLITE = sig
+
+end
diff --git a/src/sqlite.sml b/src/sqlite.sml
new file mode 100644
index 00000000..a8641a8a
--- /dev/null
+++ b/src/sqlite.sml
@@ -0,0 +1,753 @@
+(* Copyright (c) 2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ * this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ * this list of conditions and the following disclaimer in the documentation
+ * and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ * derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure SQLite :> SQLITE = struct
+
+open Settings
+open Print.PD
+open Print
+
+fun p_sql_type t =
+ case t of
+ Int => "integer"
+ | Float => "real"
+ | String => "text"
+ | Bool => "integer"
+ | Time => "integer"
+ | Blob => "blob"
+ | Channel => "integer"
+ | Client => "integer"
+ | Nullable t => p_sql_type t
+
+val ident = String.translate (fn #"'" => "PRIME"
+ | ch => str ch)
+
+fun checkRel (table, checkNullable) (s, xts) =
+ let
+ val q = "SELECT COUNT(*) FROM sqlite_master WHERE type = '" ^ table ^ "' AND name = '"
+ ^ s ^ "'"
+ in
+ box [string "if (sqlite3_prepare_v2(conn->conn, \"",
+ string q,
+ string "\", -1, &stmt, NULL) != SQLITE_OK) {",
+ newline,
+ box [string "sqlite3_close(conn->conn);",
+ newline,
+ string "uw_error(ctx, FATAL, \"Query preparation failed:\\n",
+ string q,
+ string "\");",
+ newline],
+ string "}",
+ newline,
+ newline,
+
+ string "while ((res = sqlite3_step(stmt)) == SQLITE_BUSY)",
+ newline,
+ box [string "sleep(1);",
+ newline],
+ newline,
+ string "if (res == SQLITE_DONE) {",
+ newline,
+ box [string "sqlite3_finalize(stmt);",
+ newline,
+ string "sqlite3_close(conn->conn);",
+ newline,
+ string "uw_error(ctx, FATAL, \"No row returned:\\n",
+ string q,
+ string "\");",
+ newline],
+ string "}",
+ newline,
+ newline,
+ string "if (res != SQLITE_ROW) {",
+ newline,
+ box [string "sqlite3_finalize(stmt);",
+ newline,
+ string "sqlite3_close(conn->conn);",
+ newline,
+ string "uw_error(ctx, FATAL, \"Error getting row:\\n",
+ string q,
+ string "\");",
+ newline],
+ string "}",
+ newline,
+ newline,
+
+ string "if (sqlite3_column_count(stmt) != 1) {",
+ newline,
+ box [string "sqlite3_finalize(stmt);",
+ newline,
+ string "sqlite3_close(conn->conn);",
+ newline,
+ string "uw_error(ctx, FATAL, \"Bad column count:\\n",
+ string q,
+ string "\");",
+ newline],
+ string "}",
+ newline,
+ newline,
+
+ string "if (sqlite3_column_int(stmt, 0) != 1) {",
+ newline,
+ box [string "sqlite3_finalize(stmt);",
+ newline,
+ string "sqlite3_close(conn->conn);",
+ newline,
+ string "uw_error(ctx, FATAL, \"Table '",
+ string s,
+ string "' does not exist.\");",
+ newline],
+ string "}",
+ newline,
+ newline,
+ string "sqlite3_finalize(stmt);",
+ newline]
+ end
+
+fun init {dbstring, prepared = ss, tables, views, sequences} =
+ let
+ val db = ref dbstring
+ in
+ app (fn s =>
+ case String.fields (fn ch => ch = #"=") s of
+ [name, value] =>
+ (case name of
+ "dbname" => db := value
+ | _ => ())
+ | _ => ()) (String.tokens Char.isSpace dbstring);
+
+ box [string "typedef struct {",
+ newline,
+ box [string "sqlite3 *conn;",
+ newline,
+ p_list_sepi (box [])
+ (fn i => fn _ =>
+ box [string "sqlite3_stmt *p",
+ string (Int.toString i),
+ string ";",
+ newline])
+ ss],
+ string "} uw_conn;",
+ newline,
+ newline,
+
+ string "void uw_client_init(void) {",
+ newline,
+ box [string "uw_sqlfmtInt = \"%lld%n\";",
+ newline,
+ string "uw_sqlfmtFloat = \"%g%n\";",
+ newline,
+ string "uw_Estrings = 0;",
+ newline,
+ string "uw_sqlsuffixString = \"\";",
+ newline,
+ string "uw_sqlsuffixBlob = \"\";",
+ newline,
+ string "uw_sqlfmtUint4 = \"%u%n\";",
+ newline],
+ string "}",
+ newline,
+ newline,
+
+ if #persistent (currentProtocol ()) then
+ box [string "static void uw_db_validate(uw_context ctx) {",
+ newline,
+ string "uw_conn *conn = uw_get_db(ctx);",
+ newline,
+ string "sqlite3_stmt *stmt;",
+ newline,
+ string "int res;",
+ newline,
+ newline,
+ p_list_sep newline (checkRel ("table", true)) tables,
+ p_list_sep newline (fn name => checkRel ("table", true)
+ (name, [("id", Settings.Client)])) sequences,
+ p_list_sep newline (checkRel ("view", false)) views,
+ string "}",
+ newline,
+ newline,
+
+ string "static void uw_db_prepare(uw_context ctx) {",
+ newline,
+ string "uw_conn *conn = uw_get_db(ctx);",
+ newline,
+ newline,
+
+ p_list_sepi newline (fn i => fn (s, n) =>
+ let
+ fun uhoh this s args =
+ box [p_list_sepi (box [])
+ (fn j => fn () =>
+ box [string
+ "sqlite3_finalize(conn->p",
+ string (Int.toString j),
+ string ");",
+ newline])
+ (List.tabulate (i, fn _ => ())),
+ box (if this then
+ [string
+ "sqlite3_finalize(conn->p",
+ string (Int.toString i),
+ string ");",
+ newline]
+ else
+ []),
+ string "sqlite3_close(conn->conn);",
+ newline,
+ string "uw_error(ctx, FATAL, \"",
+ string s,
+ string "\"",
+ p_list_sep (box []) (fn s => box [string ", ",
+ string s]) args,
+ string ");",
+ newline]
+ in
+ box [string "if (sqlite3_prepare_v2(conn->conn, \"",
+ string (String.toString s),
+ string "\", -1, &conn->p",
+ string (Int.toString i),
+ string ", NULL) != SQLITE_OK) {",
+ newline,
+ uhoh false ("Error preparing statement: "
+ ^ String.toString s) [],
+ string "}",
+ newline]
+ end)
+ ss,
+
+ string "}"]
+ else
+ box [string "static void uw_db_prepare(uw_context ctx) { }",
+ newline,
+ string "static void uw_db_validate(uw_context ctx) { }"],
+ newline,
+ newline,
+
+ string "void uw_db_init(uw_context ctx) {",
+ newline,
+ string "sqlite3 *sqlite;",
+ newline,
+ string "uw_conn *conn;",
+ newline,
+ newline,
+ string "if (sqlite3_open(\"",
+ string (!db),
+ string "\", &sqlite) != SQLITE_OK) uw_error(ctx, FATAL, ",
+ string "\"Can't open SQLite database.\");",
+ newline,
+ newline,
+ string "conn = calloc(1, sizeof(uw_conn));",
+ newline,
+ string "conn->conn = sqlite;",
+ newline,
+ string "uw_set_db(ctx, conn);",
+ newline,
+ string "uw_db_validate(ctx);",
+ newline,
+ string "uw_db_prepare(ctx);",
+ newline,
+ string "}",
+ newline,
+ newline,
+
+ string "void uw_db_close(uw_context ctx) {",
+ newline,
+ string "uw_conn *conn = uw_get_db(ctx);",
+ newline,
+ p_list_sepi (box [])
+ (fn i => fn _ =>
+ box [string "if (conn->p",
+ string (Int.toString i),
+ string ") sqlite3_finalize(conn->p",
+ string (Int.toString i),
+ string ");",
+ newline])
+ ss,
+ string "sqlite3_close(conn->conn);",
+ newline,
+ string "}",
+ newline,
+ newline,
+
+ string "int uw_db_begin(uw_context ctx) {",
+ newline,
+ string "uw_conn *conn = uw_get_db(ctx);",
+ newline,
+ newline,
+ string "if (sqlite3_exec(conn->conn, \"BEGIN\", NULL, NULL, NULL) == SQLITE_OK)",
+ newline,
+ box [string "return 0;",
+ newline],
+ string "else {",
+ newline,
+ box [string "fprintf(stderr, \"Begin error: %s\\n\", sqlite3_errmsg(conn->conn));",
+ newline,
+ string "return 1;",
+ newline],
+ string "}",
+ newline,
+ string "}",
+ newline,
+ string "int uw_db_commit(uw_context ctx) {",
+ newline,
+ string "uw_conn *conn = uw_get_db(ctx);",
+ newline,
+ string "if (sqlite3_exec(conn->conn, \"COMMIT\", NULL, NULL, NULL) == SQLITE_OK)",
+ newline,
+ box [string "return 0;",
+ newline],
+ string "else {",
+ newline,
+ box [string "fprintf(stderr, \"Commit error: %s\\n\", sqlite3_errmsg(conn->conn));",
+ newline,
+ string "return 1;",
+ newline],
+ string "}",
+ newline,
+ string "}",
+ newline,
+ newline,
+
+ string "int uw_db_rollback(uw_context ctx) {",
+ newline,
+ string "uw_conn *conn = uw_get_db(ctx);",
+ newline,
+ string "if (sqlite3_exec(conn->conn, \"ROLLBACK\", NULL, NULL, NULL) == SQLITE_OK)",
+ newline,
+ box [string "return 0;",
+ newline],
+ string "else {",
+ newline,
+ box [string "fprintf(stderr, \"Rollback error: %s\\n\", sqlite3_errmsg(conn->conn));",
+ newline,
+ string "return 1;",
+ newline],
+ string "}",
+ newline,
+ string "}",
+ newline,
+ newline]
+ end
+
+fun p_getcol {loc, wontLeakStrings, col = i, typ = t} =
+ let
+ fun p_unsql t =
+ case t of
+ Int => box [string "sqlite3_column_int64(stmt, ", string (Int.toString i), string ")"]
+ | Float => box [string "sqlite3_column_double(stmt, ", string (Int.toString i), string ")"]
+ | String =>
+ if wontLeakStrings then
+ box [string "sqlite3_column_text(stmt, ", string (Int.toString i), string ")"]
+ else
+ box [string "uw_strdup(ctx, sqlite3_column_text(stmt, ", string (Int.toString i), string "))"]
+ | Bool => box [string "(uw_Basis_bool)sqlite3_column_int(stmt, ", string (Int.toString i), string ")"]
+ | Time => box [string "(uw_Basis_time)sqlite3_column_int64(stmt, ", string (Int.toString i), string ")"]
+ | Blob => box [string "({",
+ newline,
+ string "char *data = sqlite3_column_blob(stmt, ",
+ string (Int.toString i),
+ string ");",
+ newline,
+ string "uw_Basis_blob b = {sqlite3_column_bytes(stmt, ",
+ string (Int.toString i),
+ string "), data};",
+ newline,
+ string "b;",
+ newline,
+ string "})"]
+ | Channel => box [string "sqlite3_column_int64(stmt, ", string (Int.toString i), string ")"]
+ | Client => box [string "sqlite3_column_int(stmt, ", string (Int.toString i), string ")"]
+
+ | Nullable _ => raise Fail "Postgres: Recursive Nullable"
+
+ fun getter t =
+ case t of
+ Nullable t =>
+ box [string "(sqlite3_column_type(stmt, ",
+ string (Int.toString i),
+ string ") == SQLITE_NULL ? NULL : ",
+ case t of
+ String => getter t
+ | _ => box [string "({",
+ newline,
+ string (p_sql_ctype t),
+ space,
+ string "*tmp = uw_malloc(ctx, sizeof(",
+ string (p_sql_ctype t),
+ string "));",
+ newline,
+ string "*tmp = ",
+ getter t,
+ string ";",
+ newline,
+ string "tmp;",
+ newline,
+ string "})"],
+ string ")"]
+ | _ =>
+ box [string "(sqlite3_column_type(stmt, ",
+ string (Int.toString i),
+ string ") == SQLITE_NULL ? ",
+ box [string "({",
+ string (p_sql_ctype t),
+ space,
+ string "tmp;",
+ newline,
+ string "uw_error(ctx, FATAL, \"",
+ string (ErrorMsg.spanToString loc),
+ string ": Unexpectedly NULL field #",
+ string (Int.toString i),
+ string "\");",
+ newline,
+ string "tmp;",
+ newline,
+ string "})"],
+ string " : ",
+ p_unsql t,
+ string ")"]
+ in
+ getter t
+ end
+
+fun queryCommon {loc, query, cols, doCols} =
+ box [string "int r;",
+ newline,
+
+ string "sqlite3_reset(stmt);",
+ newline,
+
+ string "uw_end_region(ctx);",
+ newline,
+ string "while ((r = sqlite3_step(stmt)) == SQLITE_ROW) {",
+ newline,
+ doCols p_getcol,
+ string "}",
+ newline,
+ newline,
+
+ string "if (r == SQLITE_BUSY) {",
+ box [string "sleep(1);",
+ newline,
+ string "uw_error(ctx, UNLIMITED_RETRY, \"Database is busy\");",
+ newline],
+ string "}",
+ newline,
+ newline,
+
+ string "if (r != SQLITE_DONE) uw_error(ctx, FATAL, \"",
+ string (ErrorMsg.spanToString loc),
+ string ": query step failed: %s\\n%s\", ",
+ query,
+ string ", sqlite3_errmsg(conn->conn));",
+ newline,
+ newline]
+
+fun query {loc, cols, doCols} =
+ box [string "uw_conn *conn = uw_get_db(ctx);",
+ newline,
+ string "sqlite3 *stmt;",
+ newline,
+ newline,
+ string "if (sqlite3_prepare_v2(conn->conn, query, -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: %s\\n%s\", sqlite3_errmsg(conn->conn));",
+ newline,
+ newline,
+ string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_finalize, stmt);",
+ newline,
+ newline,
+
+ queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"},
+
+ string "uw_pop_cleanup(ctx);",
+ newline]
+
+fun p_inputs loc =
+ p_list_sepi (box [])
+ (fn i => fn t =>
+ let
+ fun bind (t, arg) =
+ case t of
+ Int => box [string "sqlite3_bind_int64(stmt, ",
+ string (Int.toString (i + 1)),
+ string ", ",
+ arg,
+ string ")"]
+ | Float => box [string "sqlite3_bind_double(stmt, ",
+ string (Int.toString (i + 1)),
+ string ", ",
+ arg,
+ string ")"]
+ | String => box [string "sqlite3_bind_text(stmt, ",
+ string (Int.toString (i + 1)),
+ string ", ",
+ arg,
+ string ", -1, SQLITE_TRANSIENT)"]
+ | Bool => box [string "sqlite3_bind_int(stmt, ",
+ string (Int.toString (i + 1)),
+ string ", ",
+ arg,
+ string ")"]
+ | Time => box [string "sqlite3_bind_int64(stmt, ",
+ string (Int.toString (i + 1)),
+ string ", ",
+ arg,
+ string ")"]
+ | Blob => box [string "sqlite3_bind_blob(stmt, ",
+ string (Int.toString (i + 1)),
+ string ", ",
+ arg,
+ string ".data, ",
+ arg,
+ string ".size, SQLITE_TRANSIENT"]
+ | Channel => box [string "sqlite_bind_int64(stmt, ",
+ string (Int.toString (i + 1)),
+ string ", ",
+ arg,
+ string ")"]
+ | Client => box [string "sqlite3_bind_int(stmt, ",
+ string (Int.toString (i + 1)),
+ string ", ",
+ arg,
+ string ")"]
+ | Nullable t => box [string "(",
+ arg,
+ string " == NULL ? sqlite3_bind_null(stmt, ",
+ string (Int.toString (i + 1)),
+ string ") : ",
+ bind (t, case t of
+ String => arg
+ | _ => box [string "(*", arg, string ")"]),
+ string ")"]
+ in
+ box [string "if (",
+ bind (t, box [string "arg", string (Int.toString (i + 1))]),
+ string " != SQLITE_OK) uw_error(ctx, FATAL, \"",
+ string (ErrorMsg.spanToString loc),
+ string ": Error binding parameter #",
+ string (Int.toString (i + 1)),
+ string ": %s\", sqlite3_errmsg(conn->conn));",
+ newline]
+ end)
+
+fun queryPrepared {loc, id, query, inputs, cols, doCols, nested} =
+ box [string "uw_conn *conn = uw_get_db(ctx);",
+ newline,
+ if nested then
+ box [string "sqlite3_stmt *stmt;",
+ newline]
+ else
+ box [string "sqlite3_stmt *stmt = conn->p",
+ string (Int.toString id),
+ string ";",
+ newline,
+ newline,
+
+ string "if (stmt == NULL) {",
+ newline],
+
+ string "if (sqlite3_prepare_v2(conn->conn, \"",
+ string (String.toString query),
+ string "\", -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: ",
+ string (String.toString query),
+ string "\\n%s\", sqlite3_errmsg(conn->conn));",
+ newline,
+ if nested then
+ box [string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_finalize, stmt);",
+ newline]
+ else
+ box [string "conn->p",
+ string (Int.toString id),
+ string " = stmt;",
+ newline,
+ string "}",
+ newline,
+ newline,
+ string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_clear_bindings, stmt);",
+ newline,
+ string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_reset, stmt);",
+ newline],
+ newline,
+
+ p_inputs loc inputs,
+ newline,
+
+ queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
+ string (String.toString query),
+ string "\""]},
+
+ string "uw_pop_cleanup(ctx);",
+ newline,
+ if nested then
+ box []
+ else
+ box [string "uw_pop_cleanup(ctx);",
+ newline]]
+
+fun dmlCommon {loc, dml} =
+ box [string "int r;",
+ newline,
+
+ string "if ((r = sqlite3_step(stmt)) == SQLITE_BUSY) {",
+ box [string "sleep(1);",
+ newline,
+ string "uw_error(ctx, UNLIMITED_RETRY, \"Database is busy\");",
+ newline],
+ string "}",
+ newline,
+ newline,
+
+ string "if (r != SQLITE_DONE) uw_error(ctx, FATAL, \"",
+ string (ErrorMsg.spanToString loc),
+ string ": DML step failed: %s\\n%s\", ",
+ dml,
+ string ", sqlite3_errmsg(conn->conn));",
+ newline]
+
+fun dml loc =
+ box [string "uw_conn *conn = uw_get_db(ctx);",
+ newline,
+ string "sqlite3 *stmt;",
+ newline,
+ newline,
+ string "if (sqlite3_prepare_v2(conn->conn, dml, -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: %s\\n%s\", dml, sqlite3_errmsg(conn->conn));",
+ newline,
+ newline,
+ string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_finalize, stmt);",
+ newline,
+ newline,
+
+ dmlCommon {loc = loc, dml = string "dml"},
+
+ string "uw_pop_cleanup(ctx);",
+ newline]
+
+fun dmlPrepared {loc, id, dml, inputs} =
+ box [string "uw_conn *conn = uw_get_db(ctx);",
+ newline,
+ string "sqlite3_stmt *stmt = conn->p",
+ string (Int.toString id),
+ string ";",
+ newline,
+ newline,
+
+ string "if (stmt == NULL) {",
+ newline,
+ box [string "if (sqlite3_prepare_v2(conn->conn, \"",
+ string (String.toString dml),
+ string "\", -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: ",
+ string (String.toString dml),
+ string "\\n%s\", sqlite3_errmsg(conn->conn));",
+ newline,
+ string "conn->p",
+ string (Int.toString id),
+ string " = stmt;",
+ newline],
+ string "}",
+ newline,
+
+ string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_clear_bindings, stmt);",
+ newline,
+ string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_reset, stmt);",
+ newline,
+
+ p_inputs loc inputs,
+ newline,
+
+ dmlCommon {loc = loc, dml = box [string "\"",
+ string (String.toString dml),
+ string "\""]},
+
+ string "uw_pop_cleanup(ctx);",
+ newline,
+ string "uw_pop_cleanup(ctx);",
+ newline]
+
+fun nextval {loc, seqE, seqName} =
+ box [string "uw_conn *conn = uw_get_db(ctx);",
+ newline,
+ string "char *insert = ",
+ case seqName of
+ SOME s => string ("\"INSERT INTO " ^ s ^ " VALUES ()\"")
+ | NONE => box [string "uw_Basis_strcat(ctx, \"INSERT INTO \", uw_Basis_strcat(ctx, ",
+ seqE,
+ string ", \" VALUES ()\"))"],
+ string ";",
+ newline,
+ string "char *delete = ",
+ case seqName of
+ SOME s => string ("\"DELETE FROM " ^ s ^ "\"")
+ | NONE => box [string "uw_Basis_strcat(ctx, \"DELETE FROM \", ",
+ seqE,
+ string ")"],
+ string ";",
+ newline,
+ newline,
+
+ string "if (sqlite3_exec(conn->conn, insert, NULL, NULL, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"'nextval' INSERT failed\");",
+ newline,
+ string "n = sqlite3_last_insert_rowid(conn->conn);",
+ newline,
+ string "if (sqlite3_exec(conn->conn, delete, NULL, NULL, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"'nextval' DELETE failed\");",
+ newline]
+
+fun nextvalPrepared _ = raise Fail "SQLite.nextvalPrepared called"
+
+fun sqlifyString s = "'" ^ 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) ^ "'"
+
+fun p_cast (s, _) = s
+
+fun p_blank _ = "?"
+
+val () = addDbms {name = "sqlite",
+ header = "sqlite3.h",
+ link = "-lsqlite3",
+ init = init,
+ p_sql_type = p_sql_type,
+ query = query,
+ queryPrepared = queryPrepared,
+ dml = dml,
+ dmlPrepared = dmlPrepared,
+ nextval = nextval,
+ nextvalPrepared = nextvalPrepared,
+ sqlifyString = sqlifyString,
+ p_cast = p_cast,
+ p_blank = p_blank,
+ supportsDeleteAs = false,
+ createSequence = fn s => "CREATE TABLE " ^ s ^ " (id INTEGER PRIMARY KEY AUTO INCREMENT)",
+ textKeysNeedLengths = false,
+ supportsNextval = false,
+ supportsNestedPrepared = false,
+ sqlPrefix = ""}
+
+end
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-02 15:40:24 +0000