diff --git a/c/bdb.c b/c/bdb.c index 484cd9c..8637f7f 100644 --- a/c/bdb.c +++ b/c/bdb.c @@ -648,6 +648,41 @@ s48_value scsh_bdb_env_get_flags(s48_value senv_handle) (res == 0) ? s48_enter_integer(flags) : S48_FALSE); } +/* get verbose options */ +s48_value scsh_bdb_env_get_verbose(s48_value senv_handle, s48_value swhich) +{ + DB_ENV *dbenv; + u_int32_t which; + int res, onoff; + S48_DECLARE_GC_PROTECT(2); + + S48_GC_PROTECT_2(senv_handle, swhich); + dbenv = scsh_extract_dbenv(senv_handle); + which = s48_extract_integer(swhich); + res = dbenv->get_verbose(dbenv, which, &onoff); + S48_GC_UNPROTECT(); + CHECK_BDB_RESULT_CODE(res); + return (onoff == 0) ? S48_FALSE: S48_TRUE; +} + +/* set verbose options */ +s48_value scsh_bdb_env_set_verbose(s48_value senv_handle, s48_value swhich, + s48_value sonoff) +{ + DB_ENV *dbenv; + u_int32_t which; + int res, onoff; + S48_DECLARE_GC_PROTECT(3); + + S48_GC_PROTECT_3(senv_handle, swhich, sonoff); + dbenv = scsh_extract_dbenv(senv_handle); + which = s48_extract_integer(swhich); + onoff = (sonoff == S48_FALSE) ? 0 : 1; + res = dbenv->set_verbose(dbenv, which, onoff); + CHECK_BDB_RESULT_CODE(res); + return S48_FALSE; +} + /* remove an environment */ s48_value scsh_bdb_env_remove(s48_value db_home, s48_value sflags) { @@ -886,6 +921,27 @@ s48_value scsh_bdb_get_flags(s48_value sdatabase) (res == 0) ? s48_enter_integer(flags) : S48_FALSE); } +s48_value scsh_bdb_set_debug_file(s48_value sdatabase, + s48_value filename_or_false) +{ + DB *db; + int res; + S48_DECLARE_GC_PROTECT(2); + + S48_GC_PROTECT_2(sdatabase, filename_or_false); + db = scsh_extract_db(sdatabase); + if (filename_or_false == S48_FALSE) + db->set_errfile(db, NULL); + else + { + FILE *fp; + fp = fopen (s48_extract_string(filename_or_false), "w"); + db->set_errfile(db, fp); + } + S48_GC_UNPROTECT(); + return S48_UNSPECIFIC; +} + s48_value scsh_bdb_set_lorder(s48_value sdatabase, s48_value sbig_endian_p) { DB *db; @@ -1372,6 +1428,8 @@ void scsh_init_bdb_bindings(void) S48_EXPORT_FUNCTION(scsh_bdb_env_get_tx_timestamp); S48_EXPORT_FUNCTION(scsh_bdb_env_set_flags); S48_EXPORT_FUNCTION(scsh_bdb_env_get_flags); + S48_EXPORT_FUNCTION(scsh_bdb_env_get_verbose); + S48_EXPORT_FUNCTION(scsh_bdb_env_set_verbose); S48_EXPORT_FUNCTION(scsh_bdb_env_open); S48_EXPORT_FUNCTION(scsh_bdb_env_close); S48_EXPORT_FUNCTION(scsh_bdb_env_lock_get); @@ -1393,6 +1451,7 @@ void scsh_init_bdb_bindings(void) S48_EXPORT_FUNCTION(scsh_bdb_get_encrypt_flags); S48_EXPORT_FUNCTION(scsh_bdb_set_flags); S48_EXPORT_FUNCTION(scsh_bdb_get_flags); + S48_EXPORT_FUNCTION(scsh_bdb_set_debug_file); S48_EXPORT_FUNCTION(scsh_bdb_set_lorder); S48_EXPORT_FUNCTION(scsh_bdb_get_lorder); S48_EXPORT_FUNCTION(scsh_bdb_set_pagesize); diff --git a/c/bdb.h b/c/bdb.h index b41ec92..1e1065b 100644 --- a/c/bdb.h +++ b/c/bdb.h @@ -40,6 +40,8 @@ void scsh_extract_bytevector_as_DBT(s48_value bytevector, DBT* dt); #define CHECK_BDB_RESULT_CODE(res) \ do { \ + if (res != 0) \ + fprintf(stderr, "scsh-bdb: %s\n", db_strerror(res)); \ if (res > 0) \ s48_raise_os_error(res); \ if (res < 0) \ diff --git a/scheme/bdb.scm b/scheme/bdb.scm index 0781717..7c1b575 100644 --- a/scheme/bdb.scm +++ b/scheme/bdb.scm @@ -619,6 +619,25 @@ flags (raise-bdb-condition error-code))))) +(import-lambda-definition bdb-env-set-verbose + (env-handle which on-or-off?) + "scsh_bdb_env_set_verbose") + +(define (set-database-env-verbose! db-env which on-or-off?) + (cond + ((bdb-env-set-verbose db-env which on-or-off?) + => raise-bdb-condition))) + +(import-lambda-definition bdb-env-get-verbose + (env-handle which) + "scsh_bdb_env_get_verbose") + +(define (database-env-verbose db-env which) + (let ((res (bdb-env-get-verbose db-env which))) + (if (number? res) + (raise-bdb-condition res) + res))) + (import-lambda-definition bdb-env-close-int (env-handle) "scsh_bdb_env_close") @@ -910,6 +929,16 @@ flags (raise-bdb-condition error-code))))) +(import-lambda-definition bdb-set-debug-file + (database filename-or-false) + "scsh_bdb_set_debug_file") + +(define (turn-database-debugging-on database file-name) + (bdb-set-debug-file database file-name)) + +(define (turn-database-debugging-off database) + (bdb-set-debug-file database #f)) + (import-lambda-definition bdb-set-lorder (database big-endian?) "scsh_bdb_set_lorder") diff --git a/scheme/packages.scm b/scheme/packages.scm index 5120bc6..f5dc0db 100644 --- a/scheme/packages.scm +++ b/scheme/packages.scm @@ -53,6 +53,8 @@ database-env-data-dirs set-database-env-encrypt! database-env-encrypt-flags + set-database-env-verbose! + database-env-verbose set-database-env-lock-timeout! set-database-env-transaction-timeout! database-env-lock-timeout @@ -90,6 +92,8 @@ database-encrypt-flags set-database-flags! database-flags + turn-database-debugging-on + turn-database-debugging-off set-database-byte-order! database-big-endian? database-little-endian?