scsh-conservatory
/
scsh-bdb
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

various getters/setters for DB_ENV

This commit is contained in:
eknauel 2004-09-21 14:38:59 +00:00
parent fb5c2a89bc
commit c0fc436bf3
3 changed files with 441 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

286
c/bdb.c
View File

@ -140,6 +140,25 @@ s48_value scsh_enter_dbenv(DB_ENV *h)
return rec; return rec;
} }
/* convert null-terminated array of strings to a list of Scheme strings */
s48_value scsh_enter_string_array(const char **array)
{
int i;
s48_value res = S48_NULL;
S48_DECLARE_GC_PROTECT(1);
S48_GC_PROTECT_1(res);
if (array == NULL) {
S48_GC_UNPROTECT();
return S48_NULL;
}
for (i = 0; array[i] != NULL; i++)
res = s48_cons(s48_enter_string(array[i]), res);
S48_GC_UNPROTECT();
return res;
}
/* BDB operations */ /* BDB operations */
/* database environment */ /* database environment */
@ -181,48 +200,54 @@ s48_value scsh_bdb_env_close(s48_value env)
} }
/* remove a database */ /* remove a database */
/* s48_value scsh_bdb_dbremove(s48_value senv_handle, s48_value stxnid, */ s48_value scsh_bdb_dbremove(s48_value senv_handle, s48_value stxnid,
/* s48_value sfile, s48_value sdatabase, */ s48_value sfile, s48_value sdatabase,
/* s48_value sflags) */ s48_value sflags)
/* { */ {
/* DB_ENV *dbenv; */ DB_ENV *dbenv;
/* DB_TXN *txnid; */ DB_TXN *txnid;
/* DB *dbp; */ char *file, *database;
/* char *file; */ u_int32_t flags;
/* u_int32_t flags; */ int res;
/* int res; */ S48_DECLARE_GC_PROTECT(5);
/* S48_DECLARE_GC_PROTECT(5); */
/* S48_GC_PROTECT_5(senv_handle, stxnid, sfile, sdatabase, sflags); */ S48_GC_PROTECT_5(senv_handle, stxnid, sfile, sdatabase, sflags);
/* dbenv = scsh_extract_dbenv(senv_handle); */ dbenv = scsh_extract_dbenv(senv_handle);
/* txnid = EXTRACT_OPTIONAL_TXNID(stxnid); */ txnid = EXTRACT_OPTIONAL_TXNID(stxnid);
/* file = s48_extract_string(sfile); */ file = s48_extract_string(sfile);
/* dbp = scsh_extract_db(sdatabase); */ database = s48_extract_string(sdatabase);
/* flags = s48_extract_integer(sflags); */ flags = s48_extract_integer(sflags);
/* S48_GC_UNPROTECT(); */ S48_GC_UNPROTECT();
/* res = DB_ENV->dbremove(dbenv, txnid, file, dbp, flags); */ res = dbenv->dbremove(dbenv, txnid, file, database, flags);
/* CHECK_BDB_RESULT_CODE(res); */ CHECK_BDB_RESULT_CODE(res);
/* } */ return S48_TRUE;
}
/* rename a database */ /* rename a database */
/* s48_value scsh_bdb_dbrename(s48_value senv_handle, s48_value stxnid, */ s48_value scsh_bdb_dbrename(s48_value senv_handle, s48_value stxnid,
/* s48_value sfile, s48_value sdatabase, */ s48_value sfile, s48_value sdatabase,
/* s48_value snewname, s48_value sflags) */ s48_value snewname, s48_value sflags)
/* { */ {
/* DB_ENV *dbenv; */ DB_ENV *dbenv;
/* DB_TXN *txnid; */ DB_TXN *txnid;
/* char *file, *database, *newname; */ char *file, *database, *newname;
/* u_int32_t flags; */ int res;
/* S48_DECLARE_GC_PROTECT(6); */ u_int32_t flags;
S48_DECLARE_GC_PROTECT(6);
/* S48_GC_UNPROTECT_6(senv_handle, stxnid, sfile, sdatabase, snewname, sflags); */ S48_GC_UNPROTECT_6(senv_handle, stxnid, sfile, sdatabase, snewname, sflags);
dbenv = scsh_extract_dbenv(senv_handle);
txnid = EXTRACT_OPTIONAL_TXNID(stxnid);
file = s48_extract_string(sfile);
database = s48_extract_string(sdatabase);
newname = s48_extract_string(snewname);
flags = s48_extract_integer(sflags);
res = dbenv->dbrename(dbenv, txnid, file, database, newname, flags);
CHECK_BDB_RESULT_CODE(res);
return S48_TRUE;
/* DB_ENV->dbrename(); */ }
/* } */
/* open an environment */ /* open an environment */
s48_value scsh_bdb_env_open(s48_value env_handle, s48_value sdb_home, s48_value scsh_bdb_env_open(s48_value env_handle, s48_value sdb_home,
@ -239,18 +264,185 @@ s48_value scsh_bdb_env_open(s48_value env_handle, s48_value sdb_home,
dbhome = s48_extract_string(sdb_home); dbhome = s48_extract_string(sdb_home);
dbenv = scsh_extract_dbenv(env_handle); dbenv = scsh_extract_dbenv(env_handle);
mode = s48_extract_integer(smode); mode = s48_extract_integer(smode);
//flags = bdb_extract_flags(sflags); flags = s48_extract_integer(sflags);
// as of now default is set to transaction and locking support
flags = DB_CREATE | DB_INIT_LOG | DB_INIT_LOCK | DB_INIT_TXN;
S48_GC_UNPROTECT(); S48_GC_UNPROTECT();
res = dbenv->open(dbenv, dbhome, flags, mode); res = dbenv->open(dbenv, dbhome, flags, mode);
CHECK_BDB_RESULT_CODE(res); CHECK_BDB_RESULT_CODE(res);
return S48_TRUE; return S48_TRUE;
} }
/* set path for method database files */
s48_value scsh_bdb_env_set_data_dir(s48_value senv_handle, s48_value sdir)
{
int res;
DB_ENV *dbenv;
char* dir;
S48_DECLARE_GC_PROTECT(2);
S48_GC_PROTECT_2(senv_handle, sdir);
dir = s48_extract_string(sdir);
dbenv = scsh_extract_dbenv(senv_handle);
S48_GC_UNPROTECT();
res = dbenv->set_data_dir(dbenv, dir);
CHECK_BDB_RESULT_CODE(res);
return S48_TRUE;
}
s48_value scsh_bdb_env_get_data_dirs(s48_value senv_handle)
{
int res;
const char **a;
s48_value lst;
DB_ENV *dbenv;
S48_DECLARE_GC_PROTECT(2);
S48_GC_PROTECT_2(senv_handle, lst);
dbenv = scsh_extract_dbenv(senv_handle);
res = dbenv->get_data_dirs(dbenv, &a);
CHECK_BDB_RESULT_CODE(res);
lst = scsh_enter_string_array(a);
S48_GC_UNPROTECT();
return lst;
}
s48_value scsh_bdb_env_set_encrypt(s48_value senv_handle, s48_value spasswd,
s48_value sflags)
{
int res;
char *passwd;
DB_ENV *dbenv;
u_int32_t flags;
S48_DECLARE_GC_PROTECT(3);
S48_GC_PROTECT_3(senv_handle, spasswd, sflags);
dbenv = scsh_extract_dbenv(senv_handle);
passwd = s48_extract_string(spasswd);
flags = s48_extract_integer(sflags);
res = dbenv->set_encrypt(dbenv, passwd, flags);
memset(passwd, 0, S48_STRING_LENGTH(spasswd));
S48_GC_UNPROTECT();
CHECK_BDB_RESULT_CODE(res);
return S48_TRUE;
}
s48_value scsh_bdb_env_get_encrypt_flags(s48_value senv_handle)
{
int res;
int flags = 0;
DB_ENV *dbenv;
dbenv = scsh_extract_dbenv(senv_handle);
res = dbenv->get_encrypt_flags(dbenv, &flags);
if (res > 0)
s48_raise_os_error(res);
else
return s48_list_2(s48_enter_integer(res), s48_enter_integer(flags));
}
/* set timeout for locks and transactions */
s48_value scsh_bdb_env_set_timeout(s48_value senv_handle, s48_value stimeout,
s48_value lockp)
{
DB_ENV *dbenv;
int res;
db_timeout_t timeout;
u_int32_t flags;
S48_DECLARE_GC_PROTECT(3);
S48_GC_PROTECT_3(senv_handle, stimeout, lockp);
dbenv = scsh_extract_dbenv(senv_handle);
flags = (lockp == S48_FALSE) ? DB_SET_TXN_TIMEOUT : DB_SET_LOCK_TIMEOUT;
timeout = (db_timeout_t) s48_extract_integer(stimeout);
S48_GC_UNPROTECT();
res = dbenv->set_timeout(dbenv, timeout, flags);
CHECK_BDB_RESULT_CODE(res);
return S48_TRUE;
}
/* get timeout for locks and transactions */
s48_value scsh_bdb_env_get_timeout(s48_value senv_handle, s48_value lockp)
{
DB_ENV *dbenv;
int res;
db_timeout_t timeout;
u_int32_t flags;
S48_DECLARE_GC_PROTECT(2);
S48_GC_PROTECT_2(senv_handle, lockp);
dbenv = scsh_extract_dbenv(senv_handle);
flags = (lockp == S48_FALSE) ? DB_SET_TXN_TIMEOUT : DB_SET_LOCK_TIMEOUT;
S48_GC_UNPROTECT();
res = dbenv->get_timeout(dbenv, &timeout, flags);
return s48_list_2(s48_enter_integer(res),
(res == 0) ? s48_enter_integer((long) timeout) : S48_FALSE);
}
/* set tmp dir */
s48_value scsh_bdb_env_set_tmp_dir(s48_value senv_handle, s48_value sdir)
{
DB_ENV *dbenv;
int res;
char *dir;
S48_DECLARE_GC_PROTECT(2);
S48_GC_PROTECT_2(senv_handle, sdir);
dir = s48_extract_string(sdir);
dbenv = scsh_extract_dbenv(senv_handle);
S48_GC_UNPROTECT();
res = dbenv->set_tmp_dir(dbenv, dir);
return s48_enter_integer(res);
}
/* get tmp dir */
s48_value scsh_bdb_env_get_tmp_dir(s48_value senv_handle)
{
DB_ENV *dbenv;
int res;
char *tmpdir;
dbenv = scsh_extract_dbenv(senv_handle);
res = dbenv->get_tmp_dir(dbenv, (const char **) &tmpdir);
return s48_list_2(s48_enter_integer(res),
((res == 0) && (tmpdir != NULL)) ?
s48_enter_string(tmpdir) : S48_FALSE);
}
/* set flags of DB_ENV */
s48_value scsh_bdb_env_set_flags(s48_value senv_handle, s48_value sflags,
s48_value clearp)
{
DB_ENV *dbenv;
u_int32_t flags;
int res;
S48_DECLARE_GC_PROTECT(3);
S48_GC_PROTECT_3(senv_handle, sflags, clearp);
dbenv = scsh_extract_dbenv(senv_handle);
flags = s48_extract_integer(sflags);
res = dbenv->set_flags(dbenv, flags, (clearp == S48_TRUE) ? 0 : 1);
S48_GC_UNPROTECT();
CHECK_BDB_RESULT_CODE(res);
return S48_FALSE;
}
/* get flags of DB_ENV */
s48_value scsh_bdb_env_get_flags(s48_value senv_handle)
{
DB_ENV *dbenv;
int res;
u_int32_t flags;
dbenv = scsh_extract_dbenv(senv_handle);
res = dbenv->get_flags(dbenv, &flags);
return s48_list_2(s48_enter_integer(res),
(res == 0) ? s48_enter_integer(flags) : S48_FALSE);
}
/* remove an environment */ /* remove an environment */
s48_value scsh_bdb_env_remove(s48_value db_home, s48_value sflags) s48_value scsh_bdb_env_remove(s48_value db_home, s48_value sflags)
{ {
@ -727,6 +919,18 @@ void scsh_init_bdb_bindings(void)
S48_EXPORT_FUNCTION(scsh_bdb_get); S48_EXPORT_FUNCTION(scsh_bdb_get);
S48_EXPORT_FUNCTION(scsh_bdb_del); S48_EXPORT_FUNCTION(scsh_bdb_del);
S48_EXPORT_FUNCTION(scsh_bdb_env_create); S48_EXPORT_FUNCTION(scsh_bdb_env_create);
S48_EXPORT_FUNCTION(scsh_bdb_dbremove);
S48_EXPORT_FUNCTION(scsh_bdb_dbrename);
S48_EXPORT_FUNCTION(scsh_bdb_env_set_data_dir);
S48_EXPORT_FUNCTION(scsh_bdb_env_get_data_dirs);
S48_EXPORT_FUNCTION(scsh_bdb_env_set_encrypt);
S48_EXPORT_FUNCTION(scsh_bdb_env_get_encrypt_flags);
S48_EXPORT_FUNCTION(scsh_bdb_env_set_timeout);
S48_EXPORT_FUNCTION(scsh_bdb_env_get_timeout);
S48_EXPORT_FUNCTION(scsh_bdb_env_set_tmp_dir);
S48_EXPORT_FUNCTION(scsh_bdb_env_get_tmp_dir);
S48_EXPORT_FUNCTION(scsh_bdb_env_set_flags);
S48_EXPORT_FUNCTION(scsh_bdb_env_get_flags);
S48_EXPORT_FUNCTION(scsh_bdb_env_open); S48_EXPORT_FUNCTION(scsh_bdb_env_open);
S48_EXPORT_FUNCTION(scsh_bdb_env_close); S48_EXPORT_FUNCTION(scsh_bdb_env_close);
S48_EXPORT_FUNCTION(scsh_bdb_env_remove); S48_EXPORT_FUNCTION(scsh_bdb_env_remove);

181
scheme/bdb.scm
View File

@ -229,7 +229,7 @@
;;; define bdb records ;;; define bdb records
;;; DB handle : DB ;;; DB handle : DB
(define-record-type database :database (define-record-type database :database
(make-database c-pointer closed? weak-list) (really-make-database c-pointer closed? weak-list)
database? database?
(c-pointer database-c-pointer) (c-pointer database-c-pointer)
(closed? database-closed? set-database-closed?!) (closed? database-closed? set-database-closed?!)
@ -331,22 +331,197 @@
(add-finalizer! handle database-env-close) (add-finalizer! handle database-env-close)
handle)))))) handle))))))
(import-lambda-definition bdb-db-remove-int
(env-handle txn-id file database flags)
"scsh_bdb_db_remove")
(define (remove-database database-env file-name database-name . args)
(let-optionals args
((txn-id (or (current-transaction-id) '()))
(flags (or (current-flags) '())))
(let ((result
(bdb-db-remove-int database-env txn-id file-name database-name
(flags->value flags))))
(if (integer? result)
(raise-bdb-condition result)
(values)))))
(import-lambda-definition bdb-db-rename-int
(env-handle txn-id file database new-name flags)
"scsh_bdb_dbrename")
;; untested
(define (rename-database database-env file-name database-name new-name . args)
(let-optionals args
((txn-id (or (current-transaction-id) '()))
(flags (or (current-flags) '())))
(let ((result
(bdb-db-rename-int database-env txn-id file-name database-name
new-name (flags->value flags))))
(if (integer? result)
(raise-bdb-condition result)
(values)))))
(import-lambda-definition (import-lambda-definition
bdb-env-open-int bdb-env-open-int
(env-handle db-home flags mode) (env-handle db-home flags mode)
"scsh_bdb_env_open") "scsh_bdb_env_open")
(define (database-env-open env-handle home-dir . args) ;; untested
(define (database-env-open db-env home-dir . args)
(let-optionals args (let-optionals args
((flags (or (current-flags) '())) ((flags (or (current-flags) '()))
(mode 0)) (mode 0))
(let ((result (let ((result
(bdb-env-open-int (bdb-env-open-int
env-handle home-dir (flags->value flags) mode))) db-env home-dir (flags->value flags) mode)))
(if (integer? result) (if (integer? result)
(raise-bdb-condition result) (raise-bdb-condition result)
(values))))) (values)))))
(import-lambda-definition bdb-env-set-data-dir-int
(env-handle dir)
"scsh_bdb_env_set_data_dir")
(define (set-database-env-data-dir! db-env dir)
(let ((result
(bdb-env-set-data-dir-int db-env dir)))
(if (integer? result)
(raise-bdb-condition result)
(values))))
(import-lambda-definition bdb-env-get-data-dirs
(env-handle)
"scsh_bdb_env_get_data_dirs")
(define (database-env-data-dirs db-env)
(let ((result
(bdb-env-get-data-dirs db-env)))
(if (integer? result)
(raise-bdb-condition result)
result)))
(import-lambda-definition bdb-env-set-encrypt-int
(env-handle password flags)
"scsh_bdb_env_set_encrypt")
(define (set-database-env-encrypt! database-env password . args)
(let-optionals args
((flags (or (current-flags) '())))
(let ((result
(bdb-env-set-encrypt-int database-env password
(flags->value flags))))
(if (integer? result)
(raise-bdb-condition result)
(values)))))
(import-lambda-definition bdb-env-get-encrypt-flags-int
(env-handle)
"scsh_bdb_env_get_encrypt_flags")
;; FIXME
(define (database-env-encrypt-flags database-env)
(call-with-values
(lambda ()
(apply values (bdb-env-get-encrypt-flags-int database-env)))
(lambda (error-code flags)
(if (< error-code 0)
(raise-bdb-condition error-code)
flags))))
(import-lambda-definition bdb-env-set-timeout-int
(env-handle timeout lock?)
"scsh_bdb_env_set_timeout")
(define (set-database-env-lock-timeout! db-env timeout)
(let ((result
(bdb-env-set-timeout-int db-env timeout #t)))
(if (integer? result)
(raise-bdb-condition result)
(values))))
(define (set-database-env-transaction-timeout! db-env timeout)
(let ((result
(bdb-env-set-timeout-int db-env timeout #f)))
(if (integer? result)
(raise-bdb-condition result)
(values))))
(import-lambda-definition bdb-env-get-timeout-int
(env-handle lockp)
"scsh_bdb_env_get_timeout")
(define (database-env-lock-timeout db-env)
(call-with-values
(lambda ()
(apply values (bdb-env-get-timeout-int db-env #t)))
(lambda (error-code timeout)
(if (zero? error-code)
timeout
(raise-bdb-condition error-code)))))
(define (database-env-transaction-timeout db-env)
(call-with-values
(lambda ()
(apply values (bdb-env-get-timeout-int db-env #f)))
(lambda (error-code timeout)
(if (zero? error-code)
timeout
(raise-bdb-condition error-code)))))
(import-lambda-definition bdb-env-set-tmp-dir-int
(env-handle dir)
"scsh_bdb_env_set_tmp_dir")
(define (set-database-env-tmp-dir! db-env dir)
(let ((result
(bdb-env-set-tmp-dir-int db-env dir)))
(if (not (zero? result))
(raise-bdb-condition result)
(values))))
(import-lambda-definition bdb-env-get-tmp-dir-int
(env-handle)
"scsh_bdb_env_get_tmp_dir")
(define (database-env-tmp-dir db-env)
(call-with-values
(lambda ()
(apply values (bdb-env-get-tmp-dir-int db-env)))
(lambda (error-code tmp-dir)
(if (zero? error-code)
tmp-dir
(raise-bdb-condition error-code)))))
(import-lambda-definition bdb-env-set-flags
(env-handle flags clear?)
"scsh_bdb_env_set_flags")
(define (modify-database-env-flags! db-env flags clear?)
(let ((result (bdb-env-set-flags db-env (flags->value flags) clear?)))
(if (integer? result)
(raise-bdb-condition result)
(values))))
(define (set-database-env-flags! db-env flags)
(modify-database-env-flags! db-env flags #f))
(define (clear-database-env-flags! db-env flags)
(modify-database-env-flags! db-env flags #t))
(import-lambda-definition bdb-env-get-flags
(env-handle)
"scsh_bdb_env_get_flags")
(define (database-env-flags db-env)
(call-with-values
(lambda ()
(apply values (bdb-env-get-flags db-env)))
(lambda (error-code flags)
(if (zero? error-code)
flags
(raise-bdb-condition error-code)))))
(import-lambda-definition (import-lambda-definition
bdb-env-close-int bdb-env-close-int
(env-handle) (env-handle)

16
scheme/packages.scm
View File

@ -38,6 +38,22 @@
make-database-env make-database-env
database-env-open database-env-open
database-env-close database-env-close
set-database-env-data-dir!
database-env-data-dirs
set-database-env-encrypt!
database-env-encrypt-flags
set-database-env-lock-timeout!
set-database-env-transaction-timeout!
database-env-lock-timeout
database-env-transaction-timeout
set-database-env-tmp-dir!
database-env-tmp-dir
set-database-env-flags!
clear-database-env-flags!
database-env-flags
remove-database
rename-database
make-database make-database
open-database open-database