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

fix return values of CURSOR-GET and DATABASE-GET

This commit is contained in:
eknauel 2004-11-22 16:58:07 +00:00
parent ed7ab6948e
commit c01134e623
2 changed files with 22 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
c/bdb.c
View File

@ -997,18 +997,8 @@ s48_value scsh_bdb_get(s48_value handle, s48_value skey,
S48_GC_UNPROTECT();
res = dbp->get(dbp, txnid, &key, &data, flags);
if (res > 0)
s48_raise_os_error(res);
switch (res) {
case DB_NOTFOUND:
case DB_KEYEMPTY:
return s48_enter_integer(res);
break;
default:
CHECK_BDB_RESULT_CODE(res);
return scsh_enter_DBT_as_bytevector(&data);
}
}
/* Delete DBT to corresponding key */
@ -1074,24 +1064,29 @@ s48_value scsh_bdb_close_cursor(s48_value scursor)
}
/* retrieve values from cursor */
s48_value scsh_bdb_cursor_cget(s48_value dbc, s48_value sflags)
s48_value scsh_bdb_cursor_cget(s48_value dbc, s48_value skey,
s48_value sflags)
{
int res;
DBC* dbcp;
u_int32_t flags;
DBT *key, *data;
S48_DECLARE_GC_PROTECT(2);
DBT key, data;
S48_DECLARE_GC_PROTECT(3);
S48_GC_PROTECT_2(dbc, sflags);
S48_GC_PROTECT_3(dbc, skey, sflags);
memset(&key, 0, sizeof(DBT));
memset(&data, 0, sizeof(DBT));
scsh_extract_bytevector_as_DBT(skey, &key);
dbcp = scsh_extract_cursor(dbc);
flags = s48_extract_integer(sflags);
S48_GC_UNPROTECT();
res = dbcp->c_get(dbcp, key, data, flags);
res = dbcp->c_get(dbcp, &key, &data, flags);
CHECK_BDB_RESULT_CODE(res);
return scsh_enter_DBT_as_bytevector(data);
return scsh_enter_DBT_as_bytevector(&data);
}
/* return a count of duplicates */

14
scheme/bdb.scm
View File

@ -368,7 +368,7 @@
;;; DB Cursor : DBC
(define-record-type cursor :cursor
(make-cursor c-pointer)
(really-make-cursor c-pointer)
cursor?
(c-pointer cursor-c-pointer))
@ -975,15 +975,19 @@
result)))))
(import-lambda-definition bdb-cursor-cget-int
(db-handle flags)
(cursor key flags)
"scsh_bdb_cursor_cget")
(define (cursor-get cursor . args)
(define (cursor-get cursor key . args)
(let-optionals args
((flags (or (current-flags) '())))
(let ((result (bdb-cursor-cget-int cursor (flags->value flags))))
(let ((result
(bdb-cursor-cget-int cursor key (flags->value flags))))
(if (integer? result)
(raise-bdb-condition result)
(if (or (= result (return-code-value (return-code not-found)))
(= result (return-code-value (return-code key-empty))))
#f
(raise-bdb-condition result))
result))))
(define (cursor-get/fork . args)