# # patch "database.ml" # from [82e51dcfdfe30df1cb1b9b3b6d67b4741577333c] # to [f1bb243b8ab4e391f3f8ef9bc39f956ac881785c] # # patch "mlsqlite/ocaml-sqlite3.c" # from [e1aab6106508e6600672fd65bdf1150d2dfafb6f] # to [91b05b4b9f6dc8e1320b24d06f821ea9f080dc43] # # patch "mlsqlite/sqlite3.ml" # from [88c5a793cc14f64d0eb8faee9b7a24435da29c34] # to [b33ce0ac0c67b7d64039f2a9322128e8d38d49ee] # # patch "mlsqlite/sqlite3.mli" # from [e6308b42958630d1ccfd385d4f47c4e063f0b48d] # to [8c9624c03f134ddb2a0c1876f8e6b1c5accefd71] # ======================================================================== --- database.ml 82e51dcfdfe30df1cb1b9b3b6d67b4741577333c +++ database.ml f1bb243b8ab4e391f3f8ef9bc39f956ac881785c @@ -151,9 +151,18 @@ | _ -> g -let fetch_children db id f init = - Sqlite3.fetch_f db (fun acc row -> f acc row.(0)) init - "SELECT child FROM revision_ancestry WHERE parent = '%s'" id +let with_fetch_children db f = + Sqlite3.with_stmt + db "SELECT child FROM revision_ancestry WHERE parent = ?" + (fun stmt -> + f + (fun id f init -> + Sqlite3.reset stmt ; + Sqlite3.bind stmt 1 (`TEXT id) ; + Sqlite3.fold_rows + (fun acc stmt -> f acc (Sqlite3.column_text stmt 0)) + init + stmt)) let fetch_agraph_with_view db query = let agraph = Viz_types.empty_agraph in @@ -189,7 +198,7 @@ process_branching_edge_row agraph "SELECT parent, child \ FROM revision_ancestry AS A \ - WHERE A.child IN %s AND A.parent != '' AND \ + WHERE A.child IN %s AND A.parent NOTNULL AND \ NOT EXISTS \ (SELECT P.id FROM revision_certs AS C, revision_certs AS P \ WHERE C.id = A.child AND P.id = A.parent \ @@ -202,7 +211,10 @@ let agraph = if query = ALL then agraph - else Components.reconnect (fetch_children db) agraph in + else + with_fetch_children db + (fun fetch_children -> + Components.reconnect fetch_children agraph) in agraph @@ -274,17 +286,41 @@ "SELECT id, name, value, keypair, signature \ FROM revision_certs WHERE id = '%s'" id -let fetch_one_cert_field db id name = function - | `VALUE -> - Sqlite3.fetch_f db (fun acc row -> monot_decode row.(0) :: acc) [] - "SELECT value \ - FROM revision_certs WHERE id = '%s' AND name = '%s'" id (sql_escape name) - | `SIGNER -> - Sqlite3.fetch_f db (fun acc row -> row.(0) :: acc) [] - "SELECT keypair \ - FROM revision_certs WHERE id = '%s' AND name = '%s'" id (sql_escape name) +let prepare_fetch_one_cert_signer db = + Sqlite3.prepare_one db + "SELECT keypair FROM revision_certs WHERE id = ? AND name = ?" +let prepare_fetch_one_cert_value db = + Sqlite3.prepare_one db + "SELECT value FROM revision_certs WHERE id = ? AND name = ?" +let fetch_one_cert_field stmt id name kind = + Sqlite3.reset stmt ; + Sqlite3.bind stmt 1 (`TEXT id) ; + Sqlite3.bind stmt 2 (`TEXT name) ; + Sqlite3.fold_rows + (fun acc stmt -> + let v = Sqlite3.column_text stmt 0 in + match kind with + | `SIGNER -> v :: acc + | `VALUE -> monot_decode v :: acc) + [] + stmt +let get_matching_cert db name p = + List.rev + (Sqlite3.fetch_f db + (fun acc -> function + | [| id; v |] -> + let dv = monot_decode v in + if p dv + then (id, dv) :: acc + else acc + | _ -> acc) + [] + "SELECT id, value FROM revision_certs WHERE name = '%s'" name) + + + let spawn_monotone monotone_exe db_fname cmd status cb = let cmd = monotone_exe :: "--db" :: db_fname :: cmd in if Viz_misc.debug "exec" @@ -320,6 +356,7 @@ filename : string ; db : Sqlite3.db ; pubkeys : (string, Crypto.pub_rsa_key * int) Hashtbl.t ; + stmts : Sqlite3.stmt array ; } @@ -339,17 +376,21 @@ with Sqlite3.Error (_, msg) -> Viz_types.errorf "Could not open database %s:\n%s" fname msg in let pubkeys = Hashtbl.create 17 in + let stmts = [| prepare_fetch_one_cert_signer db ; + prepare_fetch_one_cert_value db |] in let v = { filename = fname ; db = db ; - pubkeys = pubkeys } in + pubkeys = pubkeys ; + stmts = stmts } in sqlite_try (fun db -> register_base64_functions db ; fetch_pubkeys db pubkeys) v ; v -let close_db { db = db } = +let close_db { db = db ; stmts = stmts } = + Array.iter Sqlite3.finalize_noerr stmts ; Sqlite3.close_db db let with_progress prg f db = @@ -389,29 +430,20 @@ fetch_certs db d.pubkeys id) d } let fetch_cert_signer db id name = - sqlite_try (fun _ -> fetch_one_cert_field db.db id name `SIGNER) db + sqlite_try (fun _ -> fetch_one_cert_field db.stmts.(0) id name `SIGNER) db let fetch_cert_value db id name = - sqlite_try (fun _ -> fetch_one_cert_field db.db id name `VALUE) db + sqlite_try (fun _ -> fetch_one_cert_field db.stmts.(1) id name `VALUE) db let get_key_rowid { pubkeys = pubkeys } id = let (_, rowid) = Hashtbl.find pubkeys id in rowid -let get_matching_cert db name p = - List.rev - (Sqlite3.fetch_f db.db - (fun acc -> function - | [| id; v |] when p v -> (id, v) :: acc - | _ -> acc) - [] - "SELECT id, unbase64(value) FROM revision_certs WHERE name = '%s'" name) - let get_matching_tags db p = - get_matching_cert db "tag" p + get_matching_cert db.db "tag" p let get_matching_dates db d_pref = - get_matching_cert db "date" + get_matching_cert db.db "date" (string_is_prefix d_pref) let run_monotone_diff db monotone_exe status cb (old_id, new_id) = ======================================================================== --- mlsqlite/ocaml-sqlite3.c e1aab6106508e6600672fd65bdf1150d2dfafb6f +++ mlsqlite/ocaml-sqlite3.c 91b05b4b9f6dc8e1320b24d06f821ea9f080dc43 @@ -1,6 +1,8 @@ #include #include +#define CAML_NAME_SPACE + #include #include #include @@ -12,6 +14,52 @@ #define TRUE 1 #define FALSE 0 +/* Not wrapped : + - user-defined aggregate functions + - collation functions + - sqlite3_db_handle -> should not be wrapped ! + - sqlite3_commit_hook + - sqlite3_global_recover + - sqlite3_set_authorizer +*/ + + + +/* Error handling */ + +static void ml_sqlite3_raise_exn (int, const char *, int) Noreturn; +#define raise_sqlite3_exn(db) ml_sqlite3_raise_exn (sqlite3_errcode (Sqlite3_val(db)), sqlite3_errmsg (Sqlite3_val(db)), TRUE) + +static void ml_sqlite3_raise_exn (int status, const char *errmsg, int static_errmsg) +{ + static value *sqlite3_exn; + + /* check this is really an error */ + assert (status > SQLITE_OK && status < SQLITE_ROW); + + if (sqlite3_exn == NULL) + { + sqlite3_exn = caml_named_value ("mlsqlite3_exn"); + if (sqlite3_exn == NULL) + caml_failwith ("Sqlite3 exception not registered"); + } + + { + CAMLlocal1(bucket); + bucket = caml_alloc (3, 0); + Store_field(bucket, 0, *sqlite3_exn); + Store_field(bucket, 1, Val_long (status - 1)); + Store_field(bucket, 2, caml_copy_string (errmsg ? (char *) errmsg : "")); + if (! static_errmsg) + sqlite3_free ((char *) errmsg); + caml_raise (bucket); + } +} + + + + +/* Memory management of sqlite3* values */ struct user_function { value fun; struct user_function *next; @@ -22,29 +70,69 @@ value callbacks; struct user_function *user_functions; }; + +#define Sqlite3_data_val(v) (* ((struct ml_sqlite3_data **) Data_custom_val(v))) + +#if defined(__GNUC__) && (__GNUC__ >= 3) +# define Pure __attribute__ ((pure)) +#else +# define Pure +#endif + +static sqlite3 * Sqlite3_val (value) Pure; +static sqlite3_stmt * Sqlite3_stmt_val (value) Pure; +static sqlite3_value * Sqlite3_value_val (value) Pure; + +static inline sqlite3 * +Sqlite3_val (value v) +{ + struct ml_sqlite3_data *data = Sqlite3_data_val (v); + if (data->db == NULL) + ml_sqlite3_raise_exn (SQLITE_MISUSE, "closed db", TRUE); + return data->db; +} + +static inline sqlite3_stmt * +Sqlite3_stmt_val (value v) +{ + sqlite3_stmt *stmt = * ((sqlite3_stmt **) Field (v, 0)); + if (stmt == NULL) + ml_sqlite3_raise_exn (SQLITE_MISUSE, "invalid statement", TRUE); + return stmt; +} + +static inline sqlite3_value * +Sqlite3_value_val (value v) +{ + sqlite3_value *val = * ((sqlite3_value **) v); + if (val == NULL) + ml_sqlite3_raise_exn (SQLITE_MISUSE, "invalid value", TRUE); + return val; +} + + + /* 0 -> trace * 1 -> busy * 2 -> progress */ #define NUM_CALLBACKS 3 -#define Sqlite3_data_val(v) (* ((struct ml_sqlite3_data **) Data_custom_val(v))) -#define Sqlite3_val(v) (Sqlite3_data_val(v)->db) static void -ml_sqlite3_finalize (value v) +ml_finalize_sqlite3 (value v) { struct user_function *list, *next;; struct ml_sqlite3_data *data = Sqlite3_data_val(v); - remove_global_root (&data->callbacks); + caml_remove_global_root (&data->callbacks); list = data->user_functions; while (list != NULL) { - remove_global_root (&list->fun); + caml_remove_global_root (&list->fun); next = list->next; - stat_free (list); + caml_stat_free (list); list = next; } - stat_free (data); + caml_stat_free (data); } static value @@ -52,52 +140,29 @@ { static struct custom_operations ops = { "mlsqlite3/001", - ml_sqlite3_finalize + ml_finalize_sqlite3, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default }; CAMLparam0(); CAMLlocal1(v); struct ml_sqlite3_data **store, *data; - data = stat_alloc (sizeof *data); - v = alloc_custom (&ops, sizeof data, 1, 100); + data = caml_stat_alloc (sizeof *data); + v = caml_alloc_custom (&ops, sizeof data, 1, 100); store = Data_custom_val (v); *store = data; data->db = db; - data->callbacks = alloc (NUM_CALLBACKS, 0); + data->callbacks = caml_alloc (NUM_CALLBACKS, 0); data->user_functions = NULL; - register_global_root (&data->callbacks); + caml_register_global_root (&data->callbacks); CAMLreturn(v); } - -static void ml_sqlite3_raise_exn (int, char *, int) Noreturn; -static void ml_sqlite3_raise_exn (int status, char *errmsg, int static_errmsg) +CAMLprim value +ml_sqlite3_open (value filename) { - static value *sqlite3_exn; - - /* check this is really an error */ - assert (status > SQLITE_OK && status < SQLITE_ROW); - - if (sqlite3_exn == NULL) - { - sqlite3_exn = caml_named_value ("mlsqlite3_exn"); - if (sqlite3_exn == NULL) - failwith ("Sqlite3 exception not registered"); - } - - { - CAMLlocal1(bucket); - bucket = alloc (3, 0); - Store_field(bucket, 0, *sqlite3_exn); - Store_field(bucket, 1, Val_long (status - 1)); - Store_field(bucket, 2, copy_string (errmsg ? errmsg : "")); - if (!static_errmsg) - sqlite3_free (errmsg); - mlraise (bucket); - } -} - -CAMLprim value ml_sqlite3_open (value filename) -{ sqlite3 *db; int status; @@ -113,201 +178,102 @@ return ml_wrap_sqlite3 (db); } -CAMLprim value ml_sqlite3_close (value db) +CAMLprim value +ml_sqlite3_close (value db) { - int status; - status = sqlite3_close (Sqlite3_val(db)); - if (status != SQLITE_OK) + struct ml_sqlite3_data *data = Sqlite3_data_val(db); + if (data->db != NULL) { - char *errmsg; - errmsg = (char *) sqlite3_errmsg (Sqlite3_val (db)); - ml_sqlite3_raise_exn (status, errmsg, TRUE); + int status; + status = sqlite3_close (data->db); + if (status != SQLITE_OK) + raise_sqlite3_exn (db); + data->db = NULL; } - Sqlite3_val(db) = NULL; return Val_unit; } -struct cb_data { - value *closure; - value *accum; - value *column_names_array; - int option_string; - enum { - COLUMN_NAMES_NEED_STORE, - COLUMN_NAMES_STORED - } columns; -}; -static value -copy_opt_string (char *s) -{ - if (s == NULL) - return Val_unit; - else - { - CAMLparam0(); - CAMLlocal2(str, b); + +/* Misc general functions */ - str = copy_string(s); - b = alloc_small(1, 0); - Field(b, 0) = str; - CAMLreturn(b); - } +CAMLprim value +ml_sqlite3_interrupt (value db) +{ + sqlite3_interrupt (Sqlite3_val (db)); + return Val_unit; } -static value -ml_copy_string_array (int len, char **s_arr, int option_string) +CAMLprim value +ml_sqlite3_complete (value sql) { - unsigned int i; - CAMLparam0(); - CAMLlocal2(arr, tmp); - - if (len <= 0 || s_arr == NULL) - CAMLreturn (Atom(0)); - - arr = alloc (len, 0); - for (i=0; icolumns == COLUMN_NAMES_NEED_STORE && - Is_block (*cb_data->column_names_array)) - { - CAMLlocal2 (ref, ml_col_names); - /* column_names_array if of type `array ref option' */ - ref = Field (*cb_data->column_names_array, 0); - ml_col_names = ml_copy_string_array (argc, col_names, 0); - Store_field (ref, 0, ml_col_names); - cb_data->columns = COLUMN_NAMES_STORED; - } - - values = ml_copy_string_array (argc, argv, cb_data->option_string); - - res = callback2_exn (*cb_data->closure, *cb_data->accum, values); - *cb_data->accum = res; - if (Is_exception_result (res)) - CAMLreturn (SQLITE_ERROR); - - CAMLreturn (SQLITE_OK); + return caml_copy_string (sqlite3_version); } -static value -ml_sqlite3_fetch_gen (value db, value sql, - value o_col_names, - value cb, value init, int opt_string) +CAMLprim value +ml_sqlite3_last_insert_rowid (value db) { - CAMLparam5 (db, sql, o_col_names, cb, init); - CAMLlocal1 (accum); - struct cb_data cb_data = { &cb, &accum, &o_col_names, - opt_string, COLUMN_NAMES_NEED_STORE }; - char *sql_copy, *errmsg; - int status; - - errmsg = NULL; - accum = init; - sql_copy = stat_alloc (string_length (sql) + 1); - strcpy (sql_copy, String_val (sql)); - status = sqlite3_exec (Sqlite3_val (db), sql_copy, - ml_sqlite3_callback, &cb_data, &errmsg); - stat_free (sql_copy); - if (status != SQLITE_OK) - { - if (Is_exception_result (accum)) - { - sqlite3_free (errmsg); /* should be NULL actually */ - mlraise (Extract_exception (accum)); - } - else - ml_sqlite3_raise_exn (status, errmsg, FALSE); - } - CAMLreturn(accum); + return caml_copy_int64 (sqlite3_last_insert_rowid (Sqlite3_val (db))); } -CAMLprim value -ml_sqlite3_fetch (value db, value sql, - value o_col_names, - value cb, value init) +CAMLprim value +ml_sqlite3_changes (value db) { - return ml_sqlite3_fetch_gen (db, sql, o_col_names, cb, init, FALSE); + return Val_long (sqlite3_changes (Sqlite3_val (db))); } -CAMLprim value -ml_sqlite3_fetch_opt (value db, value sql, - value o_col_names, - value cb, value init) +CAMLprim value +ml_sqlite3_total_changes (value db) { - return ml_sqlite3_fetch_gen (db, sql, o_col_names, cb, init, TRUE); + return Val_long (sqlite3_total_changes (Sqlite3_val (db))); } -CAMLprim value -ml_sqlite3_exec (value db, value sql) +CAMLprim value +ml_sqlite3_get_autocommit (value db) { - CAMLparam2(db, sql); - char *sql_copy, *errmsg; - int status; - - sql_copy = stat_alloc (string_length (sql) + 1); - strcpy (sql_copy, String_val (sql)); - status = sqlite3_exec (Sqlite3_val (db), sql_copy, - NULL, NULL, &errmsg); - stat_free (sql_copy); - if (status != SQLITE_OK) - ml_sqlite3_raise_exn (status, errmsg, FALSE); - - CAMLreturn(Val_unit); + return Val_bool (sqlite3_get_autocommit (Sqlite3_val (db))); } -CAMLprim value -ml_sqlite3_interrupt (value db) +CAMLprim value +ml_sqlite3_sleep (value ms) { - sqlite3_interrupt (Sqlite3_val (db)); - return Val_unit; +#if 0 + return Val_int (sqlite3_sleep (Int_val (ms))); +#else + caml_failwith ("sqlite3_sleep unavailable"); +#endif } -CAMLprim value ml_sqlite3_complete (value sql) -{ - return Val_bool (sqlite3_complete (String_val (sql))); -} + +/* callbacks */ -#define MLTAG_RETRY 0xc96e9e91 -#define MLTAG_FAIL 0x5ced03bd +#define MLTAG_RETRY 0xc96e9e91L +#define MLTAG_FAIL 0x5ced03bdL static int ml_sqlite3_busy_handler_cb (void *data, int num) { struct ml_sqlite3_data *db = data; value res; - res = callback_exn (Field (db->callbacks, 0), Val_int (num)); + res = caml_callback_exn (Field (db->callbacks, 0), Val_int (num)); if (Is_exception_result (res)) return 0; - if (res == MLTAG_RETRY) - return 1; - else - return 0; + return (res == MLTAG_RETRY); } CAMLprim value ml_sqlite3_busy_handler (value db, value cb) { struct ml_sqlite3_data *db_data = Sqlite3_data_val(db); - Store_field (db_data->callbacks, 0, cb); sqlite3_busy_handler (Sqlite3_val(db), ml_sqlite3_busy_handler_cb, db_data); + Store_field (db_data->callbacks, 0, cb); return Val_unit; } @@ -315,8 +281,8 @@ ml_sqlite3_busy_handler_unset (value db) { struct ml_sqlite3_data *db_data = Sqlite3_data_val(db); - Store_field (db_data->callbacks, 0, Val_unit); sqlite3_busy_handler (Sqlite3_val(db), NULL, NULL); + Store_field (db_data->callbacks, 0, Val_unit); return Val_unit; } @@ -331,16 +297,16 @@ ml_sqlite3_trace_handler (void *data, const char *req) { struct ml_sqlite3_data *db = data; - value s = copy_string (req); - callback_exn (Field (db->callbacks, 1), s); + value s = caml_copy_string (req); + caml_callback_exn (Field (db->callbacks, 1), s); } CAMLprim value ml_sqlite3_trace (value db, value cb) { struct ml_sqlite3_data *db_data = Sqlite3_data_val(db); - Store_field (db_data->callbacks, 1, cb); sqlite3_trace (Sqlite3_val (db), ml_sqlite3_trace_handler, db_data); + Store_field (db_data->callbacks, 1, cb); return Val_unit; } @@ -348,8 +314,8 @@ ml_sqlite3_trace_unset (value db) { struct ml_sqlite3_data *db_data = Sqlite3_data_val(db); - Store_field (db_data->callbacks, 1, Val_unit); sqlite3_trace (Sqlite3_val (db), NULL, NULL); + Store_field (db_data->callbacks, 1, Val_unit); return Val_unit; } @@ -358,7 +324,7 @@ { struct ml_sqlite3_data *db = data; value res; - res = callback_exn (Field (db->callbacks, 2), Val_unit); + res = caml_callback_exn (Field (db->callbacks, 2), Val_unit); return Is_exception_result(res); } @@ -366,9 +332,9 @@ ml_sqlite3_progress_handler (value db, value delay, value cb) { struct ml_sqlite3_data *db_data = Sqlite3_data_val(db); - Store_field (db_data->callbacks, 2, cb); sqlite3_progress_handler (Sqlite3_val (db), Int_val (delay), ml_sqlite3_progress_handler_cb, db_data); + Store_field (db_data->callbacks, 2, cb); return Val_unit; } @@ -376,36 +342,385 @@ ml_sqlite3_progress_handler_unset (value db) { struct ml_sqlite3_data *db_data = Sqlite3_data_val(db); + sqlite3_progress_handler (Sqlite3_val(db), 0, NULL, NULL); Store_field (db_data->callbacks, 2, Val_unit); - sqlite3_progress_handler (Sqlite3_val(db), 0, NULL, NULL); return Val_unit; } -CAMLprim value -ml_sqlite3_version (value unit) + + +#define MLTAG_INTEGER 0x2ddf233dL +#define MLTAG_FLOAT 0x0109faf9L +#define MLTAG_TEXT 0x6f75295bL +#define MLTAG_BLOB 0x57b40abbL +#define MLTAG_NULL 0x679ecd0fL + +#define MLTAG_INT 0x006f519f +#define MLTAG_INT64 0x781dd39b +#define MLTAG_VALUE 0x5f4d6ea3 + +static value +convert_sqlite3_type (int t) { - return copy_string (sqlite3_version); + switch (t) + { + case SQLITE_INTEGER: + return MLTAG_INTEGER; + case SQLITE_FLOAT: + return MLTAG_FLOAT; + case SQLITE_TEXT: + return MLTAG_TEXT; + case SQLITE_BLOB: + return MLTAG_BLOB; + default: + return MLTAG_NULL; + } } + + + +/* Prepared statements */ + +static int +ml_sqlite3_finalize_stmt (value s, sqlite3 **db) +{ + int status = SQLITE_OK; + sqlite3_stmt **p_stmt = (sqlite3_stmt **) Field (s, 0); + + if (*p_stmt != NULL) + { + if (db != NULL) + *db = sqlite3_db_handle (*p_stmt); + status = sqlite3_finalize (*p_stmt); + *p_stmt = NULL; + } + return status; +} + CAMLprim value -ml_sqlite3_last_insert_rowid (value db) +ml_sqlite3_finalize (value v) { - return copy_int64 (sqlite3_last_insert_rowid (Sqlite3_val (db))); + int status; + sqlite3 *db; + + status = ml_sqlite3_finalize_stmt (v, &db); + if (status != SQLITE_OK) + ml_sqlite3_raise_exn (status, sqlite3_errmsg (db), TRUE); + return Val_unit; } CAMLprim value -ml_sqlite3_changes (value db) +ml_sqlite3_finalize_noerr (value v) { - return Val_long (sqlite3_changes (Sqlite3_val (db))); + ml_sqlite3_finalize_stmt (v, NULL); + return Val_unit; } +static sqlite3_stmt * +ml_sqlite3_prepare_stmt (value db, value sql, value sql_off, unsigned int *tail_pos) +{ + CAMLparam2(db, sql); + sqlite3_stmt *stmt = NULL; + const char *tail; + int status; + unsigned int off = Unsigned_int_val (sql_off); + status = sqlite3_prepare (Sqlite3_val (db), + String_val (sql) + off, + caml_string_length (sql) - off, + &stmt, &tail); + if (status != SQLITE_OK) + { + if (stmt != NULL) + sqlite3_finalize (stmt); + raise_sqlite3_exn (db); + } + if (tail_pos != NULL) + *tail_pos = tail - String_val (sql); + CAMLreturn (stmt); +} + CAMLprim value -ml_sqlite3_total_changes (value db) +ml_sqlite3_prepare (value db, value sql, value sql_off) { - return Val_long (sqlite3_total_changes (Sqlite3_val (db))); + CAMLparam2(db, sql); + CAMLlocal4(t, o, r, s); + sqlite3_stmt *stmt; + unsigned int tail_pos; + + stmt = ml_sqlite3_prepare_stmt (db, sql, sql_off, &tail_pos); + if (stmt == NULL) + o = Val_unit; + else + { + s = caml_alloc_small (1, Abstract_tag); + Field (s, 0) = Val_bp (stmt); + r = caml_alloc_small (4, 0); + Field (r, 0) = s; + Field (r, 1) = db; + Field (r, 2) = sql; + Field (r, 3) = sql_off; + o = caml_alloc_small (1, 0); + Field (o, 0) = r; + } + t = caml_alloc_small (2, 0); + Field (t, 0) = o; + Field (t, 1) = Val_int (tail_pos); + CAMLreturn (t); } +static sqlite3_stmt * +ml_sqlite3_recompile (value v, sqlite3_stmt *old_stmt) +{ + CAMLparam1(v); + CAMLlocal1(s); + sqlite3_stmt *stmt; + + stmt = ml_sqlite3_prepare_stmt (Field (v, 1), Field (v, 2), Field (v, 3), NULL); + if (stmt == NULL) + caml_failwith ("Sqlite3.recompile"); + if (old_stmt != NULL) + { + sqlite3_transfer_bindings (old_stmt, stmt); + sqlite3_finalize (old_stmt); + } + + s = caml_alloc_small (1, Abstract_tag); + Field (s, 0) = Val_bp (stmt); + Store_field (v, 0, s); + CAMLreturn (stmt); +} + +CAMLprim value +ml_sqlite3_reset (value stmt) +{ + sqlite3_stmt *s = * ((sqlite3_stmt **) Field (stmt, 0)); + if (s == NULL) + ml_sqlite3_recompile (stmt, NULL); + else + sqlite3_reset (s); + return Val_unit; +} + +CAMLprim value +ml_sqlite3_expired (value stmt) +{ + sqlite3_stmt *s = * ((sqlite3_stmt **) Field (stmt, 0)); + return Val_bool (s ? sqlite3_expired (s) : TRUE); +} + +#define MLTAG_ROW 0x007cfbf5L +#define MLTAG_DONE 0x5a5d7105L + +CAMLprim value +ml_sqlite3_step (value stmt) +{ + CAMLparam1(stmt); + CAMLlocal1(r); + int status; + sqlite3_stmt *s = Sqlite3_stmt_val (stmt); + + again: + status = sqlite3_step (s); + switch (status) + { + case SQLITE_ROW: + r = MLTAG_ROW; break; + case SQLITE_DONE: + r = MLTAG_DONE; break; + default: /* either BUSY, ERROR or MISUSE */ + { + sqlite3 *db; + if (sqlite3_expired (s)) + { + s = ml_sqlite3_recompile (stmt, s); + goto again; + } + status = ml_sqlite3_finalize_stmt (stmt, &db); + ml_sqlite3_raise_exn (status, sqlite3_errmsg (db), TRUE); + } + } + CAMLreturn (r); +} + + +/* sqlite3_bind_* */ + +CAMLprim value +ml_sqlite3_bind (value s, value idx, value v) +{ + sqlite3_stmt *stmt = Sqlite3_stmt_val (s); + int i = Int_val (idx); + int status; + + if (Is_long (v)) + status = sqlite3_bind_null (stmt, i); + else + { + value val = Field (v, 1); + switch (Field (v, 0)) + { + case MLTAG_INT: + status = sqlite3_bind_int (stmt, i, Int_val (val)); break; + case MLTAG_INT64: + status = sqlite3_bind_int64 (stmt, i, Int64_val (val)); break; + case MLTAG_FLOAT: + status = sqlite3_bind_double (stmt, i, Double_val (val)); break; + case MLTAG_TEXT: + status = sqlite3_bind_text (stmt, i, + String_val (val), + caml_string_length (val), + SQLITE_TRANSIENT); + break; + case MLTAG_BLOB: + status = sqlite3_bind_blob (stmt, i, + String_val (val), + caml_string_length (val), + SQLITE_TRANSIENT); + break; + case MLTAG_VALUE: +#if 0 + status = sqlite3_bind_value (stmt, i, Sqlite3_value_val (val)); break; +#else + caml_failwith ("sqlite3_bind_value unavailable"); +#endif + default: + status = SQLITE_MISUSE; + } + } + if (status != SQLITE_OK) + ml_sqlite3_raise_exn (status, "sqlite3_bind failed", TRUE); + return Val_unit; +} + +CAMLprim value +ml_sqlite3_bind_parameter_count (value s) +{ + return Val_int (sqlite3_bind_parameter_count (Sqlite3_stmt_val (s))); +} + +CAMLprim value +ml_sqlite3_bind_parameter_index (value s, value n) +{ + return Val_int (sqlite3_bind_parameter_index (Sqlite3_stmt_val (s), + String_val(n))); +} + +CAMLprim value +ml_sqlite3_bind_parameter_name (value s, value idx) +{ + return caml_copy_string (sqlite3_bind_parameter_name (Sqlite3_stmt_val (s), + Int_val (idx))); +} + +CAMLprim value +ml_sqlite3_clear_bindings (value s) +{ +#if 0 + int status; + status = sqlite3_clear_bindings (Sqlite3_stmt_val (s)); + if (status != SQLITE_OK) + ml_sqlite3_raise_exn (status, "clear_bindings failed", TRUE); + return Val_unit; +#else + caml_failwith ("sqlite3_clear_bindings unavailable"); +#endif +} + +CAMLprim value +ml_sqlite3_transfer_bindings (value s1, value s2) +{ + int status; + status = sqlite3_transfer_bindings (Sqlite3_stmt_val (s1), + Sqlite3_stmt_val (s2)); + if (status != SQLITE_OK) + ml_sqlite3_raise_exn (status, "transfer_bindings failed", TRUE); + return Val_unit; +} + + +/* sqlite3_column_* */ + +CAMLprim value +ml_sqlite3_column_blob (value s, value i) +{ + CAMLparam1(s); + CAMLlocal1(r); + int len; + const void * data; + len = sqlite3_column_bytes (Sqlite3_stmt_val (s), Int_val (i)); + r = caml_alloc_string (len); + data = sqlite3_column_blob (Sqlite3_stmt_val (s), Int_val(i)); + memcpy (Bp_val (r), data, len); + CAMLreturn(r); +} + +CAMLprim value +ml_sqlite3_column_double (value s, value i) +{ + return caml_copy_double (sqlite3_column_double (Sqlite3_stmt_val (s), Int_val(i))); +} + +CAMLprim value +ml_sqlite3_column_int (value s, value i) +{ + return Val_int (sqlite3_column_int (Sqlite3_stmt_val (s), Int_val(i))); +} + +CAMLprim value +ml_sqlite3_column_int64 (value s, value i) +{ + return caml_copy_int64 (sqlite3_column_int64 (Sqlite3_stmt_val (s), Int_val(i))); +} + +CAMLprim value +ml_sqlite3_column_text (value s, value i) +{ + CAMLparam1(s); + CAMLlocal1(r); + int len; + const void * data; + len = sqlite3_column_bytes (Sqlite3_stmt_val (s), Int_val (i)); + r = caml_alloc_string (len); + data = sqlite3_column_text (Sqlite3_stmt_val (s), Int_val(i)); + memcpy (Bp_val (r), data, len); + CAMLreturn(r); +} + +CAMLprim value +ml_sqlite3_column_type (value s, value i) +{ + return convert_sqlite3_type (sqlite3_column_type (Sqlite3_stmt_val (s), Int_val(i))); +} + +CAMLprim value +ml_sqlite3_data_count (value s) +{ + return Val_int (sqlite3_data_count (Sqlite3_stmt_val (s))); +} + +CAMLprim value +ml_sqlite3_column_count (value s) +{ + return Val_int (sqlite3_column_count (Sqlite3_stmt_val (s))); +} + +CAMLprim value +ml_sqlite3_column_name (value s, value i) +{ + return caml_copy_string (sqlite3_column_name (Sqlite3_stmt_val (s), + Int_val(i))); +} + +CAMLprim value +ml_sqlite3_column_decltype (value s, value i) +{ + return caml_copy_string (sqlite3_column_decltype (Sqlite3_stmt_val (s), + Int_val(i))); +} + + /* User-defined functions */ static struct user_function * @@ -414,13 +729,13 @@ CAMLparam2(name, cb); CAMLlocal1(cell); struct user_function *link; - cell = alloc (2, 0); + cell = caml_alloc (2, 0); Store_field (cell, 0, name); Store_field (cell, 1, cb); - link = stat_alloc (sizeof *link); + link = caml_stat_alloc (sizeof *link); link->fun = cell; link->next = db_data->user_functions; - register_global_root (&link->fun); + caml_register_global_root (&link->fun); db_data->user_functions = link; CAMLreturn(link); } @@ -439,8 +754,8 @@ db_data->user_functions = link->next; else prev->next = link->next; - remove_global_root (&link->fun); - stat_free (link); + caml_remove_global_root (&link->fun); + caml_stat_free (link); break; } prev = link; @@ -454,12 +769,12 @@ int i; CAMLparam0(); CAMLlocal2(a, v); - if (argc == 0 || args == NULL) + if (argc <= 0 || args == NULL) CAMLreturn (Atom (0)); - a = alloc (argc, 0); + a = caml_alloc (argc, 0); for (i=0; ifun, 1), args); + res = caml_callback_exn (Field (data->fun, 1), args); ml_sqlite3_set_result (ctx, res); ml_sqlite3_wipe_values (args); CAMLreturn0; @@ -605,18 +887,19 @@ CAMLprim value ml_sqlite3_create_function (value db, value name, value nargs, value fun) { - CAMLparam4(db, name, nargs, fun); + CAMLparam3(db, name, fun); int status; - struct user_function *param = register_user_function (Sqlite3_data_val(db), - name, fun); - status = sqlite3_create_function (Sqlite3_val (db), String_val (name), + sqlite3 *s_db = Sqlite3_val(db); + struct user_function *param; + + param = register_user_function (Sqlite3_data_val(db), name, fun); + status = sqlite3_create_function (s_db, String_val (name), Int_val (nargs), SQLITE_UTF8, param, ml_sqlite3_user_function, NULL, NULL); if (status != SQLITE_OK) { - char *errmsg; - errmsg = (char *) sqlite3_errmsg (Sqlite3_val (db)); - ml_sqlite3_raise_exn (status, errmsg, TRUE); + unregister_user_function (Sqlite3_data_val(db), name); + raise_sqlite3_exn (db); } CAMLreturn(Val_unit); } @@ -625,15 +908,12 @@ ml_sqlite3_delete_function (value db, value name) { int status; - status = sqlite3_create_function (Sqlite3_val (db), String_val (name), - 0, SQLITE_UTF8, NULL, + status = sqlite3_create_function (Sqlite3_val (db), + String_val (name), + 0, SQLITE_UTF8, NULL, NULL, NULL, NULL); if (status != SQLITE_OK) - { - char *errmsg; - errmsg = (char *) sqlite3_errmsg (Sqlite3_val (db)); - ml_sqlite3_raise_exn (status, errmsg, TRUE); - } + raise_sqlite3_exn (db); unregister_user_function (Sqlite3_data_val(db), name); return Val_unit; } ======================================================================== --- mlsqlite/sqlite3.ml 88c5a793cc14f64d0eb8faee9b7a24435da29c34 +++ mlsqlite/sqlite3.ml b33ce0ac0c67b7d64039f2a9322128e8d38d49ee @@ -1,9 +1,16 @@ - type db +type stmt +type argument +type sql_type = [`INTEGER|`FLOAT|`TEXT|`BLOB|`NULL] +type sql_value = [ + | `INT of int + | `INT64 of int64 + | `FLOAT of float + | `TEXT of string + | `BLOB of string + | `VALUE of argument + | `NULL ] -external open_db : string -> db = "ml_sqlite3_open" -external close_db : db -> unit = "ml_sqlite3_close" - type error_code = | ERROR | INTERNAL @@ -36,22 +43,19 @@ let init = Callback.register_exception "mlsqlite3_exn" (Error (ERROR, "")) -external exec : db -> string -> unit = "ml_sqlite3_exec" -let exec_f db fmt = - Printf.kprintf (exec db) fmt -external fetch : - db -> string -> - ?column_names:string array ref -> - ('a -> string array -> 'a) -> 'a -> 'a = "ml_sqlite3_fetch" -external fetch_opt : - db -> string -> ?column_names:string array ref -> - ('a -> string option array -> 'a) -> 'a -> 'a = "ml_sqlite_fetch3_opt" -let fetch_f db ?column_names f init fmt = - Printf.kprintf (fun q -> fetch db q ?column_names f init) fmt +external open_db : string -> db = "ml_sqlite3_open" +external close_db : db -> unit = "ml_sqlite3_close" + external interrupt : db -> unit = "ml_sqlite3_interrupt" - external is_complete : string -> bool = "ml_sqlite3_complete" +external _version : unit -> string = "ml_sqlite3_version" +let version = _version () +external last_insert_rowid : db -> int64 = "ml_sqlite3_last_insert_rowid" +external changes : db -> int = "ml_sqlite3_changes" +external total_changes : db -> int = "ml_sqlite3_total_changes" +external get_autocommit : db -> bool = "ml_sqlite3_get_autocommit" +external sleep : int -> unit = "ml_sqlite3_sleep" external busy_set : db -> (int -> [`FAIL|`RETRY]) -> unit = "ml_sqlite3_busy_handler" @@ -65,26 +69,83 @@ = "ml_sqlite3_progress_handler" external progress_handler_unset : db -> unit = "ml_sqlite3_progress_handler_unset" -external version : unit -> string = "ml_sqlite3_version" +(* type vm *) +(* type stmt = { *) +(* mutable vm : vm ; *) +(* db : db ; *) +(* sql : string ; *) +(* sql_off : int *) +(* } *) -type sql_value -external value_blob : sql_value -> string = "ml_sqlite3_value_blob" -external value_double : sql_value -> float = "ml_sqlite3_value_double" -external value_int : sql_value -> int = "ml_sqlite3_value_int" -external value_int64 : sql_value -> int64 = "ml_sqlite3_value_int64" -external value_text : sql_value -> string = "ml_sqlite3_value_text" -external value_type : sql_value -> [`INTEGER|`FLOAT|`TEXT|`BLOB|`NULL] = "ml_sqlite3_value_type" +external finalize : stmt -> unit = "ml_sqlite3_finalize" +external finalize_noerr : stmt -> unit = "ml_sqlite3_finalize_noerr" +external prepare : db -> string -> int -> stmt option * int = "ml_sqlite3_prepare" -type user_fun_result = [ - | `INT of int - | `INT64 of int64 - | `FLOAT of float - | `TEXT of string - | `BLOB of string - | `VALUE of sql_value - | `NULL ] +let _prepare_one db sql = + match prepare db sql 0 with + | Some stmt, _ -> stmt + | None, _ -> failwith "Sqlite3.prepare_one: empty statement" + +let prepare_one db sql = + _prepare_one db (String.copy sql) + +let prepare_one_f db fmt = + Printf.kprintf (_prepare_one db) fmt + +let with_stmt db sql f = + let stmt = prepare_one db sql in + let r = + try f stmt + with exn -> finalize_noerr stmt ; raise exn in + finalize_noerr stmt ; + r + +let prepare_all db sql = + let rec proc acc off = + if off >= String.length sql + then List.rev acc + else + match + try prepare db sql off + with exn -> + List.iter finalize_noerr acc ; + raise exn + with + | Some stmt, nxt -> proc (stmt :: acc) nxt + | None, nxt -> proc acc nxt in + proc [] 0 + +external reset : stmt -> unit = "ml_sqlite3_reset" +external expired : stmt -> bool = "ml_sqlite3_expired" +external step : stmt -> [`DONE|`ROW] = "ml_sqlite3_step" + +external bind : stmt -> int -> sql_value -> unit = "ml_sqlite3_bind" +external bind_parameter_count : stmt -> int = "ml_sqlite3_bind_parameter_count" +external bind_parameter_index : stmt -> string -> int = "ml_sqlite3_bind_parameter_index" +external bind_parameter_name : stmt -> int -> string = "ml_sqlite3_bind_parameter_name" +external clear_bindings : stmt -> unit = "ml_sqlite3_clear_bindings" +external transfer_bindings : stmt -> stmt -> unit = "ml_sqlite3_transfer_bindings" + +external column_blob : stmt -> int -> string = "ml_sqlite3_column_blob" +external column_double : stmt -> int -> float = "ml_sqlite3_column_double" +external column_int : stmt -> int -> int = "ml_sqlite3_column_int" +external column_int64 : stmt -> int -> int64 = "ml_sqlite3_column_int64" +external column_text : stmt -> int -> string = "ml_sqlite3_column_text" +external column_type : stmt -> int -> sql_type = "ml_sqlite3_column_type" +external data_count : stmt -> int = "ml_sqlite3_data_count" +external column_count : stmt -> int = "ml_sqlite3_column_count" +external column_name : stmt -> int -> string = "ml_sqlite3_column_name" +external column_decltype : stmt -> int -> string = "ml_sqlite3_column_decltype" + + +external value_blob : argument -> string = "ml_sqlite3_value_blob" +external value_double : argument -> float = "ml_sqlite3_value_double" +external value_int : argument -> int = "ml_sqlite3_value_int" +external value_int64 : argument -> int64 = "ml_sqlite3_value_int64" +external value_text : argument -> string = "ml_sqlite3_value_text" +external value_type : argument -> sql_type = "ml_sqlite3_value_type" external _create_function : - db -> string -> int -> (sql_value array -> user_fun_result) -> unit + db -> string -> int -> (argument array -> sql_value) -> unit = "ml_sqlite3_create_function" let create_fun_N db name f = @@ -104,6 +165,64 @@ external delete_function : db -> string -> unit = "ml_sqlite3_delete_function" + +let rec fold_stmts f acc = function + | [] -> acc + | stmt :: tl as stmts -> + let r = + try f acc stmt + with exn -> + List.iter finalize_noerr stmts ; + raise exn in + finalize_noerr stmt ; + fold_stmts f r tl + +let rec fold_rows f acc stmt = + match step stmt with + | `DONE -> acc + | `ROW -> + fold_rows f (f acc stmt) stmt + + +let _exec db sql = + fold_stmts + (fold_rows + (fun () _ -> ())) + () + (prepare_all db sql) + +let exec db sql = + _exec db (String.copy sql) + +let exec_f db fmt = + Printf.kprintf (_exec db) fmt + + +let fetch_one ?column_names f init stmt = + begin + match column_names with + | None -> () + | Some n -> + n := Array.init (column_count stmt) (column_name stmt) + end ; + fold_rows + (fun acc stmt -> + let row = + Array.init + (data_count stmt) + (column_text stmt) in + f acc row) + init + stmt + +let _fetch db sql ?column_names f init = + fold_stmts + (fetch_one ?column_names f) + init + (prepare_all db sql) + +let fetch db sql ?column_names f init = + _fetch db (String.copy sql) ?column_names f init + +let fetch_f db ?column_names f init fmt = + Printf.kprintf (fun q -> _fetch db q ?column_names f init) fmt -external last_insert_rowid : db -> int64 = "ml_sqlite3_last_insert_rowid" -external changes : db -> int = "ml_sqlite3_changes" -external total_changes : db -> int = "ml_sqlite3_total_changes" ======================================================================== --- mlsqlite/sqlite3.mli e6308b42958630d1ccfd385d4f47c4e063f0b48d +++ mlsqlite/sqlite3.mli 8c9624c03f134ddb2a0c1876f8e6b1c5accefd71 @@ -1,7 +1,16 @@ type db +type stmt +type argument -external open_db : string -> db = "ml_sqlite3_open" -external close_db : db -> unit = "ml_sqlite3_close" +type sql_type = [ `BLOB | `FLOAT | `INTEGER | `NULL | `TEXT ] +type sql_value = + [ `BLOB of string + | `FLOAT of float + | `INT of int + | `INT64 of int64 + | `NULL + | `TEXT of string + | `VALUE of argument ] type error_code = ERROR @@ -34,74 +43,96 @@ val init : unit -external exec : db -> string -> unit = "ml_sqlite3_exec" -val exec_f : db -> ('a, unit, string, unit) format4 -> 'a +external open_db : string -> db = "ml_sqlite3_open" +external close_db : db -> unit = "ml_sqlite3_close" -external fetch : - db -> - string -> - ?column_names:string array ref -> ('a -> string array -> 'a) -> 'a -> 'a - = "ml_sqlite3_fetch" -external fetch_opt : - db -> - string -> - ?column_names:string array ref -> - ('a -> string option array -> 'a) -> 'a -> 'a = "ml_sqlite_fetch3_opt" - -val fetch_f : - db -> - ?column_names:string array ref -> - ('a -> string array -> 'a) -> 'a -> ('b, unit, string, 'a) format4 -> 'b - external interrupt : db -> unit = "ml_sqlite3_interrupt" - external is_complete : string -> bool = "ml_sqlite3_complete" +val version : string +external last_insert_rowid : db -> int64 = "ml_sqlite3_last_insert_rowid" +external changes : db -> int = "ml_sqlite3_changes" +external total_changes : db -> int = "ml_sqlite3_total_changes" +external get_autocommit : db -> bool = "ml_sqlite3_get_autocommit" +external sleep : int -> unit = "ml_sqlite3_sleep" -external busy_set : db -> (int -> [ `FAIL | `RETRY ]) -> unit = "ml_sqlite3_busy_handler" +external busy_set : db -> (int -> [ `FAIL | `RETRY ]) -> unit + = "ml_sqlite3_busy_handler" external busy_unset : db -> unit = "ml_sqlite3_busy_handler_unset" external busy_timeout : db -> int -> unit = "ml_sqlite3_busy_timeout" external trace_set : db -> (string -> unit) -> unit = "ml_sqlite3_trace" external trace_unset : db -> unit = "ml_sqlite3_trace_unset" -external progress_handler_set : db -> int -> (unit -> unit) -> unit = "ml_sqlite3_progress_handler" -external progress_handler_unset : db -> unit = "ml_sqlite3_progress_handler_unset" +external progress_handler_set : db -> int -> (unit -> unit) -> unit + = "ml_sqlite3_progress_handler" +external progress_handler_unset : db -> unit + = "ml_sqlite3_progress_handler_unset" -external version : unit -> string = "ml_sqlite3_version" -type sql_value -external value_blob : sql_value -> string = "ml_sqlite3_value_blob" -external value_double : sql_value -> float = "ml_sqlite3_value_double" -external value_int : sql_value -> int = "ml_sqlite3_value_int" -external value_int64 : sql_value -> int64 = "ml_sqlite3_value_int64" -external value_text : sql_value -> string = "ml_sqlite3_value_text" -external value_type : - sql_value -> [ `BLOB | `FLOAT | `INTEGER | `NULL | `TEXT ] - = "ml_sqlite3_value_type" +external finalize : stmt -> unit = "ml_sqlite3_finalize" +external finalize_noerr : stmt -> unit = "ml_sqlite3_finalize_noerr" +external prepare : db -> string -> int -> stmt option * int + = "ml_sqlite3_prepare" +val prepare_one : db -> string -> stmt +val prepare_all : db -> string -> stmt list -type user_fun_result = - [ `BLOB of string - | `FLOAT of float - | `INT of int - | `INT64 of int64 - | `NULL - | `TEXT of string - | `VALUE of sql_value ] +val with_stmt : db -> string -> (stmt -> 'a) -> 'a -val create_fun_N : - db -> string -> (sql_value array -> user_fun_result) -> unit -val create_fun_0 : db -> string -> (unit -> user_fun_result) -> unit -val create_fun_1 : db -> string -> (sql_value -> user_fun_result) -> unit +external reset : stmt -> unit = "ml_sqlite3_reset" +external expired : stmt -> bool = "ml_sqlite3_expired" +external step : stmt -> [ `DONE | `ROW ] = "ml_sqlite3_step" + +external bind : stmt -> int -> sql_value -> unit = "ml_sqlite3_bind" +external bind_parameter_count : stmt -> int + = "ml_sqlite3_bind_parameter_count" +external bind_parameter_index : stmt -> string -> int + = "ml_sqlite3_bind_parameter_index" +external bind_parameter_name : stmt -> int -> string + = "ml_sqlite3_bind_parameter_name" +external clear_bindings : stmt -> unit = "ml_sqlite3_clear_bindings" +external transfer_bindings : stmt -> stmt -> unit + = "ml_sqlite3_transfer_bindings" + +external column_blob : stmt -> int -> string = "ml_sqlite3_column_blob" +external column_double : stmt -> int -> float = "ml_sqlite3_column_double" +external column_int : stmt -> int -> int = "ml_sqlite3_column_int" +external column_int64 : stmt -> int -> int64 = "ml_sqlite3_column_int64" +external column_text : stmt -> int -> string = "ml_sqlite3_column_text" +external column_type : stmt -> int -> sql_type = "ml_sqlite3_column_type" +external data_count : stmt -> int = "ml_sqlite3_data_count" +external column_count : stmt -> int = "ml_sqlite3_column_count" +external column_name : stmt -> int -> string = "ml_sqlite3_column_name" +external column_decltype : stmt -> int -> string + = "ml_sqlite3_column_decltype" + +external value_blob : argument -> string = "ml_sqlite3_value_blob" +external value_double : argument -> float = "ml_sqlite3_value_double" +external value_int : argument -> int = "ml_sqlite3_value_int" +external value_int64 : argument -> int64 = "ml_sqlite3_value_int64" +external value_text : argument -> string = "ml_sqlite3_value_text" +external value_type : argument -> sql_type = "ml_sqlite3_value_type" + +val create_fun_N : db -> string -> (argument array -> sql_value) -> unit +val create_fun_0 : db -> string -> (unit -> sql_value) -> unit +val create_fun_1 : db -> string -> (argument -> sql_value) -> unit val create_fun_2 : - db -> string -> (sql_value -> sql_value -> user_fun_result) -> unit + db -> string -> (argument -> argument -> sql_value) -> unit val create_fun_3 : - db -> - string -> (sql_value -> sql_value -> sql_value -> user_fun_result) -> unit + db -> string -> (argument -> argument -> argument -> sql_value) -> unit external delete_function : db -> string -> unit = "ml_sqlite3_delete_function" -external last_insert_rowid : db -> int64 = "ml_sqlite3_last_insert_rowid" +val fold_rows : ('a -> stmt -> 'a) -> 'a -> stmt -> 'a +val exec : db -> string -> unit +val exec_f : db -> ('a, unit, string, unit) format4 -> 'a + +val fetch : + db -> + string -> + ?column_names:string array ref -> ('a -> string array -> 'a) -> 'a -> 'a +val fetch_f : + db -> + ?column_names:string array ref -> + ('a -> string array -> 'a) -> 'a -> ('b, unit, string, 'a) format4 -> 'b -external changes : db -> int = "ml_sqlite3_changes" -external total_changes : db -> int = "ml_sqlite3_total_changes"