/*- * See the file LICENSE for redistribution information. * * Copyright (c) 1999, 2000 * Sleepycat Software. All rights reserved. */ #include "db_config.h" #ifndef lint static const char revid[] = "$Id: tcl_db.c,v 11.55 2000/11/28 20:12:31 bostic Exp $"; #endif /* not lint */ #ifndef NO_SYSTEM_INCLUDES #include #include #include #include #endif #include "db_int.h" #include "tcl_db.h" /* * Prototypes for procedures defined later in this file: */ 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 *)); static int tcl_DbKeyRange __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); 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_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_DbGetjoin __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); static int tcl_DbCount __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *)); /* * * PUBLIC: int db_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*)); * * db_Cmd -- * Implements the "db" widget. */ int db_Cmd(clientData, interp, objc, objv) ClientData clientData; /* DB handle */ Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ { static char *dbcmds[] = { "close", "count", "cursor", "del", "get", "get_join", "get_type", "is_byteswapped", "join", "keyrange", "put", "stat", "sync", #if CONFIG_TEST "test", #endif NULL }; enum dbcmds { DBCLOSE, DBCOUNT, DBCURSOR, DBDELETE, DBGET, DBGETJOIN, DBGETTYPE, DBSWAPPED, DBJOIN, DBKEYRANGE, DBPUT, DBSTAT, DBSYNC #if CONFIG_TEST , DBTEST #endif }; DB *dbp; DBC *dbc; DBTCL_INFO *dbip; DBTCL_INFO *ip; Tcl_Obj *res; int cmdindex, result, ret; char newname[MSG_SIZE]; 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); } /* * Get the command name index from the object based on the dbcmds * defined above. */ if (Tcl_GetIndexFromObj(interp, objv[1], dbcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK) return (IS_HELP(objv[1])); res = NULL; switch ((enum dbcmds)cmdindex) { 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); break; case DBKEYRANGE: result = tcl_DbKeyRange(interp, objc, objv, dbp); break; case DBPUT: result = tcl_DbPut(interp, objc, objv, dbp); break; case DBCOUNT: result = tcl_DbCount(interp, objc, objv, dbp); break; case DBSWAPPED: /* * No args for this. Error if there are some. */ if (objc > 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return (TCL_ERROR); } _debug_check(); ret = dbp->get_byteswapped(dbp); res = Tcl_NewIntObj(ret); break; case DBGETTYPE: /* * No args for this. Error if there are some. */ if (objc > 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return (TCL_ERROR); } _debug_check(); ret = dbp->get_type(dbp); if (ret == DB_BTREE) res = Tcl_NewStringObj("btree", strlen("btree")); else if (ret == DB_HASH) res = Tcl_NewStringObj("hash", strlen("hash")); else if (ret == DB_RECNO) res = Tcl_NewStringObj("recno", strlen("recno")); else if (ret == 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: /* * No args for this. Error if there are some. */ 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 DBGETJOIN: result = tcl_DbGetjoin(interp, objc, objv, dbp); break; #if CONFIG_TEST case DBTEST: result = tcl_EnvTest(interp, objc, objv, dbp->dbenv); break; #endif } /* * Only set result if we have a res. Otherwise, lower * functions have already done so. */ if (result == TCL_OK && res) Tcl_SetObjResult(interp, res); return (result); } /* * tcl_db_stat -- */ static int tcl_DbStat(interp, objc, objv, dbp) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ DB *dbp; /* Database pointer */ { DB_BTREE_STAT *bsp; DB_HASH_STAT *hsp; DB_QUEUE_STAT *qsp; void *sp; Tcl_Obj *res; DBTYPE type; u_int32_t flag; int result, ret; char *arg; result = TCL_OK; flag = 0; if (objc > 3) { Tcl_WrongNumArgs(interp, 2, objv, "?-recordcount?"); return (TCL_ERROR); } if (objc == 3) { arg = Tcl_GetStringFromObj(objv[2], NULL); if (strcmp(arg, "-recordcount") == 0) flag = DB_RECORDCOUNT; else if (strcmp(arg, "-cachedcounts") == 0) flag = DB_CACHED_COUNTS; else { Tcl_SetResult(interp, "db stat: unknown arg", TCL_STATIC); return (TCL_ERROR); } } _debug_check(); ret = dbp->stat(dbp, &sp, NULL, flag); result = _ReturnSetup(interp, ret, "db stat"); if (result == TCL_ERROR) return (result); type = dbp->get_type(dbp); /* * Have our stats, now construct the name value * list pairs and free up the memory. */ res = Tcl_NewObj(); /* * MAKE_STAT_LIST assumes 'res' and 'error' label. */ 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("Estim. number of elements", hsp->hash_nelem); MAKE_STAT_LIST("Fill factor", hsp->hash_ffactor); MAKE_STAT_LIST("Buckets", hsp->hash_buckets); 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("Number of records", qsp->qs_ndata); MAKE_STAT_LIST("Number of pages", qsp->qs_pages); MAKE_STAT_LIST("Bytes free", qsp->qs_pgfree); 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); } else { /* BTREE and RECNO are same stats */ bsp = (DB_BTREE_STAT *)sp; MAKE_STAT_LIST("Number of keys", bsp->bt_nkeys); MAKE_STAT_LIST("Number of records", bsp->bt_ndata); if (flag != DB_RECORDCOUNT) { MAKE_STAT_LIST("Magic", bsp->bt_magic); MAKE_STAT_LIST("Version", bsp->bt_version); MAKE_STAT_LIST("Flags", bsp->bt_metaflags); 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); 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); } } Tcl_SetObjResult(interp, res); error: __os_free(sp, 0); return (result); } /* * tcl_db_close -- */ static int tcl_DbClose(interp, objc, objv, dbp, dbip) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ DB *dbp; /* Database pointer */ DBTCL_INFO *dbip; /* Info pointer */ { DBTCL_INFO *p, *nextp; u_int32_t flag; int result, ret; char *arg; result = TCL_OK; flag = 0; if (objc > 3) { Tcl_WrongNumArgs(interp, 2, objv, "?-nosync?"); return (TCL_ERROR); } if (objc == 3) { arg = Tcl_GetStringFromObj(objv[2], NULL); if (strcmp(arg, "-nosync") == 0) flag = DB_NOSYNC; else { Tcl_SetResult(interp, "dbclose: unknown arg", TCL_STATIC); return (TCL_ERROR); } } /* * First we have to close any open cursors. Then we close * our db. */ for (p = LIST_FIRST(&__db_infohead); p != NULL; p = nextp) { nextp = LIST_NEXT(p, entries); /* * Check if this is a cursor info structure and if * it is, if it belongs to this DB. If so, remove * its commands and info structure. */ 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); _debug_check(); ret = (dbp)->close(dbp, flag); result = _ReturnSetup(interp, ret, "db close"); return (result); } /* * tcl_db_put -- */ static int tcl_DbPut(interp, objc, objv, dbp) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ DB *dbp; /* Database pointer */ { static char *dbputopts[] = { "-append", "-nodupdata", "-nooverwrite", "-partial", "-txn", NULL }; enum dbputopts { DBPUT_APPEND, DBGET_NODUPDATA, DBPUT_NOOVER, DBPUT_PART, DBPUT_TXN }; static char *dbputapp[] = { "-append", NULL }; enum dbputapp { DBPUT_APPEND0 }; DBT key, data; DBTYPE type; DB_TXN *txn; Tcl_Obj **elemv, *res; db_recno_t recno; u_int32_t flag; int elemc, end, i, itmp, 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); } memset(&key, 0, sizeof(key)); memset(&data, 0, sizeof(data)); /* * If it is a QUEUE or RECNO database, the key is a record number * and must be setup up to contain a db_recno_t. Otherwise the * key is a "string". */ type = dbp->get_type(dbp); /* * We need to determine where the end of required args are. If we * are using a QUEUE/RECNO db and -append, then there is just one * req arg (data). Otherwise there are two (key data). * * We preparse the list to determine this since we need to know * to properly check # of args for other options below. */ 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); /* * Get the command name index from the object based on the options * defined above. */ i = 2; 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) { 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_APPEND: FLAG_CHECK(flag); flag = DB_APPEND; break; case DBGET_NODUPDATA: FLAG_CHECK(flag); flag = DB_NODUPDATA; 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; } /* * Get sublist as {offset length} */ 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 = Tcl_GetIntFromObj(interp, elemv[0], &itmp); data.doff = itmp; if (result != TCL_OK) break; result = Tcl_GetIntFromObj(interp, elemv[1], &itmp); data.dlen = itmp; /* * NOTE: We don't check result here because all we'd * do is break anyway, and we are doing that. If you * add code here, you WILL need to add the check * for result. (See the check for save.doff, a few * lines above and copy that.) */ break; } if (result != TCL_OK) break; } if (result == TCL_ERROR) return (result); /* * If we are a recno db and we are NOT using append, then the 2nd * last arg is the key. */ 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 = Tcl_GetIntFromObj(interp, objv[objc-2], &itmp); recno = itmp; if (result != TCL_OK) return (result); } } else { key.data = Tcl_GetByteArrayFromObj(objv[objc-2], &itmp); key.size = itmp; } /* * XXX * Tcl 8.1 Tcl_GetByteArrayFromObj/Tcl_GetIntFromObj bug. * * This line (and the line for key.data above) were moved from * the beginning of the function to here. * * There is a bug in Tcl 8.1 and byte arrays in that if it happens * to use an object as both a byte array and something else like * an int, and you've done a Tcl_GetByteArrayFromObj, then you * do a Tcl_GetIntFromObj, your memory is deleted. * * Workaround is to make sure all Tcl_GetByteArrayFromObj calls * are done last. */ data.data = Tcl_GetByteArrayFromObj(objv[objc-1], &itmp); data.size = itmp; _debug_check(); ret = dbp->put(dbp, txn, &key, &data, flag); result = _ReturnSetup(interp, ret, "db put"); if (ret == 0 && (type == DB_RECNO || type == DB_QUEUE) && flag == DB_APPEND) { res = Tcl_NewIntObj(recno); Tcl_SetObjResult(interp, res); } return (result); } /* * tcl_db_get -- */ static int tcl_DbGet(interp, objc, objv, dbp) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ DB *dbp; /* Database pointer */ { static char *dbgetopts[] = { "-consume", "-consume_wait", "-get_both", "-glob", "-partial", "-recno", "-rmw", "-txn", NULL }; enum dbgetopts { DBGET_CONSUME, DBGET_CONSUME_WAIT, DBGET_BOTH, DBGET_GLOB, DBGET_PART, DBGET_RECNO, DBGET_RMW, DBGET_TXN }; DBC *dbc; DBT key, data, save; DBTYPE type; DB_TXN *txn; Tcl_Obj **elemv, *retlist; db_recno_t recno; u_int32_t flag, cflag, isdup, rmw; int elemc, end, i, itmp, optindex, result, ret, useglob, userecno; char *arg, *pattern, *prefix, msg[MSG_SIZE]; result = TCL_OK; cflag = flag = 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)); /* * Get the command name index from the object based on the options * defined above. */ i = 2; type = dbp->get_type(dbp); end = objc; while (i < end) { if (Tcl_GetIndexFromObj(interp, objv[i], dbgetopts, "option", TCL_EXACT, &optindex) != TCL_OK) { if (IS_HELP(objv[i]) == TCL_OK) return (TCL_OK); Tcl_ResetResult(interp); break; } i++; switch ((enum dbgetopts)optindex) { case DBGET_BOTH: /* * Change 'end' and make sure we aren't already past * the new end. */ 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 - 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, "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; } 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; } /* * Get sublist as {offset length} */ 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 = Tcl_GetIntFromObj(interp, elemv[0], &itmp); save.doff = itmp; if (result != TCL_OK) break; result = Tcl_GetIntFromObj(interp, elemv[1], &itmp); save.dlen = itmp; /* * NOTE: We don't check result here because all we'd * do is break anyway, and we are doing that. If you * add code here, you WILL need to add the check * for result. (See the check for save.doff, a few * lines above and copy that.) */ break; } if (result != TCL_OK) break; } if (result != TCL_OK) goto out; if (type == DB_RECNO || type == DB_QUEUE) userecno = 1; /* * Check for illegal combos of options. */ 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); /* * This is the list we return */ retlist = Tcl_NewListObj(0, NULL); save.flags |= DB_DBT_MALLOC; /* * isdup is used to know if we support duplicates. If not, we * can just do a db->get call and avoid using cursors. * XXX * When there is a db->get_flags method, it should be used. * isdup = dbp->get_flags(dbp) & DB_DUP; * For now we illegally peek. * XXX */ isdup = dbp->flags & DB_AM_DUP; /* * If the database doesn't support duplicates or we're performing * ops that don't require returning multiple items, use DB->get * instead of a cursor operation. */ if (pattern == NULL && (isdup == 0 || flag == DB_SET_RECNO || flag == DB_GET_BOTH || flag == DB_CONSUME || flag == DB_CONSUME_WAIT)) { if (flag == DB_GET_BOTH) { if (userecno) { result = Tcl_GetIntFromObj(interp, objv[(objc - 2)], &itmp); recno = itmp; if (result == TCL_OK) { key.data = &recno; key.size = sizeof(db_recno_t); } else return (result); } else { key.data = Tcl_GetByteArrayFromObj(objv[objc-2], &itmp); key.size = itmp; } /* * Already checked args above. Fill in key and save. * Save is used in the dbp->get call below to fill in * data. */ save.data = Tcl_GetByteArrayFromObj(objv[objc-1], &itmp); save.size = itmp; } else if (flag != DB_CONSUME && flag != DB_CONSUME_WAIT) { if (userecno) { result = Tcl_GetIntFromObj( interp, objv[(objc - 1)], &itmp); recno = itmp; if (result == TCL_OK) { key.data = &recno; key.size = sizeof(db_recno_t); } else return (result); } else { key.data = Tcl_GetByteArrayFromObj(objv[objc-1], &itmp); key.size = itmp; } } memset(&data, 0, sizeof(data)); data = save; _debug_check(); ret = dbp->get(dbp, txn, &key, &data, flag | rmw); result = _ReturnSetup(interp, ret, "db get"); if (ret == 0) { /* * Success. Return a list of the form {name value} * If it was a recno in key.data, we need to convert * into a string/object representation of that recno. */ if (type == DB_RECNO || type == DB_QUEUE) result = _SetListRecnoElem(interp, retlist, *(db_recno_t *)key.data, data.data, data.size); else result = _SetListElem(interp, retlist, key.data, key.size, data.data, data.size); /* * Free space from DB_DBT_MALLOC */ __os_free(data.data, data.size); } if (result == TCL_OK) Tcl_SetObjResult(interp, retlist); goto out; } if (userecno) { result = Tcl_GetIntFromObj(interp, objv[(objc - 1)], &itmp); recno = itmp; if (result == TCL_OK) { key.data = &recno; key.size = sizeof(db_recno_t); } else return (result); } else { key.data = Tcl_GetByteArrayFromObj(objv[objc-1], &itmp); key.size = itmp; } ret = dbp->cursor(dbp, txn, &dbc, 0); result = _ReturnSetup(interp, ret, "db cursor"); if (result == TCL_ERROR) goto out; /* * At this point, we have a cursor, if we have a pattern, * we go to the nearest one and step forward until we don't * have any more that match the pattern prefix. If we have * an exact key, we go to that key position, and step through * all the duplicates. In either case we build up a list of * the form {{key data} {key data}...} along the way. */ memset(&data, 0, sizeof(data)); /* * Restore any "partial" info we have saved. */ data = save; if (pattern) { /* * Note, prefix is returned in new space. Must free it. */ 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 they give us an empty pattern string * (i.e. -glob *), go through entire DB. */ if (strlen(prefix) == 0) cflag = DB_FIRST; else cflag = DB_SET_RANGE; } else cflag = DB_SET; _debug_check(); ret = dbc->c_get(dbc, &key, &data, cflag | rmw); result = _ReturnSetup(interp, ret, "db get (cursor)"); if (result == TCL_ERROR) goto out1; if (pattern) cflag = DB_NEXT; else cflag = DB_NEXT_DUP; while (ret == 0 && result == TCL_OK) { /* * Build up our {name value} sublist */ result = _SetListElem(interp, retlist, key.data, key.size, data.data, data.size); /* * Free space from DB_DBT_MALLOC */ __os_free(data.data, data.size); if (result != TCL_OK) break; /* * Append {name value} to return list */ memset(&key, 0, sizeof(key)); memset(&data, 0, sizeof(data)); /* * Restore any "partial" info we have saved. */ data = save; ret = dbc->c_get(dbc, &key, &data, cflag | rmw); if (ret == 0 && pattern && memcmp(key.data, prefix, strlen(prefix)) != 0) { /* * Free space from DB_DBT_MALLOC */ __os_free(data.data, data.size); break; } } dbc->c_close(dbc); out1: if (result == TCL_OK) Tcl_SetObjResult(interp, retlist); out: /* * _GetGlobPrefix(), the function which allocates prefix, works * by copying and condensing another string. Thus prefix may * have multiple nuls at the end, so we free using __os_free(). */ if (prefix != NULL) __os_free(prefix,0); return (result); } /* * tcl_db_delete -- */ static int tcl_DbDelete(interp, objc, objv, dbp) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ DB *dbp; /* Database pointer */ { static char *dbdelopts[] = { "-glob", "-txn", NULL }; enum dbdelopts { DBDEL_GLOB, DBDEL_TXN }; DBC *dbc; DBT key, data; DBTYPE type; DB_TXN *txn; db_recno_t recno; int i, itmp, optindex, result, ret; u_int32_t flag; char *arg, *pattern, *prefix, msg[MSG_SIZE]; result = TCL_OK; 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)); /* * The first arg must be -txn, -glob or a list of keys. */ i = 2; while (i < objc) { if (Tcl_GetIndexFromObj(interp, objv[i], dbdelopts, "option", TCL_EXACT, &optindex) != TCL_OK) { /* * If we don't have a -glob or -txn, then the * remaining args must be exact keys. * Reset the result so we don't get * an errant error message if there is another error. */ 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) { /* * Someone could conceivably have a key of * the same name. So just break and use it. */ 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_GLOB: /* * Get the pattern. Get the prefix and use cursors to * get all the data items. */ if (i == objc) { /* * Someone could conceivably have a key of * the same name. So just break and use it. */ i--; break; } pattern = Tcl_GetStringFromObj(objv[i++], NULL); break; } if (result != TCL_OK) break; } if (result != TCL_OK) goto out; /* * If we have a pattern AND more keys to process, then there * is an error. Either we have some number of exact keys, * or we have a pattern. */ if (pattern != NULL && i != objc) { Tcl_WrongNumArgs(interp, 2, objv, "?args? -glob pattern | key"); result = TCL_ERROR; goto out; } /* * XXX * For consistency with get, we have decided for the moment, to * allow -glob, or one key, not many. The code was originally * written to take many keys and we'll leave it that way, because * tcl_DbGet may one day accept many disjoint keys to get, rather * than one, and at that time we'd make delete be consistent. In * any case, the code is already here and there is no need to remove, * just check that we only have one arg left. */ if (pattern == NULL && i != (objc - 1)) { Tcl_WrongNumArgs(interp, 2, objv, "?args? -glob pattern | key"); result = TCL_ERROR; goto out; } /* * If we have remaining args, they are all exact keys. Call * DB->del on each of those keys. * * If it is a RECNO database, the key is a record number and must be * setup up to contain a db_recno_t. Otherwise the key is a "string". */ type = dbp->get_type(dbp); ret = 0; while (i < objc && ret == 0) { memset(&key, 0, sizeof(key)); if (type == DB_RECNO || type == DB_QUEUE) { result = Tcl_GetIntFromObj(interp, objv[i++], &itmp); recno = itmp; if (result == TCL_OK) { key.data = &recno; key.size = sizeof(db_recno_t); } else return (result); } else { key.data = Tcl_GetByteArrayFromObj(objv[i++], &itmp); key.size = itmp; } _debug_check(); ret = dbp->del(dbp, txn, &key, 0); /* * If we have any error, set up return result and stop * processing keys. */ if (ret != 0) break; } result = _ReturnSetup(interp, ret, "db del"); /* * At this point we've either finished or, if we have a pattern, * we go to the nearest one and step forward until we don't * have any more that match the pattern prefix. */ if (pattern) { ret = dbp->cursor(dbp, txn, &dbc, 0); if (ret != 0) { result = _ReturnSetup(interp, ret, "db cursor"); goto out; } /* * Note, prefix is returned in new space. Must free it. */ 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) { /* * Each time through here the cursor is pointing * at the current valid item. Delete it and * move ahead. */ _debug_check(); ret = dbc->c_del(dbc, 0); if (ret != 0) { result = _ReturnSetup(interp, ret, "db c_del"); break; } /* * Deleted the current, now move to the next item * in the list, check if it matches the prefix pattern. */ 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; /* * _GetGlobPrefix(), the function which allocates prefix, works * by copying and condensing another string. Thus prefix may * have multiple nuls at the end, so we free using __os_free(). */ __os_free(prefix,0); dbc->c_close(dbc); result = _ReturnSetup(interp, ret, "db del"); } out: return (result); } /* * tcl_db_cursor -- */ static int tcl_DbCursor(interp, objc, objv, dbp, dbcp) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ DB *dbp; /* Database pointer */ DBC **dbcp; /* Return cursor pointer */ { static char *dbcuropts[] = { "-txn", "-update", NULL }; enum dbcuropts { DBCUR_TXN, DBCUR_UPDATE }; DB_TXN *txn; u_int32_t flag; int i, optindex, result, ret; char *arg, msg[MSG_SIZE]; result = TCL_OK; flag = 0; txn = NULL; /* * If the user asks for -glob or -recno, it MUST be the second * last arg given. If it isn't given, then we must check if * they gave us a correct key. */ 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 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; case DBCUR_UPDATE: flag = DB_WRITECURSOR; 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); } /* * tcl_db_join -- */ static int tcl_DbJoin(interp, objc, objv, dbp, dbcp) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ DB *dbp; /* Database pointer */ DBC **dbcp; /* Cursor pointer */ { static 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); /* * Allocate one more for NULL ptr at end of list. */ size = sizeof(DBC *) * ((objc - adj) + 1); ret = __os_malloc(dbp->dbenv, size, NULL, &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 join"); out: __os_free(listp, size); return (result); } /* * tcl_db_getjoin -- */ static int tcl_DbGetjoin(interp, objc, objv, dbp) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ DB *dbp; /* Database pointer */ { static char *dbgetjopts[] = { "-nosort", "-txn", NULL }; enum dbgetjopts { DBGETJ_NOSORT, DBGETJ_TXN }; DB_TXN *txn; DB *elemdbp; DBC **listp; DBC *dbc; DBT key, data; Tcl_Obj **elemv, *retlist; u_int32_t flag; int adj, elemc, i, itmp, j, optindex, result, ret, size; char *arg, msg[MSG_SIZE]; result = TCL_OK; flag = 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) { case DBGETJ_NOSORT: flag |= DB_JOIN_NOSORT; adj++; break; 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, NULL, &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++) { /* * Get each sublist as {db key} */ 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; } /* * Get a pointer to that open db. Then, open a cursor in * that db, and go to the "key" place. */ 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 cursor")) == TCL_ERROR) goto out; memset(&key, 0, sizeof(key)); memset(&data, 0, sizeof(data)); key.data = Tcl_GetByteArrayFromObj(elemv[elemc-1], &itmp); key.size = itmp; ret = (listp[j])->c_get(listp[j], &key, &data, DB_SET); if ((result = _ReturnSetup(interp, ret, "db cget")) == TCL_ERROR) goto out; } listp[j] = NULL; _debug_check(); ret = dbp->join(dbp, listp, &dbc, flag); result = _ReturnSetup(interp, 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); /* * Build up our {name value} sublist */ if (ret == 0) { result = _SetListElem(interp, retlist, key.data, key.size, data.data, data.size); __os_free(key.data, key.size); __os_free(data.data, data.size); } } dbc->c_close(dbc); if (result == TCL_OK) Tcl_SetObjResult(interp, retlist); out: while (j) { if (listp[j]) (listp[j])->c_close(listp[j]); j--; } __os_free(listp, size); return (result); } /* * tcl_DbCount -- */ static int tcl_DbCount(interp, objc, objv, dbp) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ DB *dbp; /* Database pointer */ { Tcl_Obj *res; DBC *dbc; DBT key, data; db_recno_t count, recno; int itmp, len, result, ret; result = TCL_OK; count = 0; res = NULL; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "key"); return (TCL_ERROR); } memset(&key, 0, sizeof(key)); /* * Get the count for our key. * We do this by getting a cursor for this DB. Moving the cursor * to the set location, and getting a count on that cursor. */ ret = 0; memset(&key, 0, sizeof(key)); memset(&data, 0, sizeof(data)); /* * If it's a queue or recno database, we must make sure to * treat the key as a recno rather than as a byte string. */ if (dbp->type == DB_RECNO || dbp->type == DB_QUEUE) { result = Tcl_GetIntFromObj(interp, objv[2], &itmp); recno = itmp; if (result == TCL_OK) { key.data = &recno; key.size = sizeof(db_recno_t); } else return (result); } else { key.data = Tcl_GetByteArrayFromObj(objv[2], &len); key.size = len; } _debug_check(); ret = dbp->cursor(dbp, NULL, &dbc, 0); if (ret != 0) { result = _ReturnSetup(interp, ret, "db cursor"); goto out; } /* * Move our cursor to the key. */ ret = dbc->c_get(dbc, &key, &data, DB_SET); if (ret == DB_NOTFOUND) count = 0; else { ret = dbc->c_count(dbc, &count, 0); if (ret != 0) { result = _ReturnSetup(interp, ret, "db cursor"); goto out; } } res = Tcl_NewIntObj(count); Tcl_SetObjResult(interp, res); out: return (result); } /* * tcl_DbKeyRange -- */ static int tcl_DbKeyRange(interp, objc, objv, dbp) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ DB *dbp; /* Database pointer */ { static char *dbkeyropts[] = { "-txn", NULL }; enum dbkeyropts { DBKEYR_TXN }; DB_TXN *txn; DB_KEY_RANGE range; DBT key; DBTYPE type; Tcl_Obj *myobjv[3], *retlist; db_recno_t recno; u_int32_t flag; int i, itmp, myobjc, optindex, result, ret; char *arg, msg[MSG_SIZE]; result = TCL_OK; flag = 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); type = dbp->get_type(dbp); ret = 0; /* * Make sure we have a key. */ 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 = Tcl_GetIntFromObj(interp, objv[i], &itmp); recno = itmp; if (result == TCL_OK) { key.data = &recno; key.size = sizeof(db_recno_t); } else return (result); } else { key.data = Tcl_GetByteArrayFromObj(objv[i++], &itmp); key.size = itmp; } _debug_check(); ret = dbp->key_range(dbp, txn, &key, &range, flag); result = _ReturnSetup(interp, ret, "db join"); if (result == TCL_ERROR) goto out; /* * If we succeeded, set up return list. */ 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: return (result); }