Mercurial > urweb

annotate src/sqlite.sml @ 1739:c414850f206f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add support for -boot flag, which allows in-tree execution of Ur/Web The boot flag rewrites most hardcoded paths to point to the build directory, and also forces static compilation. This is convenient for developing Ur/Web, or if you cannot 'sudo make install' Ur/Web. The following changes were made: * Header files were moved to include/urweb instead of include; this lets FFI users point their C_INCLUDE_PATH at this directory at write <urweb/urweb.h>. For internal Ur/Web executables, we simply pass -I$PATH/include/urweb as normal. * Differentiate between LIB and SRCLIB; SRCLIB is Ur and JavaScript source files, while LIB is compiled products from libtool. For in-tree compilation these live in different places. * No longer reference Config for paths; instead use Settings; these settings can be changed dynamically by Compiler.enableBoot () (TODO: add a disableBoot function.) * config.h is now generated directly in include/urweb/config.h, for consistency's sake (especially since it gets installed along with the rest of the headers!) * All of the autotools build products got updated. * The linkStatic field in protocols now only contains the name of the build product, and not the absolute path. Future users have to be careful not to reference the Settings files to early, lest they get an old version (this was the source of two bugs during development of this patch.)
author Edward Z. Yang <ezyang@mit.edu>
date Wed, 02 May 2012 17:17:57 -0400
parents ac141fbb313a
children 59b07fdae1ff
rev   line source
adam@1656 1 (* Copyright (c) 2009-2010, Adam Chlipala
adamc@885 2 * All rights reserved.
adamc@885 3 *
adamc@885 4 * Redistribution and use in source and binary forms, with or without
adamc@885 5 * modification, are permitted provided that the following conditions are met:
adamc@885 6 *
adamc@885 7 * - Redistributions of source code must retain the above copyright notice,
adamc@885 8 * this list of conditions and the following disclaimer.
adamc@885 9 * - Redistributions in binary form must reproduce the above copyright notice,
adamc@885 10 * this list of conditions and the following disclaimer in the documentation
adamc@885 11 * and/or other materials provided with the distribution.
adamc@885 12 * - The names of contributors may not be used to endorse or promote products
adamc@885 13 * derived from this software without specific prior written permission.
adamc@885 14 *
adamc@885 15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
adamc@885 16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
adamc@885 17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
adamc@885 18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
adam@1682 19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
adamc@885 20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
adamc@885 21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
adamc@885 22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
adamc@885 23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
adamc@885 24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
adamc@885 25 * POSSIBILITY OF SUCH DAMAGE.
adamc@885 26 *)
adamc@885 27
adamc@885 28 structure SQLite :> SQLITE = struct
adamc@885 29
adamc@885 30 open Settings
adamc@885 31 open Print.PD
adamc@885 32 open Print
adamc@885 33
adamc@885 34 fun p_sql_type t =
adamc@885 35 case t of
adamc@885 36 Int => "integer"
adamc@885 37 | Float => "real"
adamc@885 38 | String => "text"
adamc@1014 39 | Char => "text"
adamc@885 40 | Bool => "integer"
adamc@887 41 | Time => "text"
adamc@885 42 | Blob => "blob"
adamc@885 43 | Channel => "integer"
adamc@885 44 | Client => "integer"
adamc@885 45 | Nullable t => p_sql_type t
adamc@885 46
adamc@885 47 val ident = String.translate (fn #"'" => "PRIME"
adamc@885 48 | ch => str ch)
adamc@885 49
adamc@885 50 fun checkRel (table, checkNullable) (s, xts) =
adamc@885 51 let
adamc@885 52 val q = "SELECT COUNT(*) FROM sqlite_master WHERE type = '" ^ table ^ "' AND name = '"
adamc@885 53 ^ s ^ "'"
adamc@885 54 in
adamc@885 55 box [string "if (sqlite3_prepare_v2(conn->conn, \"",
adamc@885 56 string q,
adamc@885 57 string "\", -1, &stmt, NULL) != SQLITE_OK) {",
adamc@885 58 newline,
adamc@885 59 box [string "sqlite3_close(conn->conn);",
adamc@885 60 newline,
adamc@1266 61 string "uw_error(ctx, FATAL, \"Query preparation failed:<br />",
adamc@885 62 string q,
adamc@885 63 string "\");",
adamc@885 64 newline],
adamc@885 65 string "}",
adamc@885 66 newline,
adamc@885 67 newline,
adamc@885 68
adamc@885 69 string "while ((res = sqlite3_step(stmt)) == SQLITE_BUSY)",
adamc@885 70 newline,
adamc@885 71 box [string "sleep(1);",
adamc@885 72 newline],
adamc@885 73 newline,
adamc@885 74 string "if (res == SQLITE_DONE) {",
adamc@885 75 newline,
adamc@885 76 box [string "sqlite3_finalize(stmt);",
adamc@885 77 newline,
adamc@885 78 string "sqlite3_close(conn->conn);",
adamc@885 79 newline,
adamc@1266 80 string "uw_error(ctx, FATAL, \"No row returned:<br />",
adamc@885 81 string q,
adamc@885 82 string "\");",
adamc@885 83 newline],
adamc@885 84 string "}",
adamc@885 85 newline,
adamc@885 86 newline,
adamc@885 87 string "if (res != SQLITE_ROW) {",
adamc@885 88 newline,
adamc@885 89 box [string "sqlite3_finalize(stmt);",
adamc@885 90 newline,
adamc@885 91 string "sqlite3_close(conn->conn);",
adamc@885 92 newline,
adamc@1266 93 string "uw_error(ctx, FATAL, \"Error getting row:<br />",
adamc@885 94 string q,
adamc@885 95 string "\");",
adamc@885 96 newline],
adamc@885 97 string "}",
adamc@885 98 newline,
adamc@885 99 newline,
adamc@885 100
adamc@885 101 string "if (sqlite3_column_count(stmt) != 1) {",
adamc@885 102 newline,
adamc@885 103 box [string "sqlite3_finalize(stmt);",
adamc@885 104 newline,
adamc@885 105 string "sqlite3_close(conn->conn);",
adamc@885 106 newline,
adamc@1266 107 string "uw_error(ctx, FATAL, \"Bad column count:<br />",
adamc@885 108 string q,
adamc@885 109 string "\");",
adamc@885 110 newline],
adamc@885 111 string "}",
adamc@885 112 newline,
adamc@885 113 newline,
adamc@885 114
adamc@885 115 string "if (sqlite3_column_int(stmt, 0) != 1) {",
adamc@885 116 newline,
adamc@885 117 box [string "sqlite3_finalize(stmt);",
adamc@885 118 newline,
adamc@885 119 string "sqlite3_close(conn->conn);",
adamc@885 120 newline,
adamc@885 121 string "uw_error(ctx, FATAL, \"Table '",
adamc@885 122 string s,
adamc@885 123 string "' does not exist.\");",
adamc@885 124 newline],
adamc@885 125 string "}",
adamc@885 126 newline,
adamc@885 127 newline,
adamc@885 128 string "sqlite3_finalize(stmt);",
adamc@885 129 newline]
adamc@885 130 end
adamc@885 131
adamc@885 132 fun init {dbstring, prepared = ss, tables, views, sequences} =
adamc@885 133 let
adamc@885 134 val db = ref dbstring
adamc@885 135 in
adamc@885 136 app (fn s =>
adamc@885 137 case String.fields (fn ch => ch = #"=") s of
adamc@885 138 [name, value] =>
adamc@885 139 (case name of
adamc@885 140 "dbname" => db := value
adamc@885 141 | _ => ())
adamc@885 142 | _ => ()) (String.tokens Char.isSpace dbstring);
adamc@885 143
adamc@885 144 box [string "typedef struct {",
adamc@885 145 newline,
adamc@885 146 box [string "sqlite3 *conn;",
adamc@885 147 newline,
adamc@885 148 p_list_sepi (box [])
adamc@885 149 (fn i => fn _ =>
adamc@885 150 box [string "sqlite3_stmt *p",
adamc@885 151 string (Int.toString i),
adamc@885 152 string ";",
adamc@885 153 newline])
adamc@885 154 ss],
adamc@885 155 string "} uw_conn;",
adamc@885 156 newline,
adamc@885 157 newline,
adamc@885 158
adamc@1094 159 string "static void uw_client_init(void) {",
adamc@885 160 newline,
adamc@885 161 box [string "uw_sqlfmtInt = \"%lld%n\";",
adamc@885 162 newline,
adamc@885 163 string "uw_sqlfmtFloat = \"%g%n\";",
adamc@885 164 newline,
adamc@885 165 string "uw_Estrings = 0;",
adamc@885 166 newline,
adamc@885 167 string "uw_sqlsuffixString = \"\";",
adamc@885 168 newline,
adamc@1011 169 string "uw_sqlsuffixChar = \"\";",
adamc@1011 170 newline,
adamc@885 171 string "uw_sqlsuffixBlob = \"\";",
adamc@885 172 newline,
adamc@885 173 string "uw_sqlfmtUint4 = \"%u%n\";",
adamc@885 174 newline],
adamc@885 175 string "}",
adamc@885 176 newline,
adamc@885 177 newline,
adamc@885 178
adamc@885 179 if #persistent (currentProtocol ()) then
adamc@885 180 box [string "static void uw_db_validate(uw_context ctx) {",
adamc@885 181 newline,
adamc@885 182 string "uw_conn *conn = uw_get_db(ctx);",
adamc@885 183 newline,
adamc@885 184 string "sqlite3_stmt *stmt;",
adamc@885 185 newline,
adamc@885 186 string "int res;",
adamc@885 187 newline,
adamc@885 188 newline,
adamc@885 189 p_list_sep newline (checkRel ("table", true)) tables,
adamc@885 190 p_list_sep newline (fn name => checkRel ("table", true)
adamc@885 191 (name, [("id", Settings.Client)])) sequences,
adamc@885 192 p_list_sep newline (checkRel ("view", false)) views,
adamc@885 193 string "}",
adamc@885 194 newline,
adamc@885 195 newline,
adamc@885 196
adamc@885 197 string "static void uw_db_prepare(uw_context ctx) {",
adamc@885 198 newline,
adamc@885 199 string "uw_conn *conn = uw_get_db(ctx);",
adamc@885 200 newline,
adamc@885 201 newline,
adamc@885 202
adamc@885 203 p_list_sepi newline (fn i => fn (s, n) =>
adamc@885 204 let
adamc@885 205 fun uhoh this s args =
adamc@885 206 box [p_list_sepi (box [])
adamc@885 207 (fn j => fn () =>
adamc@885 208 box [string
adamc@885 209 "sqlite3_finalize(conn->p",
adamc@885 210 string (Int.toString j),
adamc@885 211 string ");",
adamc@885 212 newline])
adamc@885 213 (List.tabulate (i, fn _ => ())),
adamc@885 214 box (if this then
adamc@885 215 [string
adamc@885 216 "sqlite3_finalize(conn->p",
adamc@885 217 string (Int.toString i),
adamc@885 218 string ");",
adamc@885 219 newline]
adamc@885 220 else
adamc@885 221 []),
adamc@885 222 string "sqlite3_close(conn->conn);",
adamc@885 223 newline,
adamc@885 224 string "uw_error(ctx, FATAL, \"",
adamc@885 225 string s,
adamc@885 226 string "\"",
adamc@885 227 p_list_sep (box []) (fn s => box [string ", ",
adamc@885 228 string s]) args,
adamc@885 229 string ");",
adamc@885 230 newline]
adamc@885 231 in
adamc@885 232 box [string "if (sqlite3_prepare_v2(conn->conn, \"",
adam@1656 233 string (Prim.toCString s),
adamc@885 234 string "\", -1, &conn->p",
adamc@885 235 string (Int.toString i),
adamc@885 236 string ", NULL) != SQLITE_OK) {",
adamc@885 237 newline,
adamc@886 238 box [string "char msg[1024];",
adamc@886 239 newline,
adamc@886 240 string "strncpy(msg, sqlite3_errmsg(conn->conn), 1024);",
adamc@886 241 newline,
adamc@886 242 string "msg[1023] = 0;",
adamc@886 243 newline,
adamc@886 244 uhoh false ("Error preparing statement: "
adam@1656 245 ^ Prim.toCString s ^ "<br />%s") ["msg"]],
adamc@885 246 string "}",
adamc@885 247 newline]
adamc@885 248 end)
adamc@885 249 ss,
adamc@885 250
adamc@885 251 string "}"]
adamc@885 252 else
adamc@885 253 box [string "static void uw_db_prepare(uw_context ctx) { }",
adamc@885 254 newline,
adamc@885 255 string "static void uw_db_validate(uw_context ctx) { }"],
adamc@885 256 newline,
adamc@885 257 newline,
adam@1682 258
adamc@1094 259 string "static void uw_db_init(uw_context ctx) {",
adamc@885 260 newline,
adamc@885 261 string "sqlite3 *sqlite;",
adamc@885 262 newline,
adamc@1115 263 string "sqlite3_stmt *stmt;",
adamc@1115 264 newline,
adamc@885 265 string "uw_conn *conn;",
adamc@885 266 newline,
adamc@885 267 newline,
adamc@885 268 string "if (sqlite3_open(\"",
adamc@885 269 string (!db),
adamc@885 270 string "\", &sqlite) != SQLITE_OK) uw_error(ctx, FATAL, ",
adamc@885 271 string "\"Can't open SQLite database.\");",
adamc@885 272 newline,
adamc@885 273 newline,
adamc@1115 274 string "if (uw_database_max < SIZE_MAX) {",
adamc@1115 275 newline,
adamc@1115 276 box [string "char buf[100];",
adamc@1115 277 newline,
adamc@1115 278 newline,
adamc@1115 279
adamc@1115 280 string "sprintf(buf, \"PRAGMA max_page_count = %llu\", (unsigned long long)(uw_database_max / 1024));",
adamc@1115 281 newline,
adamc@1115 282 newline,
adamc@1115 283
adamc@1115 284 string "if (sqlite3_prepare_v2(sqlite, buf, -1, &stmt, NULL) != SQLITE_OK) {",
adamc@1115 285 newline,
adamc@1115 286 box [string "sqlite3_close(sqlite);",
adamc@1115 287 newline,
adamc@1115 288 string "uw_error(ctx, FATAL, \"Can't prepare max_page_count query for SQLite database\");",
adamc@1115 289 newline],
adamc@1115 290 string "}",
adamc@1115 291 newline,
adamc@1115 292 newline,
adamc@1115 293
adamc@1115 294 string "if (sqlite3_step(stmt) != SQLITE_ROW) {",
adamc@1115 295 newline,
adamc@1115 296 box [string "sqlite3_finalize(stmt);",
adamc@1115 297 newline,
adamc@1115 298 string "sqlite3_close(sqlite);",
adamc@1115 299 newline,
adamc@1115 300 string "uw_error(ctx, FATAL, \"Can't set max_page_count parameter for SQLite database\");",
adamc@1115 301 newline],
adamc@1115 302 string "}",
adamc@1115 303 newline,
adamc@1115 304 newline,
adamc@1115 305
adamc@1115 306 string "sqlite3_finalize(stmt);",
adamc@1115 307 newline],
adamc@1115 308 string "}",
adamc@1115 309 newline,
adamc@1115 310 newline,
adam@1682 311
adamc@885 312 string "conn = calloc(1, sizeof(uw_conn));",
adamc@885 313 newline,
adamc@885 314 string "conn->conn = sqlite;",
adamc@885 315 newline,
adamc@885 316 string "uw_set_db(ctx, conn);",
adamc@885 317 newline,
adamc@885 318 string "uw_db_validate(ctx);",
adamc@885 319 newline,
adamc@885 320 string "uw_db_prepare(ctx);",
adamc@885 321 newline,
adamc@885 322 string "}",
adamc@885 323 newline,
adamc@885 324 newline,
adamc@885 325
adamc@1094 326 string "static void uw_db_close(uw_context ctx) {",
adamc@885 327 newline,
adamc@885 328 string "uw_conn *conn = uw_get_db(ctx);",
adamc@885 329 newline,
adamc@885 330 p_list_sepi (box [])
adamc@885 331 (fn i => fn _ =>
adamc@885 332 box [string "if (conn->p",
adamc@885 333 string (Int.toString i),
adamc@885 334 string ") sqlite3_finalize(conn->p",
adamc@885 335 string (Int.toString i),
adamc@885 336 string ");",
adamc@885 337 newline])
adamc@885 338 ss,
adamc@885 339 string "sqlite3_close(conn->conn);",
adamc@885 340 newline,
adamc@885 341 string "}",
adamc@885 342 newline,
adamc@885 343 newline,
adamc@885 344
adamc@1094 345 string "static int uw_db_begin(uw_context ctx) {",
adamc@885 346 newline,
adamc@885 347 string "uw_conn *conn = uw_get_db(ctx);",
adamc@885 348 newline,
adamc@885 349 newline,
adamc@885 350 string "if (sqlite3_exec(conn->conn, \"BEGIN\", NULL, NULL, NULL) == SQLITE_OK)",
adamc@885 351 newline,
adamc@885 352 box [string "return 0;",
adamc@885 353 newline],
adamc@885 354 string "else {",
adamc@885 355 newline,
adamc@1266 356 box [string "fprintf(stderr, \"Begin error: %s<br />\", sqlite3_errmsg(conn->conn));",
adamc@885 357 newline,
adamc@885 358 string "return 1;",
adamc@885 359 newline],
adamc@885 360 string "}",
adamc@885 361 newline,
adamc@885 362 string "}",
adamc@885 363 newline,
adamc@1094 364 string "static int uw_db_commit(uw_context ctx) {",
adamc@885 365 newline,
adamc@885 366 string "uw_conn *conn = uw_get_db(ctx);",
adamc@885 367 newline,
adamc@885 368 string "if (sqlite3_exec(conn->conn, \"COMMIT\", NULL, NULL, NULL) == SQLITE_OK)",
adamc@885 369 newline,
adamc@885 370 box [string "return 0;",
adamc@885 371 newline],
adamc@885 372 string "else {",
adamc@885 373 newline,
adamc@1266 374 box [string "fprintf(stderr, \"Commit error: %s<br />\", sqlite3_errmsg(conn->conn));",
adamc@885 375 newline,
adamc@885 376 string "return 1;",
adamc@885 377 newline],
adamc@885 378 string "}",
adamc@885 379 newline,
adamc@885 380 string "}",
adamc@885 381 newline,
adamc@885 382 newline,
adamc@885 383
adamc@1094 384 string "static int uw_db_rollback(uw_context ctx) {",
adamc@885 385 newline,
adamc@885 386 string "uw_conn *conn = uw_get_db(ctx);",
adamc@885 387 newline,
adamc@885 388 string "if (sqlite3_exec(conn->conn, \"ROLLBACK\", NULL, NULL, NULL) == SQLITE_OK)",
adamc@885 389 newline,
adamc@885 390 box [string "return 0;",
adamc@885 391 newline],
adamc@885 392 string "else {",
adamc@885 393 newline,
adamc@1266 394 box [string "fprintf(stderr, \"Rollback error: %s<br />\", sqlite3_errmsg(conn->conn));",
adamc@885 395 newline,
adamc@885 396 string "return 1;",
adamc@885 397 newline],
adamc@885 398 string "}",
adamc@885 399 newline,
adamc@885 400 string "}",
adamc@885 401 newline,
adamc@885 402 newline]
adamc@885 403 end
adamc@885 404
adam@1352 405 val fmt = "\"%Y-%m-%d %H:%M:%S\""
adam@1352 406
adamc@885 407 fun p_getcol {loc, wontLeakStrings, col = i, typ = t} =
adamc@885 408 let
adamc@885 409 fun p_unsql t =
adamc@885 410 case t of
adamc@885 411 Int => box [string "sqlite3_column_int64(stmt, ", string (Int.toString i), string ")"]
adamc@885 412 | Float => box [string "sqlite3_column_double(stmt, ", string (Int.toString i), string ")"]
adamc@885 413 | String =>
adamc@885 414 if wontLeakStrings then
adamc@1014 415 box [string "(uw_Basis_string)sqlite3_column_text(stmt, ", string (Int.toString i), string ")"]
adamc@885 416 else
adamc@1014 417 box [string "uw_strdup(ctx, (uw_Basis_string)sqlite3_column_text(stmt, ", string (Int.toString i), string "))"]
adamc@1014 418 | Char => box [string "sqlite3_column_text(stmt, ", string (Int.toString i), string ")[0]"]
adamc@885 419 | Bool => box [string "(uw_Basis_bool)sqlite3_column_int(stmt, ", string (Int.toString i), string ")"]
adam@1352 420 | Time => box [string "uw_Basis_stringToTimef_error(ctx, ",
adam@1352 421 string fmt,
adam@1352 422 string ", (uw_Basis_string)sqlite3_column_text(stmt, ",
adam@1352 423 string (Int.toString i),
adam@1352 424 string "))"]
adamc@885 425 | Blob => box [string "({",
adamc@885 426 newline,
adamc@890 427 string "char *data = (char *)sqlite3_column_blob(stmt, ",
adamc@885 428 string (Int.toString i),
adamc@885 429 string ");",
adamc@885 430 newline,
adamc@890 431 string "int len = sqlite3_column_bytes(stmt, ",
adamc@885 432 string (Int.toString i),
adamc@890 433 string ");",
adamc@890 434 newline,
adamc@890 435 string "uw_Basis_blob b = {len, uw_memdup(ctx, data, len)};",
adamc@885 436 newline,
adamc@885 437 string "b;",
adamc@885 438 newline,
adamc@885 439 string "})"]
adamc@886 440 | Channel => box [string "({",
adamc@886 441 newline,
adamc@886 442 string "sqlite3_int64 n = sqlite3_column_int64(stmt, ",
adamc@886 443 string (Int.toString i),
adamc@886 444 string ");",
adamc@886 445 newline,
adamc@886 446 string "uw_Basis_channel ch = {n >> 32, n & 0xFFFFFFFF};",
adamc@886 447 newline,
adamc@886 448 string "ch;",
adamc@886 449 newline,
adamc@886 450 string "})"]
adamc@885 451 | Client => box [string "sqlite3_column_int(stmt, ", string (Int.toString i), string ")"]
adamc@885 452
adamc@885 453 | Nullable _ => raise Fail "Postgres: Recursive Nullable"
adamc@885 454
adamc@885 455 fun getter t =
adamc@885 456 case t of
adamc@885 457 Nullable t =>
adamc@885 458 box [string "(sqlite3_column_type(stmt, ",
adamc@885 459 string (Int.toString i),
adamc@885 460 string ") == SQLITE_NULL ? NULL : ",
adamc@885 461 case t of
adamc@885 462 String => getter t
adamc@885 463 | _ => box [string "({",
adamc@885 464 newline,
adamc@885 465 string (p_sql_ctype t),
adamc@885 466 space,
adamc@885 467 string "*tmp = uw_malloc(ctx, sizeof(",
adamc@885 468 string (p_sql_ctype t),
adamc@885 469 string "));",
adamc@885 470 newline,
adamc@885 471 string "*tmp = ",
adamc@885 472 getter t,
adamc@885 473 string ";",
adamc@885 474 newline,
adamc@885 475 string "tmp;",
adamc@885 476 newline,
adamc@885 477 string "})"],
adamc@885 478 string ")"]
adamc@885 479 | _ =>
adamc@885 480 box [string "(sqlite3_column_type(stmt, ",
adamc@885 481 string (Int.toString i),
adamc@885 482 string ") == SQLITE_NULL ? ",
adamc@885 483 box [string "({",
adamc@885 484 string (p_sql_ctype t),
adamc@885 485 space,
adamc@885 486 string "tmp;",
adamc@885 487 newline,
adamc@885 488 string "uw_error(ctx, FATAL, \"",
adamc@885 489 string (ErrorMsg.spanToString loc),
adamc@885 490 string ": Unexpectedly NULL field #",
adamc@885 491 string (Int.toString i),
adamc@885 492 string "\");",
adamc@885 493 newline,
adamc@885 494 string "tmp;",
adamc@885 495 newline,
adamc@885 496 string "})"],
adamc@885 497 string " : ",
adamc@885 498 p_unsql t,
adamc@885 499 string ")"]
adamc@885 500 in
adamc@885 501 getter t
adamc@885 502 end
adamc@885 503
adamc@885 504 fun queryCommon {loc, query, cols, doCols} =
adamc@885 505 box [string "int r;",
adamc@885 506 newline,
adamc@885 507
adamc@885 508 string "sqlite3_reset(stmt);",
adamc@885 509 newline,
adamc@885 510
adamc@885 511 string "uw_end_region(ctx);",
adamc@885 512 newline,
adamc@885 513 string "while ((r = sqlite3_step(stmt)) == SQLITE_ROW) {",
adamc@885 514 newline,
adamc@885 515 doCols p_getcol,
adamc@885 516 string "}",
adamc@885 517 newline,
adamc@885 518 newline,
adamc@885 519
adamc@885 520 string "if (r == SQLITE_BUSY) {",
adamc@885 521 box [string "sleep(1);",
adamc@885 522 newline,
adamc@885 523 string "uw_error(ctx, UNLIMITED_RETRY, \"Database is busy\");",
adamc@885 524 newline],
adamc@885 525 string "}",
adamc@885 526 newline,
adamc@885 527 newline,
adamc@885 528
adamc@885 529 string "if (r != SQLITE_DONE) uw_error(ctx, FATAL, \"",
adamc@885 530 string (ErrorMsg.spanToString loc),
adamc@1266 531 string ": query step failed: %s<br />%s\", ",
adamc@885 532 query,
adamc@885 533 string ", sqlite3_errmsg(conn->conn));",
adamc@885 534 newline,
adamc@885 535 newline]
adamc@885 536
adamc@885 537 fun query {loc, cols, doCols} =
adamc@885 538 box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@885 539 newline,
adamc@886 540 string "sqlite3_stmt *stmt;",
adamc@885 541 newline,
adamc@885 542 newline,
adamc@1266 543 string "if (sqlite3_prepare_v2(conn->conn, query, -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: %s<br />%s\", sqlite3_errmsg(conn->conn), query);",
adamc@885 544 newline,
adamc@885 545 newline,
adamc@885 546 string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_finalize, stmt);",
adamc@885 547 newline,
adamc@885 548 newline,
adamc@885 549
adamc@885 550 queryCommon {loc = loc, cols = cols, doCols = doCols, query = string "query"},
adamc@885 551
adamc@885 552 string "uw_pop_cleanup(ctx);",
adamc@885 553 newline]
adamc@885 554
adamc@1014 555 val p_pre_inputs =
adamc@1014 556 p_list_sepi (box [])
adamc@1014 557 (fn i => fn t =>
adamc@1014 558 case t of
adamc@1014 559 Char => box [string "char arg",
adamc@1014 560 string (Int.toString (i + 1)),
adamc@1014 561 string "s = {arg",
adamc@1014 562 string (Int.toString (i + 1)),
adamc@1014 563 string ", 0};",
adamc@1014 564 newline]
adamc@1014 565 | _ => box [])
adamc@1014 566
adamc@885 567 fun p_inputs loc =
adamc@885 568 p_list_sepi (box [])
adamc@885 569 (fn i => fn t =>
adamc@885 570 let
adamc@885 571 fun bind (t, arg) =
adamc@885 572 case t of
adamc@885 573 Int => box [string "sqlite3_bind_int64(stmt, ",
adamc@885 574 string (Int.toString (i + 1)),
adamc@885 575 string ", ",
adamc@885 576 arg,
adamc@885 577 string ")"]
adamc@885 578 | Float => box [string "sqlite3_bind_double(stmt, ",
adamc@885 579 string (Int.toString (i + 1)),
adamc@885 580 string ", ",
adamc@885 581 arg,
adamc@1014 582 string ")"]
adamc@885 583 | String => box [string "sqlite3_bind_text(stmt, ",
adamc@885 584 string (Int.toString (i + 1)),
adamc@885 585 string ", ",
adamc@885 586 arg,
adamc@885 587 string ", -1, SQLITE_TRANSIENT)"]
adamc@1014 588 | Char => box [string "sqlite3_bind_text(stmt, ",
adamc@1014 589 string (Int.toString (i + 1)),
adamc@1014 590 string ", ",
adamc@1014 591 arg,
adamc@1014 592 string "s, -1, SQLITE_TRANSIENT)"]
adamc@885 593 | Bool => box [string "sqlite3_bind_int(stmt, ",
adamc@885 594 string (Int.toString (i + 1)),
adamc@885 595 string ", ",
adamc@885 596 arg,
adamc@885 597 string ")"]
adamc@887 598 | Time => box [string "sqlite3_bind_text(stmt, ",
adamc@885 599 string (Int.toString (i + 1)),
adam@1359 600 string ", uw_Basis_timef(ctx, ",
adam@1352 601 string fmt,
adam@1352 602 string ", ",
adamc@885 603 arg,
adamc@887 604 string "), -1, SQLITE_TRANSIENT)"]
adamc@885 605 | Blob => box [string "sqlite3_bind_blob(stmt, ",
adamc@885 606 string (Int.toString (i + 1)),
adamc@885 607 string ", ",
adamc@885 608 arg,
adamc@885 609 string ".data, ",
adamc@885 610 arg,
adamc@890 611 string ".size, SQLITE_TRANSIENT)"]
adamc@886 612 | Channel => box [string "sqlite3_bind_int64(stmt, ",
adamc@885 613 string (Int.toString (i + 1)),
adamc@886 614 string ", ((sqlite3_int64)",
adamc@885 615 arg,
adamc@886 616 string ".cli << 32) | ",
adamc@886 617 arg,
adamc@886 618 string ".chn)"]
adamc@885 619 | Client => box [string "sqlite3_bind_int(stmt, ",
adamc@885 620 string (Int.toString (i + 1)),
adamc@885 621 string ", ",
adamc@885 622 arg,
adamc@885 623 string ")"]
adamc@885 624 | Nullable t => box [string "(",
adamc@885 625 arg,
adamc@885 626 string " == NULL ? sqlite3_bind_null(stmt, ",
adamc@885 627 string (Int.toString (i + 1)),
adamc@885 628 string ") : ",
adamc@885 629 bind (t, case t of
adamc@885 630 String => arg
adamc@885 631 | _ => box [string "(*", arg, string ")"]),
adamc@885 632 string ")"]
adamc@885 633 in
adamc@885 634 box [string "if (",
adamc@885 635 bind (t, box [string "arg", string (Int.toString (i + 1))]),
adamc@885 636 string " != SQLITE_OK) uw_error(ctx, FATAL, \"",
adamc@885 637 string (ErrorMsg.spanToString loc),
adamc@885 638 string ": Error binding parameter #",
adamc@885 639 string (Int.toString (i + 1)),
adamc@885 640 string ": %s\", sqlite3_errmsg(conn->conn));",
adamc@885 641 newline]
adamc@885 642 end)
adamc@885 643
adamc@885 644 fun queryPrepared {loc, id, query, inputs, cols, doCols, nested} =
adamc@885 645 box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@885 646 newline,
adamc@1014 647 p_pre_inputs inputs,
adamc@885 648 if nested then
adamc@885 649 box [string "sqlite3_stmt *stmt;",
adamc@885 650 newline]
adamc@885 651 else
adamc@885 652 box [string "sqlite3_stmt *stmt = conn->p",
adamc@885 653 string (Int.toString id),
adamc@885 654 string ";",
adamc@885 655 newline,
adamc@885 656 newline,
adamc@885 657
adamc@885 658 string "if (stmt == NULL) {",
adamc@885 659 newline],
adamc@885 660
adamc@885 661 string "if (sqlite3_prepare_v2(conn->conn, \"",
adam@1656 662 string (Prim.toCString query),
adamc@885 663 string "\", -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: ",
adam@1656 664 string (Prim.toCString query),
adamc@1266 665 string "<br />%s\", sqlite3_errmsg(conn->conn));",
adamc@885 666 newline,
adamc@885 667 if nested then
adamc@885 668 box [string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_finalize, stmt);",
adamc@885 669 newline]
adamc@885 670 else
adamc@885 671 box [string "conn->p",
adamc@885 672 string (Int.toString id),
adamc@885 673 string " = stmt;",
adamc@885 674 newline,
adamc@885 675 string "}",
adamc@885 676 newline,
adamc@885 677 newline,
adamc@885 678 string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_clear_bindings, stmt);",
adamc@885 679 newline,
adamc@885 680 string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_reset, stmt);",
adamc@885 681 newline],
adamc@885 682 newline,
adamc@885 683
adamc@885 684 p_inputs loc inputs,
adamc@885 685 newline,
adamc@885 686
adamc@885 687 queryCommon {loc = loc, cols = cols, doCols = doCols, query = box [string "\"",
adam@1656 688 string (Prim.toCString query),
adamc@885 689 string "\""]},
adamc@885 690
adamc@885 691 string "uw_pop_cleanup(ctx);",
adamc@885 692 newline,
adamc@885 693 if nested then
adamc@885 694 box []
adamc@885 695 else
adamc@885 696 box [string "uw_pop_cleanup(ctx);",
adamc@885 697 newline]]
adamc@885 698
adam@1293 699 fun dmlCommon {loc, dml, mode} =
adamc@885 700 box [string "int r;",
adamc@885 701 newline,
adamc@885 702
adamc@885 703 string "if ((r = sqlite3_step(stmt)) == SQLITE_BUSY) {",
adamc@885 704 box [string "sleep(1);",
adamc@885 705 newline,
adamc@885 706 string "uw_error(ctx, UNLIMITED_RETRY, \"Database is busy\");",
adamc@885 707 newline],
adamc@885 708 string "}",
adamc@885 709 newline,
adamc@885 710 newline,
adamc@885 711
adam@1293 712 string "if (r != SQLITE_DONE) ",
adam@1293 713 case mode of
adam@1293 714 Settings.Error => box [string "uw_error(ctx, FATAL, \"",
adam@1293 715 string (ErrorMsg.spanToString loc),
adam@1293 716 string ": DML step failed: %s<br />%s\", ",
adam@1293 717 dml,
adam@1293 718 string ", sqlite3_errmsg(conn->conn));"]
adam@1295 719 | Settings.None => string "uw_set_error_message(ctx, sqlite3_errmsg(conn->conn));",
adamc@885 720 newline]
adamc@885 721
adam@1293 722 fun dml (loc, mode) =
adamc@885 723 box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@885 724 newline,
adamc@886 725 string "sqlite3_stmt *stmt;",
adamc@885 726 newline,
adamc@885 727 newline,
adamc@1266 728 string "if (sqlite3_prepare_v2(conn->conn, dml, -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: %s<br />%s\", dml, sqlite3_errmsg(conn->conn));",
adamc@885 729 newline,
adamc@885 730 newline,
adamc@885 731 string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_finalize, stmt);",
adamc@885 732 newline,
adamc@885 733 newline,
adamc@885 734
adam@1293 735 dmlCommon {loc = loc, dml = string "dml", mode = mode},
adamc@885 736
adamc@885 737 string "uw_pop_cleanup(ctx);",
adamc@885 738 newline]
adamc@885 739
adam@1293 740 fun dmlPrepared {loc, id, dml, inputs, mode = mode} =
adamc@885 741 box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@885 742 newline,
adamc@1014 743 p_pre_inputs inputs,
adamc@885 744 string "sqlite3_stmt *stmt = conn->p",
adamc@885 745 string (Int.toString id),
adamc@885 746 string ";",
adamc@885 747 newline,
adamc@885 748 newline,
adamc@885 749
adamc@885 750 string "if (stmt == NULL) {",
adamc@885 751 newline,
adamc@885 752 box [string "if (sqlite3_prepare_v2(conn->conn, \"",
adam@1656 753 string (Prim.toCString dml),
adamc@885 754 string "\", -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: ",
adam@1656 755 string (Prim.toCString dml),
adamc@1266 756 string "<br />%s\", sqlite3_errmsg(conn->conn));",
adamc@885 757 newline,
adamc@885 758 string "conn->p",
adamc@885 759 string (Int.toString id),
adamc@885 760 string " = stmt;",
adamc@885 761 newline],
adamc@885 762 string "}",
adamc@885 763 newline,
adamc@885 764
adamc@885 765 string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_clear_bindings, stmt);",
adamc@885 766 newline,
adamc@885 767 string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_reset, stmt);",
adamc@885 768 newline,
adamc@885 769
adamc@885 770 p_inputs loc inputs,
adamc@885 771 newline,
adamc@885 772
adamc@885 773 dmlCommon {loc = loc, dml = box [string "\"",
adam@1656 774 string (Prim.toCString dml),
adam@1293 775 string "\""], mode = mode},
adamc@885 776
adamc@885 777 string "uw_pop_cleanup(ctx);",
adamc@885 778 newline,
adamc@885 779 string "uw_pop_cleanup(ctx);",
adamc@885 780 newline]
adamc@885 781
adamc@885 782 fun nextval {loc, seqE, seqName} =
adamc@885 783 box [string "uw_conn *conn = uw_get_db(ctx);",
adamc@885 784 newline,
adamc@885 785 string "char *insert = ",
adamc@885 786 case seqName of
adamc@886 787 SOME s => string ("\"INSERT INTO " ^ s ^ " VALUES (NULL)\"")
adamc@885 788 | NONE => box [string "uw_Basis_strcat(ctx, \"INSERT INTO \", uw_Basis_strcat(ctx, ",
adamc@885 789 seqE,
adamc@885 790 string ", \" VALUES ()\"))"],
adamc@885 791 string ";",
adamc@885 792 newline,
adamc@885 793 string "char *delete = ",
adamc@885 794 case seqName of
adamc@885 795 SOME s => string ("\"DELETE FROM " ^ s ^ "\"")
adamc@885 796 | NONE => box [string "uw_Basis_strcat(ctx, \"DELETE FROM \", ",
adamc@885 797 seqE,
adamc@885 798 string ")"],
adamc@885 799 string ";",
adamc@885 800 newline,
adamc@885 801 newline,
adamc@885 802
adamc@886 803 string "if (sqlite3_exec(conn->conn, insert, NULL, NULL, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"'nextval' INSERT failed: %s\", sqlite3_errmsg(conn->conn));",
adamc@885 804 newline,
adamc@885 805 string "n = sqlite3_last_insert_rowid(conn->conn);",
adamc@885 806 newline,
adamc@886 807 string "if (sqlite3_exec(conn->conn, delete, NULL, NULL, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"'nextval' DELETE failed: %s\", sqlite3_errmsg(conn->conn));",
adamc@885 808 newline]
adamc@885 809
adamc@885 810 fun nextvalPrepared _ = raise Fail "SQLite.nextvalPrepared called"
adamc@1073 811 fun setval _ = raise Fail "SQLite.setval called"
adamc@885 812
adamc@885 813 fun sqlifyString s = "'" ^ String.translate (fn #"'" => "''"
adam@1285 814 | #"\000" => ""
adam@1285 815 | ch => str ch)
adam@1285 816 s ^ "'"
adamc@885 817
adamc@885 818 fun p_cast (s, _) = s
adamc@885 819
adamc@885 820 fun p_blank _ = "?"
adamc@885 821
adamc@885 822 val () = addDbms {name = "sqlite",
adam@1682 823 randomFunction = "RANDOM",
adam@1464 824 header = Config.sqheader,
adamc@885 825 link = "-lsqlite3",
adamc@885 826 init = init,
adamc@885 827 p_sql_type = p_sql_type,
adamc@885 828 query = query,
adamc@885 829 queryPrepared = queryPrepared,
adamc@885 830 dml = dml,
adamc@885 831 dmlPrepared = dmlPrepared,
adamc@885 832 nextval = nextval,
adamc@885 833 nextvalPrepared = nextvalPrepared,
adamc@1073 834 setval = setval,
adamc@885 835 sqlifyString = sqlifyString,
adamc@885 836 p_cast = p_cast,
adamc@885 837 p_blank = p_blank,
adamc@885 838 supportsDeleteAs = false,
adamc@886 839 supportsUpdateAs = false,
adamc@886 840 createSequence = fn s => "CREATE TABLE " ^ s ^ " (id INTEGER PRIMARY KEY AUTOINCREMENT)",
adamc@885 841 textKeysNeedLengths = false,
adamc@885 842 supportsNextval = false,
adamc@885 843 supportsNestedPrepared = false,
adamc@890 844 sqlPrefix = "",
adamc@1014 845 supportsOctetLength = false,
adamc@1014 846 trueString = "1",
adamc@1196 847 falseString = "0",
adamc@1196 848 onlyUnion = false,
adamc@1196 849 nestedRelops = false}
adamc@885 850
adamc@885 851 end