#include "db_config.h"
#ifndef lint
static const char revid[] = "$Id: tcl_db.c,v 1.2 2004/03/30 01:24:05 jtownsen Exp $";
#endif
#ifndef NO_SYSTEM_INCLUDES
#include <sys/types.h>
#include <stdlib.h>
#include <string.h>
#include <tcl.h>
#endif
#include "db_int.h"
#include "dbinc/db_page.h"
#include "dbinc/db_am.h"
#include "dbinc/tcl_db.h"
static int tcl_DbAssociate __P((Tcl_Interp *,
int, Tcl_Obj * CONST*, DB *));
static int tcl_DbClose __P((Tcl_Interp *,
int, Tcl_Obj * CONST*, DB *, DBTCL_INFO *));
static int tcl_DbDelete __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *));
static int tcl_DbGet __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *, int));
#if CONFIG_TEST
static int tcl_DbKeyRange __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *));
#endif
static int tcl_DbPut __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *));
static int tcl_DbStat __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *));
static int tcl_DbTruncate __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *));
static int tcl_DbCursor __P((Tcl_Interp *,
int, Tcl_Obj * CONST*, DB *, DBC **));
static int tcl_DbJoin __P((Tcl_Interp *,
int, Tcl_Obj * CONST*, DB *, DBC **));
static int tcl_DbGetFlags __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *));
static int tcl_DbGetOpenFlags __P((Tcl_Interp *,
int, Tcl_Obj * CONST*, DB *));
static int tcl_DbGetjoin __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *));
static int tcl_DbCount __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *));
static int tcl_second_call __P((DB *, const DBT *, const DBT *, DBT *));
void
_DbInfoDelete(interp, dbip)
Tcl_Interp *interp;
DBTCL_INFO *dbip;
{
DBTCL_INFO *nextp, *p;
for (p = LIST_FIRST(&__db_infohead); p != NULL; p = nextp) {
nextp = LIST_NEXT(p, entries);
if (p->i_parent == dbip && p->i_type == I_DBC) {
(void)Tcl_DeleteCommand(interp, p->i_name);
_DeleteInfo(p);
}
}
(void)Tcl_DeleteCommand(interp, dbip->i_name);
_DeleteInfo(dbip);
}
int
db_Cmd(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
static const char *dbcmds[] = {
#if CONFIG_TEST
"keyrange",
"pget",
"rpcid",
"test",
#endif
"associate",
"close",
"count",
"cursor",
"del",
"get",
"get_bt_minkey",
"get_cachesize",
"get_dbname",
"get_encrypt_flags",
"get_env",
"get_errpfx",
"get_flags",
"get_h_ffactor",
"get_h_nelem",
"get_join",
"get_lorder",
"get_open_flags",
"get_pagesize",
"get_q_extentsize",
"get_re_delim",
"get_re_len",
"get_re_pad",
"get_re_source",
"get_type",
"is_byteswapped",
"join",
"put",
"stat",
"sync",
"truncate",
NULL
};
enum dbcmds {
#if CONFIG_TEST
DBKEYRANGE,
DBPGET,
DBRPCID,
DBTEST,
#endif
DBASSOCIATE,
DBCLOSE,
DBCOUNT,
DBCURSOR,
DBDELETE,
DBGET,
DBGETBTMINKEY,
DBGETCACHESIZE,
DBGETDBNAME,
DBGETENCRYPTFLAGS,
DBGETENV,
DBGETERRPFX,
DBGETFLAGS,
DBGETHFFACTOR,
DBGETHNELEM,
DBGETJOIN,
DBGETLORDER,
DBGETOPENFLAGS,
DBGETPAGESIZE,
DBGETQEXTENTSIZE,
DBGETREDELIM,
DBGETRELEN,
DBGETREPAD,
DBGETRESOURCE,
DBGETTYPE,
DBSWAPPED,
DBJOIN,
DBPUT,
DBSTAT,
DBSYNC,
DBTRUNCATE
};
DB *dbp;
DB_ENV *dbenv;
DBC *dbc;
DBTCL_INFO *dbip, *ip;
DBTYPE type;
Tcl_Obj *res, *myobjv[3];
int cmdindex, intval, ncache, result, ret;
char newname[MSG_SIZE];
u_int32_t bytes, gbytes, value;
const char *strval, *filename, *dbname, *envid;
Tcl_ResetResult(interp);
dbp = (DB *)clientData;
dbip = _PtrToInfo((void *)dbp);
memset(newname, 0, MSG_SIZE);
result = TCL_OK;
if (objc <= 1) {
Tcl_WrongNumArgs(interp, 1, objv, "command cmdargs");
return (TCL_ERROR);
}
if (dbp == NULL) {
Tcl_SetResult(interp, "NULL db pointer", TCL_STATIC);
return (TCL_ERROR);
}
if (dbip == NULL) {
Tcl_SetResult(interp, "NULL db info pointer", TCL_STATIC);
return (TCL_ERROR);
}
if (Tcl_GetIndexFromObj(interp,
objv[1], dbcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
return (IS_HELP(objv[1]));
res = NULL;
switch ((enum dbcmds)cmdindex) {
#if CONFIG_TEST
case DBKEYRANGE:
result = tcl_DbKeyRange(interp, objc, objv, dbp);
break;
case DBPGET:
result = tcl_DbGet(interp, objc, objv, dbp, 1);
break;
case DBRPCID:
if (objc > 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return (TCL_ERROR);
}
res = Tcl_NewLongObj(dbp->cl_id);
break;
case DBTEST:
result = tcl_EnvTest(interp, objc, objv, dbp->dbenv);
break;
#endif
case DBASSOCIATE:
result = tcl_DbAssociate(interp, objc, objv, dbp);
break;
case DBCLOSE:
result = tcl_DbClose(interp, objc, objv, dbp, dbip);
break;
case DBDELETE:
result = tcl_DbDelete(interp, objc, objv, dbp);
break;
case DBGET:
result = tcl_DbGet(interp, objc, objv, dbp, 0);
break;
case DBPUT:
result = tcl_DbPut(interp, objc, objv, dbp);
break;
case DBCOUNT:
result = tcl_DbCount(interp, objc, objv, dbp);
break;
case DBSWAPPED:
if (objc > 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return (TCL_ERROR);
}
_debug_check();
ret = dbp->get_byteswapped(dbp, &intval);
res = Tcl_NewIntObj(intval);
break;
case DBGETTYPE:
if (objc > 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return (TCL_ERROR);
}
_debug_check();
ret = dbp->get_type(dbp, &type);
if (type == DB_BTREE)
res = Tcl_NewStringObj("btree", strlen("btree"));
else if (type == DB_HASH)
res = Tcl_NewStringObj("hash", strlen("hash"));
else if (type == DB_RECNO)
res = Tcl_NewStringObj("recno", strlen("recno"));
else if (type == DB_QUEUE)
res = Tcl_NewStringObj("queue", strlen("queue"));
else {
Tcl_SetResult(interp,
"db gettype: Returned unknown type\n", TCL_STATIC);
result = TCL_ERROR;
}
break;
case DBSTAT:
result = tcl_DbStat(interp, objc, objv, dbp);
break;
case DBSYNC:
if (objc > 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return (TCL_ERROR);
}
_debug_check();
ret = dbp->sync(dbp, 0);
res = Tcl_NewIntObj(ret);
if (ret != 0) {
Tcl_SetObjResult(interp, res);
result = TCL_ERROR;
}
break;
case DBCURSOR:
snprintf(newname, sizeof(newname),
"%s.c%d", dbip->i_name, dbip->i_dbdbcid);
ip = _NewInfo(interp, NULL, newname, I_DBC);
if (ip != NULL) {
result = tcl_DbCursor(interp, objc, objv, dbp, &dbc);
if (result == TCL_OK) {
dbip->i_dbdbcid++;
ip->i_parent = dbip;
Tcl_CreateObjCommand(interp, newname,
(Tcl_ObjCmdProc *)dbc_Cmd,
(ClientData)dbc, NULL);
res =
Tcl_NewStringObj(newname, strlen(newname));
_SetInfoData(ip, dbc);
} else
_DeleteInfo(ip);
} else {
Tcl_SetResult(interp,
"Could not set up info", TCL_STATIC);
result = TCL_ERROR;
}
break;
case DBJOIN:
snprintf(newname, sizeof(newname),
"%s.c%d", dbip->i_name, dbip->i_dbdbcid);
ip = _NewInfo(interp, NULL, newname, I_DBC);
if (ip != NULL) {
result = tcl_DbJoin(interp, objc, objv, dbp, &dbc);
if (result == TCL_OK) {
dbip->i_dbdbcid++;
ip->i_parent = dbip;
Tcl_CreateObjCommand(interp, newname,
(Tcl_ObjCmdProc *)dbc_Cmd,
(ClientData)dbc, NULL);
res =
Tcl_NewStringObj(newname, strlen(newname));
_SetInfoData(ip, dbc);
} else
_DeleteInfo(ip);
} else {
Tcl_SetResult(interp,
"Could not set up info", TCL_STATIC);
result = TCL_ERROR;
}
break;
case DBGETBTMINKEY:
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return (TCL_ERROR);
}
ret = dbp->get_bt_minkey(dbp, &value);
if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"db get_bt_minkey")) == TCL_OK)
res = Tcl_NewIntObj(value);
break;
case DBGETCACHESIZE:
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return (TCL_ERROR);
}
ret = dbp->get_cachesize(dbp, &gbytes, &bytes, &ncache);
if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"db get_cachesize")) == TCL_OK) {
myobjv[0] = Tcl_NewIntObj(gbytes);
myobjv[1] = Tcl_NewIntObj(bytes);
myobjv[2] = Tcl_NewIntObj(ncache);
res = Tcl_NewListObj(3, myobjv);
}
break;
case DBGETDBNAME:
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return (TCL_ERROR);
}
ret = dbp->get_dbname(dbp, &filename, &dbname);
if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"db get_dbname")) == TCL_OK) {
myobjv[0] = Tcl_NewStringObj(filename,
strlen(filename));
myobjv[1] = Tcl_NewStringObj(dbname, strlen(dbname));
res = Tcl_NewListObj(2, myobjv);
}
break;
case DBGETENCRYPTFLAGS:
result = tcl_EnvGetEncryptFlags(interp, objc, objv, dbp->dbenv);
break;
case DBGETENV:
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return (TCL_ERROR);
}
ret = dbp->get_env(dbp, &dbenv);
if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"db get_env")) == TCL_OK) {
if (dbenv != NULL && (ip = _PtrToInfo(dbenv)) != NULL) {
envid = ip->i_name;
res = Tcl_NewStringObj(envid, strlen(envid));
} else
Tcl_ResetResult(interp);
}
break;
case DBGETERRPFX:
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return (TCL_ERROR);
}
dbp->get_errpfx(dbp, &strval);
res = Tcl_NewStringObj(strval, strlen(strval));
break;
case DBGETFLAGS:
result = tcl_DbGetFlags(interp, objc, objv, dbp);
break;
case DBGETHFFACTOR:
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return (TCL_ERROR);
}
ret = dbp->get_h_ffactor(dbp, &value);
if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"db get_h_ffactor")) == TCL_OK)
res = Tcl_NewIntObj(value);
break;
case DBGETHNELEM:
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return (TCL_ERROR);
}
ret = dbp->get_h_nelem(dbp, &value);
if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"db get_h_nelem")) == TCL_OK)
res = Tcl_NewIntObj(value);
break;
case DBGETJOIN:
result = tcl_DbGetjoin(interp, objc, objv, dbp);
break;
case DBGETLORDER:
if (objc > 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return (TCL_ERROR);
}
_debug_check();
ret = dbp->get_lorder(dbp, &intval);
res = Tcl_NewIntObj(intval);
break;
case DBGETOPENFLAGS:
result = tcl_DbGetOpenFlags(interp, objc, objv, dbp);
break;
case DBGETPAGESIZE:
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return (TCL_ERROR);
}
ret = dbp->get_pagesize(dbp, &value);
if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"db get_pagesize")) == TCL_OK)
res = Tcl_NewIntObj(value);
break;
case DBGETQEXTENTSIZE:
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return (TCL_ERROR);
}
ret = dbp->get_q_extentsize(dbp, &value);
if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"db get_q_extentsize")) == TCL_OK)
res = Tcl_NewIntObj(value);
break;
case DBGETREDELIM:
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return (TCL_ERROR);
}
ret = dbp->get_re_delim(dbp, &intval);
if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"db get_re_delim")) == TCL_OK)
res = Tcl_NewIntObj(intval);
break;
case DBGETRELEN:
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return (TCL_ERROR);
}
ret = dbp->get_re_len(dbp, &value);
if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"db get_re_len")) == TCL_OK)
res = Tcl_NewIntObj(value);
break;
case DBGETREPAD:
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return (TCL_ERROR);
}
ret = dbp->get_re_pad(dbp, &result);
if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"db get_re_pad")) == TCL_OK)
res = Tcl_NewIntObj(result);
break;
case DBGETRESOURCE:
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return (TCL_ERROR);
}
ret = dbp->get_re_source(dbp, &strval);
if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"db get_re_source")) == TCL_OK)
res = Tcl_NewStringObj(strval, strlen(strval));
break;
case DBTRUNCATE:
result = tcl_DbTruncate(interp, objc, objv, dbp);
break;
}
if (result == TCL_OK && res)
Tcl_SetObjResult(interp, res);
return (result);
}
static int
tcl_DbStat(interp, objc, objv, dbp)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
DB *dbp;
{
DB_BTREE_STAT *bsp;
DB_HASH_STAT *hsp;
DB_QUEUE_STAT *qsp;
void *sp;
Tcl_Obj *res, *flaglist, *myobjv[2];
DBTYPE type;
u_int32_t flag;
int result, ret;
char *arg;
result = TCL_OK;
flag = 0;
if (objc > 3) {
Tcl_WrongNumArgs(interp, 2, objv, "?-faststat?");
return (TCL_ERROR);
}
if (objc == 3) {
arg = Tcl_GetStringFromObj(objv[2], NULL);
if (strcmp(arg, "-faststat") == 0)
flag = DB_FAST_STAT;
else {
Tcl_SetResult(interp,
"db stat: unknown arg", TCL_STATIC);
return (TCL_ERROR);
}
}
_debug_check();
ret = dbp->stat(dbp, &sp, flag);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db stat");
if (result == TCL_ERROR)
return (result);
(void)dbp->get_type(dbp, &type);
res = Tcl_NewObj();
if (type == DB_HASH) {
hsp = (DB_HASH_STAT *)sp;
MAKE_STAT_LIST("Magic", hsp->hash_magic);
MAKE_STAT_LIST("Version", hsp->hash_version);
MAKE_STAT_LIST("Page size", hsp->hash_pagesize);
MAKE_STAT_LIST("Number of keys", hsp->hash_nkeys);
MAKE_STAT_LIST("Number of records", hsp->hash_ndata);
MAKE_STAT_LIST("Fill factor", hsp->hash_ffactor);
MAKE_STAT_LIST("Buckets", hsp->hash_buckets);
if (flag != DB_FAST_STAT) {
MAKE_STAT_LIST("Free pages", hsp->hash_free);
MAKE_STAT_LIST("Bytes free", hsp->hash_bfree);
MAKE_STAT_LIST("Number of big pages",
hsp->hash_bigpages);
MAKE_STAT_LIST("Big pages bytes free",
hsp->hash_big_bfree);
MAKE_STAT_LIST("Overflow pages", hsp->hash_overflows);
MAKE_STAT_LIST("Overflow bytes free",
hsp->hash_ovfl_free);
MAKE_STAT_LIST("Duplicate pages", hsp->hash_dup);
MAKE_STAT_LIST("Duplicate pages bytes free",
hsp->hash_dup_free);
}
} else if (type == DB_QUEUE) {
qsp = (DB_QUEUE_STAT *)sp;
MAKE_STAT_LIST("Magic", qsp->qs_magic);
MAKE_STAT_LIST("Version", qsp->qs_version);
MAKE_STAT_LIST("Page size", qsp->qs_pagesize);
MAKE_STAT_LIST("Extent size", qsp->qs_extentsize);
MAKE_STAT_LIST("Number of records", qsp->qs_nkeys);
MAKE_STAT_LIST("Record length", qsp->qs_re_len);
MAKE_STAT_LIST("Record pad", qsp->qs_re_pad);
MAKE_STAT_LIST("First record number", qsp->qs_first_recno);
MAKE_STAT_LIST("Last record number", qsp->qs_cur_recno);
if (flag != DB_FAST_STAT) {
MAKE_STAT_LIST("Number of pages", qsp->qs_pages);
MAKE_STAT_LIST("Bytes free", qsp->qs_pgfree);
}
} else {
bsp = (DB_BTREE_STAT *)sp;
MAKE_STAT_LIST("Magic", bsp->bt_magic);
MAKE_STAT_LIST("Version", bsp->bt_version);
MAKE_STAT_LIST("Number of keys", bsp->bt_nkeys);
MAKE_STAT_LIST("Number of records", bsp->bt_ndata);
MAKE_STAT_LIST("Minimum keys per page", bsp->bt_minkey);
MAKE_STAT_LIST("Fixed record length", bsp->bt_re_len);
MAKE_STAT_LIST("Record pad", bsp->bt_re_pad);
MAKE_STAT_LIST("Page size", bsp->bt_pagesize);
if (flag != DB_FAST_STAT) {
MAKE_STAT_LIST("Levels", bsp->bt_levels);
MAKE_STAT_LIST("Internal pages", bsp->bt_int_pg);
MAKE_STAT_LIST("Leaf pages", bsp->bt_leaf_pg);
MAKE_STAT_LIST("Duplicate pages", bsp->bt_dup_pg);
MAKE_STAT_LIST("Overflow pages", bsp->bt_over_pg);
MAKE_STAT_LIST("Pages on freelist", bsp->bt_free);
MAKE_STAT_LIST("Internal pages bytes free",
bsp->bt_int_pgfree);
MAKE_STAT_LIST("Leaf pages bytes free",
bsp->bt_leaf_pgfree);
MAKE_STAT_LIST("Duplicate pages bytes free",
bsp->bt_dup_pgfree);
MAKE_STAT_LIST("Bytes free in overflow pages",
bsp->bt_over_pgfree);
}
}
myobjv[0] = Tcl_NewStringObj("Flags", strlen("Flags"));
myobjv[1] = _GetFlagsList(interp, dbp->flags, __db_inmemdbflags);
flaglist = Tcl_NewListObj(2, myobjv);
if (flaglist == NULL) {
result = TCL_ERROR;
goto error;
}
if ((result =
Tcl_ListObjAppendElement(interp, res, flaglist)) != TCL_OK)
goto error;
Tcl_SetObjResult(interp, res);
error:
(void)__os_ufree(dbp->dbenv, sp);
return (result);
}
static int
tcl_DbClose(interp, objc, objv, dbp, dbip)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
DB *dbp;
DBTCL_INFO *dbip;
{
static const char *dbclose[] = {
"-nosync", "--", NULL
};
enum dbclose {
TCL_DBCLOSE_NOSYNC,
TCL_DBCLOSE_ENDARG
};
u_int32_t flag;
int endarg, i, optindex, result, ret;
char *arg;
result = TCL_OK;
endarg = 0;
flag = 0;
if (objc > 4) {
Tcl_WrongNumArgs(interp, 2, objv, "?-nosync?");
return (TCL_ERROR);
}
i = 2;
while (i < objc) {
if (Tcl_GetIndexFromObj(interp, objv[i], dbclose,
"option", TCL_EXACT, &optindex) != TCL_OK) {
arg = Tcl_GetStringFromObj(objv[i], NULL);
if (arg[0] == '-')
return (IS_HELP(objv[i]));
else
Tcl_ResetResult(interp);
break;
}
i++;
switch ((enum dbclose)optindex) {
case TCL_DBCLOSE_NOSYNC:
flag = DB_NOSYNC;
break;
case TCL_DBCLOSE_ENDARG:
endarg = 1;
break;
}
if (result != TCL_OK)
return (result);
if (endarg)
break;
}
_DbInfoDelete(interp, dbip);
_debug_check();
dbp->api_internal = NULL;
ret = (dbp)->close(dbp, flag);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db close");
return (result);
}
static int
tcl_DbPut(interp, objc, objv, dbp)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
DB *dbp;
{
static const char *dbputopts[] = {
#if CONFIG_TEST
"-nodupdata",
#endif
"-append",
"-auto_commit",
"-nooverwrite",
"-partial",
"-txn",
NULL
};
enum dbputopts {
#if CONFIG_TEST
DBGET_NODUPDATA,
#endif
DBPUT_APPEND,
DBPUT_AUTO_COMMIT,
DBPUT_NOOVER,
DBPUT_PART,
DBPUT_TXN
};
static const char *dbputapp[] = {
"-append", NULL
};
enum dbputapp { DBPUT_APPEND0 };
DBT key, data;
DBTYPE type;
DB_TXN *txn;
Tcl_Obj **elemv, *res;
void *dtmp, *ktmp;
db_recno_t recno;
u_int32_t flag;
int auto_commit, elemc, end, freekey, freedata;
int i, optindex, result, ret;
char *arg, msg[MSG_SIZE];
txn = NULL;
result = TCL_OK;
flag = 0;
if (objc <= 3) {
Tcl_WrongNumArgs(interp, 2, objv, "?-args? key data");
return (TCL_ERROR);
}
freekey = freedata = 0;
memset(&key, 0, sizeof(key));
memset(&data, 0, sizeof(data));
(void)dbp->get_type(dbp, &type);
end = objc - 2;
if (type == DB_QUEUE || type == DB_RECNO) {
i = 2;
while (i < objc - 1) {
if (Tcl_GetIndexFromObj(interp, objv[i++], dbputapp,
"option", TCL_EXACT, &optindex) != TCL_OK)
continue;
switch ((enum dbputapp)optindex) {
case DBPUT_APPEND0:
end = objc - 1;
break;
}
}
}
Tcl_ResetResult(interp);
i = 2;
auto_commit = 0;
while (i < end) {
if (Tcl_GetIndexFromObj(interp, objv[i],
dbputopts, "option", TCL_EXACT, &optindex) != TCL_OK)
return (IS_HELP(objv[i]));
i++;
switch ((enum dbputopts)optindex) {
#if CONFIG_TEST
case DBGET_NODUPDATA:
FLAG_CHECK(flag);
flag = DB_NODUPDATA;
break;
#endif
case DBPUT_TXN:
if (i > (end - 1)) {
Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
result = TCL_ERROR;
break;
}
arg = Tcl_GetStringFromObj(objv[i++], NULL);
txn = NAME_TO_TXN(arg);
if (txn == NULL) {
snprintf(msg, MSG_SIZE,
"Put: Invalid txn: %s\n", arg);
Tcl_SetResult(interp, msg, TCL_VOLATILE);
result = TCL_ERROR;
}
break;
case DBPUT_AUTO_COMMIT:
auto_commit = 1;
break;
case DBPUT_APPEND:
FLAG_CHECK(flag);
flag = DB_APPEND;
break;
case DBPUT_NOOVER:
FLAG_CHECK(flag);
flag = DB_NOOVERWRITE;
break;
case DBPUT_PART:
if (i > (end - 1)) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-partial {offset length}?");
result = TCL_ERROR;
break;
}
result = Tcl_ListObjGetElements(interp, objv[i++],
&elemc, &elemv);
if (elemc != 2) {
Tcl_SetResult(interp,
"List must be {offset length}", TCL_STATIC);
result = TCL_ERROR;
break;
}
data.flags = DB_DBT_PARTIAL;
result = _GetUInt32(interp, elemv[0], &data.doff);
if (result != TCL_OK)
break;
result = _GetUInt32(interp, elemv[1], &data.dlen);
break;
}
if (result != TCL_OK)
break;
}
if (result == TCL_ERROR)
return (result);
if (type == DB_QUEUE || type == DB_RECNO) {
key.data = &recno;
key.ulen = key.size = sizeof(db_recno_t);
key.flags = DB_DBT_USERMEM;
if (flag == DB_APPEND)
recno = 0;
else {
result = _GetUInt32(interp, objv[objc-2], &recno);
if (result != TCL_OK)
return (result);
}
} else {
ret = _CopyObjBytes(interp, objv[objc-2], &ktmp,
&key.size, &freekey);
if (ret != 0) {
result = _ReturnSetup(interp, ret,
DB_RETOK_DBPUT(ret), "db put");
return (result);
}
key.data = ktmp;
}
if (auto_commit)
flag |= DB_AUTO_COMMIT;
ret = _CopyObjBytes(interp, objv[objc-1], &dtmp,
&data.size, &freedata);
if (ret != 0) {
result = _ReturnSetup(interp, ret,
DB_RETOK_DBPUT(ret), "db put");
goto out;
}
data.data = dtmp;
_debug_check();
ret = dbp->put(dbp, txn, &key, &data, flag);
result = _ReturnSetup(interp, ret, DB_RETOK_DBPUT(ret), "db put");
if (ret == 0 &&
(type == DB_RECNO || type == DB_QUEUE) && flag == DB_APPEND) {
res = Tcl_NewWideIntObj((Tcl_WideInt)recno);
Tcl_SetObjResult(interp, res);
}
out:
if (freedata)
(void)__os_free(dbp->dbenv, dtmp);
if (freekey)
(void)__os_free(dbp->dbenv, ktmp);
return (result);
}
static int
tcl_DbGet(interp, objc, objv, dbp, ispget)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
DB *dbp;
int ispget;
{
static const char *dbgetopts[] = {
#if CONFIG_TEST
"-dirty",
"-multi",
#endif
"-auto_commit",
"-consume",
"-consume_wait",
"-get_both",
"-glob",
"-partial",
"-recno",
"-rmw",
"-txn",
"--",
NULL
};
enum dbgetopts {
#if CONFIG_TEST
DBGET_DIRTY,
DBGET_MULTI,
#endif
DBGET_AUTO_COMMIT,
DBGET_CONSUME,
DBGET_CONSUME_WAIT,
DBGET_BOTH,
DBGET_GLOB,
DBGET_PART,
DBGET_RECNO,
DBGET_RMW,
DBGET_TXN,
DBGET_ENDARG
};
DBC *dbc;
DBT key, pkey, data, save;
DBTYPE ptype, type;
DB_TXN *txn;
Tcl_Obj **elemv, *retlist;
void *dtmp, *ktmp;
u_int32_t aflag, flag, cflag, isdup, mflag, rmw;
int elemc, end, endarg, freekey, freedata, i;
int optindex, result, ret, useglob, useprecno, userecno;
char *arg, *pattern, *prefix, msg[MSG_SIZE];
db_recno_t precno, recno;
#if CONFIG_TEST
int bufsize;
#endif
result = TCL_OK;
freekey = freedata = 0;
aflag = cflag = endarg = flag = mflag = rmw = 0;
useglob = userecno = 0;
txn = NULL;
pattern = prefix = NULL;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv, "?-args? key");
return (TCL_ERROR);
}
memset(&key, 0, sizeof(key));
memset(&data, 0, sizeof(data));
memset(&save, 0, sizeof(save));
memset(&pkey, 0, sizeof(pkey));
i = 2;
(void)dbp->get_type(dbp, &type);
end = objc;
while (i < end) {
if (Tcl_GetIndexFromObj(interp, objv[i], dbgetopts, "option",
TCL_EXACT, &optindex) != TCL_OK) {
arg = Tcl_GetStringFromObj(objv[i], NULL);
if (arg[0] == '-') {
result = IS_HELP(objv[i]);
goto out;
} else
Tcl_ResetResult(interp);
break;
}
i++;
switch ((enum dbgetopts)optindex) {
#if CONFIG_TEST
case DBGET_DIRTY:
rmw |= DB_DIRTY_READ;
break;
case DBGET_MULTI:
mflag |= DB_MULTIPLE;
result = Tcl_GetIntFromObj(interp, objv[i], &bufsize);
if (result != TCL_OK)
goto out;
i++;
break;
#endif
case DBGET_AUTO_COMMIT:
aflag |= DB_AUTO_COMMIT;
break;
case DBGET_BOTH:
if (i > objc - 2) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-get_both key data?");
result = TCL_ERROR;
break;
}
end = objc - 2;
FLAG_CHECK(flag);
flag = DB_GET_BOTH;
break;
case DBGET_TXN:
if (i >= end) {
Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
result = TCL_ERROR;
break;
}
arg = Tcl_GetStringFromObj(objv[i++], NULL);
txn = NAME_TO_TXN(arg);
if (txn == NULL) {
snprintf(msg, MSG_SIZE,
"Get: Invalid txn: %s\n", arg);
Tcl_SetResult(interp, msg, TCL_VOLATILE);
result = TCL_ERROR;
}
break;
case DBGET_GLOB:
useglob = 1;
end = objc - 1;
break;
case DBGET_CONSUME:
FLAG_CHECK(flag);
flag = DB_CONSUME;
break;
case DBGET_CONSUME_WAIT:
FLAG_CHECK(flag);
flag = DB_CONSUME_WAIT;
break;
case DBGET_RECNO:
end = objc - 1;
userecno = 1;
if (type != DB_RECNO && type != DB_QUEUE) {
FLAG_CHECK(flag);
flag = DB_SET_RECNO;
key.flags |= DB_DBT_MALLOC;
}
break;
case DBGET_RMW:
rmw |= DB_RMW;
break;
case DBGET_PART:
end = objc - 1;
if (i == end) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-partial {offset length}?");
result = TCL_ERROR;
break;
}
result = Tcl_ListObjGetElements(interp, objv[i++],
&elemc, &elemv);
if (elemc != 2) {
Tcl_SetResult(interp,
"List must be {offset length}", TCL_STATIC);
result = TCL_ERROR;
break;
}
save.flags = DB_DBT_PARTIAL;
result = _GetUInt32(interp, elemv[0], &save.doff);
if (result != TCL_OK)
break;
result = _GetUInt32(interp, elemv[1], &save.dlen);
break;
case DBGET_ENDARG:
endarg = 1;
break;
}
if (result != TCL_OK)
break;
if (endarg)
break;
}
if (result != TCL_OK)
goto out;
if (type == DB_RECNO || type == DB_QUEUE)
userecno = 1;
if (((flag == DB_CONSUME || flag == DB_CONSUME_WAIT) && i != objc) ||
(flag == DB_GET_BOTH && i != objc - 2)) {
Tcl_SetResult(interp,
"Wrong number of key/data given based on flags specified\n",
TCL_STATIC);
result = TCL_ERROR;
goto out;
} else if (flag == 0 && i != objc - 1) {
Tcl_SetResult(interp,
"Wrong number of key/data given\n", TCL_STATIC);
result = TCL_ERROR;
goto out;
}
if (ispget && dbp->s_primary != NULL) {
(void)dbp->s_primary->get_type(dbp->s_primary, &ptype);
useprecno = ptype == DB_RECNO || ptype == DB_QUEUE;
} else
useprecno = 0;
if (useglob && (userecno || flag == DB_SET_RECNO ||
type == DB_RECNO || type == DB_QUEUE)) {
Tcl_SetResult(interp,
"Cannot use -glob and record numbers.\n",
TCL_STATIC);
result = TCL_ERROR;
goto out;
}
if (useglob && flag == DB_GET_BOTH) {
Tcl_SetResult(interp,
"Only one of -glob or -get_both can be specified.\n",
TCL_STATIC);
result = TCL_ERROR;
goto out;
}
if (useglob)
pattern = Tcl_GetStringFromObj(objv[objc - 1], NULL);
retlist = Tcl_NewListObj(0, NULL);
save.flags |= DB_DBT_MALLOC;
if ((ret = dbp->get_flags(dbp, &isdup)) != 0) {
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db get");
goto out;
}
isdup &= DB_DUP;
if (pattern == NULL && (isdup == 0 || mflag != 0 ||
flag == DB_SET_RECNO || flag == DB_GET_BOTH ||
flag == DB_CONSUME || flag == DB_CONSUME_WAIT)) {
if (flag == DB_GET_BOTH) {
if (userecno) {
result = _GetUInt32(interp,
objv[(objc - 2)], &recno);
if (result == TCL_OK) {
key.data = &recno;
key.size = sizeof(db_recno_t);
} else
goto out;
} else {
ret = _CopyObjBytes(interp, objv[objc-2],
&ktmp, &key.size, &freekey);
if (ret != 0) {
result = _ReturnSetup(interp, ret,
DB_RETOK_DBGET(ret), "db get");
goto out;
}
key.data = ktmp;
}
if (useprecno) {
result = _GetUInt32(interp,
objv[objc - 1], &precno);
if (result == TCL_OK) {
save.data = &precno;
save.size = sizeof(db_recno_t);
} else
goto out;
} else {
ret = _CopyObjBytes(interp, objv[objc-1],
&dtmp, &save.size, &freedata);
if (ret != 0) {
result = _ReturnSetup(interp, ret,
DB_RETOK_DBGET(ret), "db get");
goto out;
}
save.data = dtmp;
}
} else if (flag != DB_CONSUME && flag != DB_CONSUME_WAIT) {
if (userecno) {
result = _GetUInt32(
interp, objv[(objc - 1)], &recno);
if (result == TCL_OK) {
key.data = &recno;
key.size = sizeof(db_recno_t);
} else
goto out;
} else {
ret = _CopyObjBytes(interp, objv[objc-1],
&ktmp, &key.size, &freekey);
if (ret != 0) {
result = _ReturnSetup(interp, ret,
DB_RETOK_DBGET(ret), "db get");
goto out;
}
key.data = ktmp;
}
#if CONFIG_TEST
if (mflag & DB_MULTIPLE) {
if ((ret = __os_malloc(dbp->dbenv,
bufsize, &save.data)) != 0) {
Tcl_SetResult(interp,
db_strerror(ret), TCL_STATIC);
goto out;
}
save.ulen = bufsize;
F_CLR(&save, DB_DBT_MALLOC);
F_SET(&save, DB_DBT_USERMEM);
}
#endif
}
data = save;
if (ispget) {
if (flag == DB_GET_BOTH) {
pkey.data = save.data;
pkey.size = save.size;
data.data = NULL;
data.size = 0;
}
F_SET(&pkey, DB_DBT_MALLOC);
_debug_check();
ret = dbp->pget(dbp,
txn, &key, &pkey, &data, flag | rmw);
} else {
_debug_check();
ret = dbp->get(dbp,
txn, &key, &data, flag | aflag | rmw | mflag);
}
result = _ReturnSetup(interp, ret, DB_RETOK_DBGET(ret),
"db get");
if (ret == 0) {
if (mflag & DB_MULTIPLE)
result = _SetMultiList(interp,
retlist, &key, &data, type, flag);
else if (type == DB_RECNO || type == DB_QUEUE)
if (ispget)
result = _Set3DBTList(interp,
retlist, &key, 1, &pkey,
useprecno, &data);
else
result = _SetListRecnoElem(interp,
retlist, *(db_recno_t *)key.data,
data.data, data.size);
else {
if (ispget)
result = _Set3DBTList(interp,
retlist, &key, 0, &pkey,
useprecno, &data);
else
result = _SetListElem(interp, retlist,
key.data, key.size,
data.data, data.size);
}
}
if (F_ISSET(&key, DB_DBT_MALLOC) && ret == 0)
(void)__os_ufree(dbp->dbenv, key.data);
if (F_ISSET(&data, DB_DBT_MALLOC) && ret == 0)
(void)__os_ufree(dbp->dbenv, data.data);
else if (!F_ISSET(&data, DB_DBT_MALLOC))
__os_free(dbp->dbenv, data.data);
if (ispget && ret == 0)
(void)__os_ufree(dbp->dbenv, pkey.data);
if (result == TCL_OK)
Tcl_SetObjResult(interp, retlist);
goto out;
}
if (userecno) {
result = _GetUInt32(interp, objv[(objc - 1)], &recno);
if (result == TCL_OK) {
key.data = &recno;
key.size = sizeof(db_recno_t);
} else
goto out;
} else {
ret = _CopyObjBytes(interp, objv[objc-1], &ktmp,
&key.size, &freekey);
if (ret != 0) {
result = _ReturnSetup(interp, ret,
DB_RETOK_DBGET(ret), "db get");
return (result);
}
key.data = ktmp;
}
ret = dbp->cursor(dbp, txn, &dbc, 0);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db cursor");
if (result == TCL_ERROR)
goto out;
memset(&data, 0, sizeof(data));
data = save;
if (pattern) {
ret = _GetGlobPrefix(pattern, &prefix);
if (ret) {
result = TCL_ERROR;
Tcl_SetResult(interp,
"Unable to allocate pattern space", TCL_STATIC);
goto out1;
}
key.data = prefix;
key.size = strlen(prefix);
if (strlen(prefix) == 0)
cflag = DB_FIRST;
else
cflag = DB_SET_RANGE;
} else
cflag = DB_SET;
if (ispget) {
_debug_check();
F_SET(&pkey, DB_DBT_MALLOC);
ret = dbc->c_pget(dbc, &key, &pkey, &data, cflag | rmw);
} else {
_debug_check();
ret = dbc->c_get(dbc, &key, &data, cflag | rmw);
}
result = _ReturnSetup(interp, ret, DB_RETOK_DBCGET(ret),
"db get (cursor)");
if (result == TCL_ERROR)
goto out1;
if (ret == 0 && pattern &&
memcmp(key.data, prefix, strlen(prefix)) != 0) {
(void)__os_ufree(dbp->dbenv, data.data);
goto out1;
}
if (pattern)
cflag = DB_NEXT;
else
cflag = DB_NEXT_DUP;
while (ret == 0 && result == TCL_OK) {
if (ispget)
result = _Set3DBTList(interp, retlist, &key, 0,
&pkey, useprecno, &data);
else
result = _SetListElem(interp, retlist,
key.data, key.size, data.data, data.size);
if (ispget)
(void)__os_ufree(dbp->dbenv, pkey.data);
(void)__os_ufree(dbp->dbenv, data.data);
if (result != TCL_OK)
break;
memset(&key, 0, sizeof(key));
memset(&pkey, 0, sizeof(pkey));
memset(&data, 0, sizeof(data));
data = save;
if (ispget) {
F_SET(&pkey, DB_DBT_MALLOC);
ret = dbc->c_pget(dbc, &key, &pkey, &data, cflag | rmw);
} else
ret = dbc->c_get(dbc, &key, &data, cflag | rmw);
if (ret == 0 && pattern &&
memcmp(key.data, prefix, strlen(prefix)) != 0) {
(void)__os_ufree(dbp->dbenv, data.data);
break;
}
}
out1:
dbc->c_close(dbc);
if (result == TCL_OK)
Tcl_SetObjResult(interp, retlist);
out:
if (prefix != NULL)
__os_free(dbp->dbenv, prefix);
if (freedata)
(void)__os_free(dbp->dbenv, dtmp);
if (freekey)
(void)__os_free(dbp->dbenv, ktmp);
return (result);
}
static int
tcl_DbDelete(interp, objc, objv, dbp)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
DB *dbp;
{
static const char *dbdelopts[] = {
"-auto_commit",
"-glob",
"-txn",
NULL
};
enum dbdelopts {
DBDEL_AUTO_COMMIT,
DBDEL_GLOB,
DBDEL_TXN
};
DBC *dbc;
DBT key, data;
DBTYPE type;
DB_TXN *txn;
void *ktmp;
db_recno_t recno;
int freekey, i, optindex, result, ret;
u_int32_t flag;
char *arg, *pattern, *prefix, msg[MSG_SIZE];
result = TCL_OK;
freekey = 0;
flag = 0;
pattern = prefix = NULL;
txn = NULL;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv, "?-args? key");
return (TCL_ERROR);
}
memset(&key, 0, sizeof(key));
i = 2;
while (i < objc) {
if (Tcl_GetIndexFromObj(interp, objv[i], dbdelopts, "option",
TCL_EXACT, &optindex) != TCL_OK) {
if (IS_HELP(objv[i]) == TCL_OK)
return (TCL_OK);
Tcl_ResetResult(interp);
break;
}
i++;
switch ((enum dbdelopts)optindex) {
case DBDEL_TXN:
if (i == objc) {
i--;
break;
}
arg = Tcl_GetStringFromObj(objv[i++], NULL);
txn = NAME_TO_TXN(arg);
if (txn == NULL) {
snprintf(msg, MSG_SIZE,
"Delete: Invalid txn: %s\n", arg);
Tcl_SetResult(interp, msg, TCL_VOLATILE);
result = TCL_ERROR;
}
break;
case DBDEL_AUTO_COMMIT:
flag |= DB_AUTO_COMMIT;
break;
case DBDEL_GLOB:
if (i == objc) {
i--;
break;
}
pattern = Tcl_GetStringFromObj(objv[i++], NULL);
break;
}
if (result != TCL_OK)
break;
}
if (result != TCL_OK)
goto out;
if (pattern == NULL) {
if (i != (objc - 1)) {
Tcl_WrongNumArgs(
interp, 2, objv, "?args? -glob pattern | key");
result = TCL_ERROR;
goto out;
}
} else {
if (i != objc) {
Tcl_WrongNumArgs(
interp, 2, objv, "?args? -glob pattern | key");
result = TCL_ERROR;
goto out;
}
if (flag & DB_AUTO_COMMIT) {
Tcl_SetResult(interp,
"Cannot use -auto_commit and patterns.\n",
TCL_STATIC);
result = TCL_ERROR;
goto out;
}
}
(void)dbp->get_type(dbp, &type);
ret = 0;
while (i < objc && ret == 0) {
memset(&key, 0, sizeof(key));
if (type == DB_RECNO || type == DB_QUEUE) {
result = _GetUInt32(interp, objv[i++], &recno);
if (result == TCL_OK) {
key.data = &recno;
key.size = sizeof(db_recno_t);
} else
return (result);
} else {
ret = _CopyObjBytes(interp, objv[i++], &ktmp,
&key.size, &freekey);
if (ret != 0) {
result = _ReturnSetup(interp, ret,
DB_RETOK_DBDEL(ret), "db del");
return (result);
}
key.data = ktmp;
}
_debug_check();
ret = dbp->del(dbp, txn, &key, flag);
if (freekey)
(void)__os_free(dbp->dbenv, ktmp);
if (ret != 0)
break;
}
result = _ReturnSetup(interp, ret, DB_RETOK_DBDEL(ret), "db del");
if (pattern) {
ret = dbp->cursor(dbp, txn, &dbc, 0);
if (ret != 0) {
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"db cursor");
goto out;
}
memset(&key, 0, sizeof(key));
memset(&data, 0, sizeof(data));
ret = _GetGlobPrefix(pattern, &prefix);
if (ret) {
result = TCL_ERROR;
Tcl_SetResult(interp,
"Unable to allocate pattern space", TCL_STATIC);
goto out;
}
key.data = prefix;
key.size = strlen(prefix);
if (strlen(prefix) == 0)
flag = DB_FIRST;
else
flag = DB_SET_RANGE;
ret = dbc->c_get(dbc, &key, &data, flag);
while (ret == 0 &&
memcmp(key.data, prefix, strlen(prefix)) == 0) {
_debug_check();
ret = dbc->c_del(dbc, 0);
if (ret != 0) {
result = _ReturnSetup(interp, ret,
DB_RETOK_DBCDEL(ret), "db c_del");
break;
}
memset(&key, 0, sizeof(key));
memset(&data, 0, sizeof(data));
ret = dbc->c_get(dbc, &key, &data, DB_NEXT);
}
if (ret == DB_NOTFOUND)
ret = 0;
__os_free(dbp->dbenv, prefix);
dbc->c_close(dbc);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db del");
}
out:
return (result);
}
static int
tcl_DbCursor(interp, objc, objv, dbp, dbcp)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
DB *dbp;
DBC **dbcp;
{
static const char *dbcuropts[] = {
#if CONFIG_TEST
"-dirty",
"-update",
#endif
"-txn",
NULL
};
enum dbcuropts {
#if CONFIG_TEST
DBCUR_DIRTY,
DBCUR_UPDATE,
#endif
DBCUR_TXN
};
DB_TXN *txn;
u_int32_t flag;
int i, optindex, result, ret;
char *arg, msg[MSG_SIZE];
result = TCL_OK;
flag = 0;
txn = NULL;
i = 2;
while (i < objc) {
if (Tcl_GetIndexFromObj(interp, objv[i], dbcuropts, "option",
TCL_EXACT, &optindex) != TCL_OK) {
result = IS_HELP(objv[i]);
goto out;
}
i++;
switch ((enum dbcuropts)optindex) {
#if CONFIG_TEST
case DBCUR_DIRTY:
flag |= DB_DIRTY_READ;
break;
case DBCUR_UPDATE:
flag |= DB_WRITECURSOR;
break;
#endif
case DBCUR_TXN:
if (i == objc) {
Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
result = TCL_ERROR;
break;
}
arg = Tcl_GetStringFromObj(objv[i++], NULL);
txn = NAME_TO_TXN(arg);
if (txn == NULL) {
snprintf(msg, MSG_SIZE,
"Cursor: Invalid txn: %s\n", arg);
Tcl_SetResult(interp, msg, TCL_VOLATILE);
result = TCL_ERROR;
}
break;
}
if (result != TCL_OK)
break;
}
if (result != TCL_OK)
goto out;
_debug_check();
ret = dbp->cursor(dbp, txn, dbcp, flag);
if (ret != 0)
result = _ErrorSetup(interp, ret, "db cursor");
out:
return (result);
}
static int
tcl_DbAssociate(interp, objc, objv, dbp)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
DB *dbp;
{
static const char *dbaopts[] = {
"-auto_commit",
"-create",
"-txn",
NULL
};
enum dbaopts {
DBA_AUTO_COMMIT,
DBA_CREATE,
DBA_TXN
};
DB *sdbp;
DB_TXN *txn;
DBTCL_INFO *sdbip;
int i, optindex, result, ret;
char *arg, msg[MSG_SIZE];
u_int32_t flag;
txn = NULL;
result = TCL_OK;
flag = 0;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 2, objv, "[callback] secondary");
return (TCL_ERROR);
}
i = 2;
while (i < objc) {
if (Tcl_GetIndexFromObj(interp, objv[i], dbaopts, "option",
TCL_EXACT, &optindex) != TCL_OK) {
result = IS_HELP(objv[i]);
if (result == TCL_OK)
return (result);
result = TCL_OK;
Tcl_ResetResult(interp);
break;
}
i++;
switch ((enum dbaopts)optindex) {
case DBA_AUTO_COMMIT:
flag |= DB_AUTO_COMMIT;
break;
case DBA_CREATE:
flag |= DB_CREATE;
break;
case DBA_TXN:
if (i > (objc - 1)) {
Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
result = TCL_ERROR;
break;
}
arg = Tcl_GetStringFromObj(objv[i++], NULL);
txn = NAME_TO_TXN(arg);
if (txn == NULL) {
snprintf(msg, MSG_SIZE,
"Associate: Invalid txn: %s\n", arg);
Tcl_SetResult(interp, msg, TCL_VOLATILE);
result = TCL_ERROR;
}
break;
}
}
if (result != TCL_OK)
return (result);
arg = Tcl_GetStringFromObj(objv[objc - 1], NULL);
sdbp = NAME_TO_DB(arg);
if (sdbp == NULL) {
snprintf(msg, MSG_SIZE,
"Associate: Invalid database handle: %s\n", arg);
Tcl_SetResult(interp, msg, TCL_VOLATILE);
return (TCL_ERROR);
}
sdbip = (DBTCL_INFO *)sdbp->api_internal;
if (i != objc - 1) {
sdbip->i_second_call = objv[objc - 2];
Tcl_IncrRefCount(sdbip->i_second_call);
_debug_check();
ret = dbp->associate(dbp, txn, sdbp, tcl_second_call, flag);
} else {
sdbip->i_second_call = NULL;
ret = dbp->associate(dbp, txn, sdbp, NULL, flag);
}
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "associate");
return (result);
}
static int
tcl_second_call(dbp, pkey, data, skey)
DB *dbp;
const DBT *pkey, *data;
DBT *skey;
{
DBTCL_INFO *ip;
Tcl_Interp *interp;
Tcl_Obj *pobj, *dobj, *objv[3];
int len, result, ret;
void *retbuf, *databuf;
ip = (DBTCL_INFO *)dbp->api_internal;
interp = ip->i_interp;
objv[0] = ip->i_second_call;
pobj = Tcl_NewByteArrayObj(pkey->data, pkey->size);
Tcl_IncrRefCount(pobj);
dobj = Tcl_NewByteArrayObj(data->data, data->size);
Tcl_IncrRefCount(dobj);
objv[1] = pobj;
objv[2] = dobj;
result = Tcl_EvalObjv(interp, 3, objv, 0);
Tcl_DecrRefCount(pobj);
Tcl_DecrRefCount(dobj);
if (result != TCL_OK) {
__db_err(dbp->dbenv,
"Tcl callback function failed with code %d", result);
return (EINVAL);
}
retbuf =
Tcl_GetByteArrayFromObj(Tcl_GetObjResult(interp), &len);
if ((ret = __os_umalloc(dbp->dbenv, len, &databuf)) != 0)
return (ret);
memcpy(databuf, retbuf, len);
skey->data = databuf;
skey->size = len;
F_SET(skey, DB_DBT_APPMALLOC);
return (0);
}
static int
tcl_DbJoin(interp, objc, objv, dbp, dbcp)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
DB *dbp;
DBC **dbcp;
{
static const char *dbjopts[] = {
"-nosort",
NULL
};
enum dbjopts {
DBJ_NOSORT
};
DBC **listp;
u_int32_t flag;
int adj, i, j, optindex, size, result, ret;
char *arg, msg[MSG_SIZE];
result = TCL_OK;
flag = 0;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv, "curs1 curs2 ...");
return (TCL_ERROR);
}
i = 2;
adj = i;
while (i < objc) {
if (Tcl_GetIndexFromObj(interp, objv[i], dbjopts, "option",
TCL_EXACT, &optindex) != TCL_OK) {
result = IS_HELP(objv[i]);
if (result == TCL_OK)
return (result);
result = TCL_OK;
Tcl_ResetResult(interp);
break;
}
i++;
switch ((enum dbjopts)optindex) {
case DBJ_NOSORT:
flag |= DB_JOIN_NOSORT;
adj++;
break;
}
}
if (result != TCL_OK)
return (result);
size = sizeof(DBC *) * ((objc - adj) + 1);
ret = __os_malloc(dbp->dbenv, size, &listp);
if (ret != 0) {
Tcl_SetResult(interp, db_strerror(ret), TCL_STATIC);
return (TCL_ERROR);
}
memset(listp, 0, size);
for (j = 0, i = adj; i < objc; i++, j++) {
arg = Tcl_GetStringFromObj(objv[i], NULL);
listp[j] = NAME_TO_DBC(arg);
if (listp[j] == NULL) {
snprintf(msg, MSG_SIZE,
"Join: Invalid cursor: %s\n", arg);
Tcl_SetResult(interp, msg, TCL_VOLATILE);
result = TCL_ERROR;
goto out;
}
}
listp[j] = NULL;
_debug_check();
ret = dbp->join(dbp, listp, dbcp, flag);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db join");
out:
__os_free(dbp->dbenv, listp);
return (result);
}
static int
tcl_DbGetjoin(interp, objc, objv, dbp)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
DB *dbp;
{
static const char *dbgetjopts[] = {
#if CONFIG_TEST
"-nosort",
#endif
"-txn",
NULL
};
enum dbgetjopts {
#if CONFIG_TEST
DBGETJ_NOSORT,
#endif
DBGETJ_TXN
};
DB_TXN *txn;
DB *elemdbp;
DBC **listp;
DBC *dbc;
DBT key, data;
Tcl_Obj **elemv, *retlist;
void *ktmp;
u_int32_t flag;
int adj, elemc, freekey, i, j, optindex, result, ret, size;
char *arg, msg[MSG_SIZE];
result = TCL_OK;
flag = 0;
freekey = 0;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv, "{db1 key1} {db2 key2} ...");
return (TCL_ERROR);
}
txn = NULL;
i = 2;
adj = i;
while (i < objc) {
if (Tcl_GetIndexFromObj(interp, objv[i], dbgetjopts, "option",
TCL_EXACT, &optindex) != TCL_OK) {
result = IS_HELP(objv[i]);
if (result == TCL_OK)
return (result);
result = TCL_OK;
Tcl_ResetResult(interp);
break;
}
i++;
switch ((enum dbgetjopts)optindex) {
#if CONFIG_TEST
case DBGETJ_NOSORT:
flag |= DB_JOIN_NOSORT;
adj++;
break;
#endif
case DBGETJ_TXN:
if (i == objc) {
Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
result = TCL_ERROR;
break;
}
arg = Tcl_GetStringFromObj(objv[i++], NULL);
txn = NAME_TO_TXN(arg);
adj += 2;
if (txn == NULL) {
snprintf(msg, MSG_SIZE,
"GetJoin: Invalid txn: %s\n", arg);
Tcl_SetResult(interp, msg, TCL_VOLATILE);
result = TCL_ERROR;
}
break;
}
}
if (result != TCL_OK)
return (result);
size = sizeof(DBC *) * ((objc - adj) + 1);
ret = __os_malloc(NULL, size, &listp);
if (ret != 0) {
Tcl_SetResult(interp, db_strerror(ret), TCL_STATIC);
return (TCL_ERROR);
}
memset(listp, 0, size);
for (j = 0, i = adj; i < objc; i++, j++) {
result = Tcl_ListObjGetElements(interp, objv[i],
&elemc, &elemv);
if (elemc != 2) {
Tcl_SetResult(interp, "Lists must be {db key}",
TCL_STATIC);
result = TCL_ERROR;
goto out;
}
elemdbp = NAME_TO_DB(Tcl_GetStringFromObj(elemv[0], NULL));
if (elemdbp == NULL) {
snprintf(msg, MSG_SIZE, "Get_join: Invalid db: %s\n",
Tcl_GetStringFromObj(elemv[0], NULL));
Tcl_SetResult(interp, msg, TCL_VOLATILE);
result = TCL_ERROR;
goto out;
}
ret = elemdbp->cursor(elemdbp, txn, &listp[j], 0);
if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"db cursor")) == TCL_ERROR)
goto out;
memset(&key, 0, sizeof(key));
memset(&data, 0, sizeof(data));
ret = _CopyObjBytes(interp, elemv[elemc-1], &ktmp,
&key.size, &freekey);
if (ret != 0) {
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "db join");
goto out;
}
key.data = ktmp;
ret = (listp[j])->c_get(listp[j], &key, &data, DB_SET);
if ((result = _ReturnSetup(interp, ret, DB_RETOK_DBCGET(ret),
"db cget")) == TCL_ERROR)
goto out;
}
listp[j] = NULL;
_debug_check();
ret = dbp->join(dbp, listp, &dbc, flag);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db join");
if (result == TCL_ERROR)
goto out;
retlist = Tcl_NewListObj(0, NULL);
while (ret == 0 && result == TCL_OK) {
memset(&key, 0, sizeof(key));
memset(&data, 0, sizeof(data));
key.flags |= DB_DBT_MALLOC;
data.flags |= DB_DBT_MALLOC;
ret = dbc->c_get(dbc, &key, &data, 0);
if (ret == 0) {
result = _SetListElem(interp, retlist,
key.data, key.size,
data.data, data.size);
(void)__os_ufree(dbp->dbenv, key.data);
(void)__os_ufree(dbp->dbenv, data.data);
}
}
dbc->c_close(dbc);
if (result == TCL_OK)
Tcl_SetObjResult(interp, retlist);
out:
if (freekey)
(void)__os_free(dbp->dbenv, ktmp);
while (j) {
if (listp[j])
(listp[j])->c_close(listp[j]);
j--;
}
__os_free(dbp->dbenv, listp);
return (result);
}
static int
tcl_DbGetFlags(interp, objc, objv, dbp)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
DB *dbp;
{
int i, ret, result;
u_int32_t flags;
char buf[512];
Tcl_Obj *res;
static const struct {
u_int32_t flag;
char *arg;
} db_flags[] = {
{ DB_CHKSUM, "-chksum" },
{ DB_DUP, "-dup" },
{ DB_DUPSORT, "-dupsort" },
{ DB_ENCRYPT, "-encrypt" },
{ DB_TXN_NOT_DURABLE, "-notdurable" },
{ DB_RECNUM, "-recnum" },
{ DB_RENUMBER, "-renumber" },
{ DB_REVSPLITOFF, "-revsplitoff" },
{ DB_SNAPSHOT, "-snapshot" },
{ 0, NULL }
};
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return (TCL_ERROR);
}
ret = dbp->get_flags(dbp, &flags);
if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"db get_flags")) == TCL_OK) {
buf[0] = '\0';
for (i = 0; db_flags[i].flag != 0; i++)
if (LF_ISSET(db_flags[i].flag)) {
if (strlen(buf) > 0)
strncat(buf, " ", sizeof(buf));
strncat(buf, db_flags[i].arg, sizeof(buf));
}
res = Tcl_NewStringObj(buf, strlen(buf));
Tcl_SetObjResult(interp, res);
}
return (result);
}
static int
tcl_DbGetOpenFlags(interp, objc, objv, dbp)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
DB *dbp;
{
int i, ret, result;
u_int32_t flags;
char buf[512];
Tcl_Obj *res;
static const struct {
u_int32_t flag;
char *arg;
} open_flags[] = {
{ DB_AUTO_COMMIT, "-auto_commit" },
{ DB_CREATE, "-create" },
{ DB_DIRTY_READ, "-dirty" },
{ DB_EXCL, "-excl" },
{ DB_NOMMAP, "-nommap" },
{ DB_RDONLY, "-rdonly" },
{ DB_THREAD, "-thread" },
{ DB_TRUNCATE, "-truncate" },
{ 0, NULL }
};
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return (TCL_ERROR);
}
ret = dbp->get_open_flags(dbp, &flags);
if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"db get_open_flags")) == TCL_OK) {
buf[0] = '\0';
for (i = 0; open_flags[i].flag != 0; i++)
if (LF_ISSET(open_flags[i].flag)) {
if (strlen(buf) > 0)
strncat(buf, " ", sizeof(buf));
strncat(buf, open_flags[i].arg, sizeof(buf));
}
res = Tcl_NewStringObj(buf, strlen(buf));
Tcl_SetObjResult(interp, res);
}
return (result);
}
static int
tcl_DbCount(interp, objc, objv, dbp)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
DB *dbp;
{
Tcl_Obj *res;
DBC *dbc;
DBT key, data;
void *ktmp;
db_recno_t count, recno;
int freekey, result, ret;
res = NULL;
count = 0;
freekey = ret = 0;
result = TCL_OK;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "key");
return (TCL_ERROR);
}
memset(&key, 0, sizeof(key));
memset(&data, 0, sizeof(data));
if (dbp->type == DB_RECNO || dbp->type == DB_QUEUE) {
result = _GetUInt32(interp, objv[2], &recno);
if (result == TCL_OK) {
key.data = &recno;
key.size = sizeof(db_recno_t);
} else
return (result);
} else {
ret = _CopyObjBytes(interp, objv[2], &ktmp,
&key.size, &freekey);
if (ret != 0) {
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "db count");
return (result);
}
key.data = ktmp;
}
_debug_check();
ret = dbp->cursor(dbp, NULL, &dbc, 0);
if (ret != 0) {
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"db cursor");
goto out;
}
ret = dbc->c_get(dbc, &key, &data, DB_SET);
if (ret == DB_KEYEMPTY || ret == DB_NOTFOUND)
count = 0;
else {
ret = dbc->c_count(dbc, &count, 0);
if (ret != 0) {
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
"db c count");
goto out;
}
}
res = Tcl_NewWideIntObj((Tcl_WideInt)count);
Tcl_SetObjResult(interp, res);
out:
if (freekey)
(void)__os_free(dbp->dbenv, ktmp);
(void)dbc->c_close(dbc);
return (result);
}
#if CONFIG_TEST
static int
tcl_DbKeyRange(interp, objc, objv, dbp)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
DB *dbp;
{
static const char *dbkeyropts[] = {
"-txn",
NULL
};
enum dbkeyropts {
DBKEYR_TXN
};
DB_TXN *txn;
DB_KEY_RANGE range;
DBT key;
DBTYPE type;
Tcl_Obj *myobjv[3], *retlist;
void *ktmp;
db_recno_t recno;
u_int32_t flag;
int freekey, i, myobjc, optindex, result, ret;
char *arg, msg[MSG_SIZE];
result = TCL_OK;
flag = 0;
freekey = 0;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv, "?-txn id? key");
return (TCL_ERROR);
}
txn = NULL;
i = 2;
while (i < objc) {
if (Tcl_GetIndexFromObj(interp, objv[i], dbkeyropts, "option",
TCL_EXACT, &optindex) != TCL_OK) {
result = IS_HELP(objv[i]);
if (result == TCL_OK)
return (result);
result = TCL_OK;
Tcl_ResetResult(interp);
break;
}
i++;
switch ((enum dbkeyropts)optindex) {
case DBKEYR_TXN:
if (i == objc) {
Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
result = TCL_ERROR;
break;
}
arg = Tcl_GetStringFromObj(objv[i++], NULL);
txn = NAME_TO_TXN(arg);
if (txn == NULL) {
snprintf(msg, MSG_SIZE,
"KeyRange: Invalid txn: %s\n", arg);
Tcl_SetResult(interp, msg, TCL_VOLATILE);
result = TCL_ERROR;
}
break;
}
}
if (result != TCL_OK)
return (result);
(void)dbp->get_type(dbp, &type);
ret = 0;
if (i != (objc - 1)) {
Tcl_WrongNumArgs(interp, 2, objv, "?args? key");
result = TCL_ERROR;
goto out;
}
memset(&key, 0, sizeof(key));
if (type == DB_RECNO || type == DB_QUEUE) {
result = _GetUInt32(interp, objv[i], &recno);
if (result == TCL_OK) {
key.data = &recno;
key.size = sizeof(db_recno_t);
} else
return (result);
} else {
ret = _CopyObjBytes(interp, objv[i++], &ktmp,
&key.size, &freekey);
if (ret != 0) {
result = _ReturnSetup(interp, ret,
DB_RETOK_STD(ret), "db keyrange");
return (result);
}
key.data = ktmp;
}
_debug_check();
ret = dbp->key_range(dbp, txn, &key, &range, flag);
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db keyrange");
if (result == TCL_ERROR)
goto out;
myobjc = 3;
myobjv[0] = Tcl_NewDoubleObj(range.less);
myobjv[1] = Tcl_NewDoubleObj(range.equal);
myobjv[2] = Tcl_NewDoubleObj(range.greater);
retlist = Tcl_NewListObj(myobjc, myobjv);
if (result == TCL_OK)
Tcl_SetObjResult(interp, retlist);
out:
if (freekey)
(void)__os_free(dbp->dbenv, ktmp);
return (result);
}
#endif
static int
tcl_DbTruncate(interp, objc, objv, dbp)
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
DB *dbp;
{
static const char *dbcuropts[] = {
"-auto_commit",
"-txn",
NULL
};
enum dbcuropts {
DBTRUNC_AUTO_COMMIT,
DBTRUNC_TXN
};
DB_TXN *txn;
Tcl_Obj *res;
u_int32_t count, flag;
int i, optindex, result, ret;
char *arg, msg[MSG_SIZE];
txn = NULL;
flag = 0;
result = TCL_OK;
i = 2;
while (i < objc) {
if (Tcl_GetIndexFromObj(interp, objv[i], dbcuropts, "option",
TCL_EXACT, &optindex) != TCL_OK) {
result = IS_HELP(objv[i]);
goto out;
}
i++;
switch ((enum dbcuropts)optindex) {
case DBTRUNC_AUTO_COMMIT:
flag |= DB_AUTO_COMMIT;
break;
case DBTRUNC_TXN:
if (i == objc) {
Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
result = TCL_ERROR;
break;
}
arg = Tcl_GetStringFromObj(objv[i++], NULL);
txn = NAME_TO_TXN(arg);
if (txn == NULL) {
snprintf(msg, MSG_SIZE,
"Truncate: Invalid txn: %s\n", arg);
Tcl_SetResult(interp, msg, TCL_VOLATILE);
result = TCL_ERROR;
}
break;
}
if (result != TCL_OK)
break;
}
if (result != TCL_OK)
goto out;
_debug_check();
ret = dbp->truncate(dbp, txn, &count, flag);
if (ret != 0)
result = _ErrorSetup(interp, ret, "db truncate");
else {
res = Tcl_NewWideIntObj((Tcl_WideInt)count);
Tcl_SetObjResult(interp, res);
}
out:
return (result);
}