Logo Search packages:      
Sourcecode: db3 version File versions  Download package

tcl_db_pkg.c

/*-
 * 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_pkg.c,v 11.76 2001/01/19 18:02:36 bostic Exp $";
#endif /* not lint */

#ifndef NO_SYSTEM_INCLUDES
#include <sys/types.h>

#include <stdlib.h>
#include <string.h>
#include <tcl.h>
#endif

#define     DB_DBM_HSEARCH 1

#include "db_int.h"
#include "tcl_db.h"

/*
 * Prototypes for procedures defined later in this file:
 */
static int  berkdb_Cmd __P((ClientData, Tcl_Interp *, int,
    Tcl_Obj * CONST*));
static int  bdb_EnvOpen __P((Tcl_Interp *, int, Tcl_Obj * CONST*,
    DBTCL_INFO *, DB_ENV **));
static int  bdb_DbOpen __P((Tcl_Interp *, int, Tcl_Obj * CONST*,
    DBTCL_INFO *, DB **));
static int  bdb_DbRemove __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
static int  bdb_DbRename __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
static int  bdb_DbUpgrade __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
static int  bdb_DbVerify __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
static int  bdb_Version __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
static int  bdb_Handles __P((Tcl_Interp *, int, Tcl_Obj * CONST*));

/*
 * Db_tcl_Init --
 *
 * This is a package initialization procedure, which is called by Tcl when
 * this package is to be added to an interpreter.  The name is based on the
 * name of the shared library, currently libdb_tcl-X.Y.so, which Tcl uses
 * to determine the name of this function.
 */
int
Db_tcl_Init(interp)
      Tcl_Interp *interp;           /* Interpreter in which the package is
                               * to be made available. */
{
      int code;

      code = Tcl_PkgProvide(interp, "Db_tcl", "1.0");
      if (code != TCL_OK)
            return (code);

      Tcl_CreateObjCommand(interp, "berkdb", (Tcl_ObjCmdProc *)berkdb_Cmd,
          (ClientData)0, NULL);
      /*
       * Create shared global debugging variables
       */
      Tcl_LinkVar(interp, "__debug_on", (char *)&__debug_on, TCL_LINK_INT);
      Tcl_LinkVar(interp, "__debug_print", (char *)&__debug_print,
          TCL_LINK_INT);
      Tcl_LinkVar(interp, "__debug_stop", (char *)&__debug_stop,
          TCL_LINK_INT);
      Tcl_LinkVar(interp, "__debug_test", (char *)&__debug_test,
          TCL_LINK_INT);
      LIST_INIT(&__db_infohead);
      return (TCL_OK);
}

/*
 * berkdb_cmd --
 *    Implements the "berkdb" command.
 *    This command supports three sub commands:
 *    berkdb version - Returns a list {major minor patch}
 *    berkdb env - Creates a new DB_ENV and returns a binding
 *      to a new command of the form dbenvX, where X is an
 *      integer starting at 0 (dbenv0, dbenv1, ...)
 *    berkdb open - Creates a new DB (optionally within
 *      the given environment.  Returns a binding to a new
 *      command of the form dbX, where X is an integer
 *      starting at 0 (db0, db1, ...)
 */
static int
berkdb_Cmd(notused, interp, objc, objv)
      ClientData notused;           /* Not used. */
      Tcl_Interp *interp;           /* Interpreter */
      int objc;               /* How many arguments? */
      Tcl_Obj *CONST objv[];        /* The argument objects */
{
      static char *berkdbcmds[] = {
            "dbremove",
            "dbrename",
            "dbverify",
            "env",
            "envremove",
            "handles",
            "open",
            "upgrade",
            "version",
            /* All below are compatibility functions */
            "hcreate",  "hsearch",  "hdestroy",
            "dbminit",  "fetch",    "store",
            "delete",   "firstkey", "nextkey",
            "ndbm_open",      "dbmclose",
            /* All below are convenience functions */
            "rand",           "random_int",     "srand",
            "debug_check",
            NULL
      };
      /*
       * All commands enums below ending in X are compatibility
       */
      enum berkdbcmds {
            BDB_DBREMOVE,
            BDB_DBRENAME,
            BDB_DBVERIFY,
            BDB_ENV,
            BDB_ENVREMOVE,
            BDB_HANDLES,
            BDB_OPEN,
            BDB_UPGRADE,
            BDB_VERSION,
            BDB_HCREATEX,     BDB_HSEARCHX,     BDB_HDESTROYX,
            BDB_DBMINITX,     BDB_FETCHX, BDB_STOREX,
            BDB_DELETEX,      BDB_FIRSTKEYX,    BDB_NEXTKEYX,
            BDB_NDBMOPENX,    BDB_DBMCLOSEX,
            BDB_RANDX,  BDB_RAND_INTX,    BDB_SRANDX,
            BDB_DBGCKX
      };
      static int env_id = 0;
      static int db_id = 0;
      static int ndbm_id = 0;

      DB *dbp;
      DBM *ndbmp;
      DBTCL_INFO *ip;
      DB_ENV *envp;
      Tcl_Obj *res;
      int cmdindex, result;
      char newname[MSG_SIZE];

      COMPQUIET(notused, NULL);

      Tcl_ResetResult(interp);
      memset(newname, 0, MSG_SIZE);
      result = TCL_OK;
      if (objc <= 1) {
            Tcl_WrongNumArgs(interp, 1, objv, "command cmdargs");
            return (TCL_ERROR);
      }

      /*
       * Get the command name index from the object based on the berkdbcmds
       * defined above.
       */
      if (Tcl_GetIndexFromObj(interp,
          objv[1], berkdbcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
            return (IS_HELP(objv[1]));
      res = NULL;
      switch ((enum berkdbcmds)cmdindex) {
      case BDB_VERSION:
            _debug_check();
            result = bdb_Version(interp, objc, objv);
            break;
      case BDB_HANDLES:
            result = bdb_Handles(interp, objc, objv);
            break;
      case BDB_ENV:
            snprintf(newname, sizeof(newname), "env%d", env_id);
            ip = _NewInfo(interp, NULL, newname, I_ENV);
            if (ip != NULL) {
                  result = bdb_EnvOpen(interp, objc, objv, ip, &envp);
                  if (result == TCL_OK && envp != NULL) {
                        env_id++;
                        Tcl_CreateObjCommand(interp, newname,
                            (Tcl_ObjCmdProc *)env_Cmd,
                            (ClientData)envp, NULL);
                        /* Use ip->i_name - newname is overwritten */
                        res =
                            Tcl_NewStringObj(newname, strlen(newname));
                        _SetInfoData(ip, envp);
                  } else
                        _DeleteInfo(ip);
            } else {
                  Tcl_SetResult(interp, "Could not set up info",
                      TCL_STATIC);
                  result = TCL_ERROR;
            }
            break;
      case BDB_DBREMOVE:
            result = bdb_DbRemove(interp, objc, objv);
            break;
      case BDB_DBRENAME:
            result = bdb_DbRename(interp, objc, objv);
            break;
      case BDB_UPGRADE:
            result = bdb_DbUpgrade(interp, objc, objv);
            break;
      case BDB_DBVERIFY:
            result = bdb_DbVerify(interp, objc, objv);
            break;
      case BDB_ENVREMOVE:
            result = tcl_EnvRemove(interp, objc, objv, NULL, NULL);
            break;
      case BDB_OPEN:
            snprintf(newname, sizeof(newname), "db%d", db_id);
            ip = _NewInfo(interp, NULL, newname, I_DB);
            if (ip != NULL) {
                  result = bdb_DbOpen(interp, objc, objv, ip, &dbp);
                  if (result == TCL_OK && dbp != NULL) {
                        db_id++;
                        Tcl_CreateObjCommand(interp, newname,
                            (Tcl_ObjCmdProc *)db_Cmd,
                            (ClientData)dbp, NULL);
                        /* Use ip->i_name - newname is overwritten */
                        res =
                            Tcl_NewStringObj(newname, strlen(newname));
                        _SetInfoData(ip, dbp);
                  } else
                        _DeleteInfo(ip);
            } else {
                  Tcl_SetResult(interp, "Could not set up info",
                      TCL_STATIC);
                  result = TCL_ERROR;
            }
            break;
      case BDB_HCREATEX:
      case BDB_HSEARCHX:
      case BDB_HDESTROYX:
            result = bdb_HCommand(interp, objc, objv);
            break;
      case BDB_DBMINITX:
      case BDB_DBMCLOSEX:
      case BDB_FETCHX:
      case BDB_STOREX:
      case BDB_DELETEX:
      case BDB_FIRSTKEYX:
      case BDB_NEXTKEYX:
            result = bdb_DbmCommand(interp, objc, objv, DBTCL_DBM, NULL);
            break;
      case BDB_NDBMOPENX:
            snprintf(newname, sizeof(newname), "ndbm%d", ndbm_id);
            ip = _NewInfo(interp, NULL, newname, I_NDBM);
            if (ip != NULL) {
                  result = bdb_NdbmOpen(interp, objc, objv, &ndbmp);
                  if (result == TCL_OK) {
                        ndbm_id++;
                        Tcl_CreateObjCommand(interp, newname,
                            (Tcl_ObjCmdProc *)ndbm_Cmd,
                            (ClientData)ndbmp, NULL);
                        /* Use ip->i_name - newname is overwritten */
                        res =
                            Tcl_NewStringObj(newname, strlen(newname));
                        _SetInfoData(ip, ndbmp);
                  } else
                        _DeleteInfo(ip);
            } else {
                  Tcl_SetResult(interp, "Could not set up info",
                      TCL_STATIC);
                  result = TCL_ERROR;
            }
            break;
      case BDB_RANDX:
      case BDB_RAND_INTX:
      case BDB_SRANDX:
            result = bdb_RandCommand(interp, objc, objv);
            break;
      case BDB_DBGCKX:
            _debug_check();
            res = Tcl_NewIntObj(0);
            break;
      }
      /*
       * For each different arg call different function to create
       * new commands (or if version, get/return it).
       */
      if (result == TCL_OK && res != NULL)
            Tcl_SetObjResult(interp, res);
      return (result);
}

/*
 * bdb_EnvOpen -
 *    Implements the environment open command.
 *    There are many, many options to the open command.
 *    Here is the general flow:
 *
 *    1.  Call db_env_create to create the env handle.
 *    2.  Parse args tracking options.
 *    3.  Make any pre-open setup calls necessary.
 *    4.  Call DBENV->open to open the env.
 *    5.  Return env widget handle to user.
 */
static int
bdb_EnvOpen(interp, objc, objv, ip, env)
      Tcl_Interp *interp;           /* Interpreter */
      int objc;               /* How many arguments? */
      Tcl_Obj *CONST objv[];        /* The argument objects */
      DBTCL_INFO *ip;               /* Our internal info */
      DB_ENV **env;                 /* Environment pointer */
{
      static char *envopen[] = {
            "-cachesize",
            "-cdb",
            "-cdb_alldb",
            "-client_timeout",
            "-create",
            "-data_dir",
            "-errfile",
            "-errpfx",
            "-home",
            "-lock",
            "-lock_conflict",
            "-lock_detect",
            "-lock_max",
            "-lock_max_locks",
            "-lock_max_lockers",
            "-lock_max_objects",
            "-log",
            "-log_buffer",
            "-log_dir",
            "-log_max",
            "-mmapsize",
            "-mode",
            "-nommap",
            "-private",
            "-recover",
            "-recover_fatal",
            "-region_init",
            "-server",
            "-server_timeout",
            "-shm_key",
            "-system_mem",
            "-tmp_dir",
            "-txn",
            "-txn_max",
            "-txn_timestamp",
            "-use_environ",
            "-use_environ_root",
            "-verbose",
            NULL
      };
      /*
       * !!!
       * These have to be in the same order as the above,
       * which is close to but not quite alphabetical.
       */
      enum envopen {
            ENV_CACHESIZE,
            ENV_CDB,
            ENV_CDB_ALLDB,
            ENV_CLIENT_TO,
            ENV_CREATE,
            ENV_DATA_DIR,
            ENV_ERRFILE,
            ENV_ERRPFX,
            ENV_HOME,
            ENV_LOCK,
            ENV_CONFLICT,
            ENV_DETECT,
            ENV_LOCK_MAX,
            ENV_LOCK_MAX_LOCKS,
            ENV_LOCK_MAX_LOCKERS,
            ENV_LOCK_MAX_OBJECTS,
            ENV_LOG,
            ENV_LOG_BUFFER,
            ENV_LOG_DIR,
            ENV_LOG_MAX,
            ENV_MMAPSIZE,
            ENV_MODE,
            ENV_NOMMAP,
            ENV_PRIVATE,
            ENV_RECOVER,
            ENV_RECOVER_FATAL,
            ENV_REGION_INIT,
            ENV_SERVER,
            ENV_SERVER_TO,
            ENV_SHM_KEY,
            ENV_SYSTEM_MEM,
            ENV_TMP_DIR,
            ENV_TXN,
            ENV_TXN_MAX,
            ENV_TXN_TIME,
            ENV_USE_ENVIRON,
            ENV_USE_ENVIRON_ROOT,
            ENV_VERBOSE
      };
      Tcl_Obj **myobjv, **myobjv1;
      time_t time;
      u_int32_t detect, gbytes, bytes, ncaches, open_flags, set_flag, size;
      u_int8_t *conflicts;
      int i, intarg, itmp, j, logbufset, logmaxset;
      int mode, myobjc, nmodes, optindex, result, ret, temp;
      long client_to, server_to, shm;
      char *arg, *home, *server;

      result = TCL_OK;
      mode = 0;
      set_flag = 0;
      home = NULL;
      /*
       * XXX
       * If/when our Tcl interface becomes thread-safe, we should enable
       * DB_THREAD here.  Note that DB_THREAD currently does not work
       * with log_get -next, -prev;  if we wish to enable DB_THREAD,
       * those must either be made thread-safe first or we must come up with
       * a workaround.  (We used to specify DB_THREAD if and only if
       * logging was not configured.)
       */
      open_flags = DB_JOINENV;
      logmaxset = logbufset = 0;

      if (objc <= 2) {
            Tcl_WrongNumArgs(interp, 2, objv, "?args?");
            return (TCL_ERROR);
      }

      /*
       * Server code must go before the call to db_env_create.
       */
      server = NULL;
      server_to = client_to = 0;
      i = 2;
      while (i < objc) {
            if (Tcl_GetIndexFromObj(interp, objv[i++], envopen, "option",
                TCL_EXACT, &optindex) != TCL_OK) {
                  Tcl_ResetResult(interp);
                  continue;
            }
            switch ((enum envopen)optindex) {
            case ENV_SERVER:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "?-server hostname");
                        result = TCL_ERROR;
                        break;
                  }
                  server = Tcl_GetStringFromObj(objv[i++], NULL);
                  break;
            case ENV_SERVER_TO:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "?-server_to secs");
                        result = TCL_ERROR;
                        break;
                  }
                  result = Tcl_GetLongFromObj(interp, objv[i++],
                      &server_to);
                  break;
            case ENV_CLIENT_TO:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "?-client_to secs");
                        result = TCL_ERROR;
                        break;
                  }
                  result = Tcl_GetLongFromObj(interp, objv[i++],
                      &client_to);
                  break;
            default:
                  break;
            }
      }
      if (server != NULL) {
            ret = db_env_create(env, DB_CLIENT);
            if (ret)
                  return (_ReturnSetup(interp, ret, "db_env_create"));
            (*env)->set_errpfx((*env), ip->i_name);
            (*env)->set_errcall((*env), _ErrorFunc);
            if ((ret = (*env)->set_server((*env), server,
                client_to, server_to, 0)) != 0) {
                  result = TCL_ERROR;
                  goto error;
            }
      } else {
            /*
             * Create the environment handle before parsing the args
             * since we'll be modifying the environment as we parse.
             */
            ret = db_env_create(env, 0);
            if (ret)
                  return (_ReturnSetup(interp, ret, "db_env_create"));
            (*env)->set_errpfx((*env), ip->i_name);
            (*env)->set_errcall((*env), _ErrorFunc);
      }

      /*
       * Get the command name index from the object based on the bdbcmds
       * defined above.
       */
      i = 2;
      while (i < objc) {
            if (Tcl_GetIndexFromObj(interp, objv[i], envopen, "option",
                TCL_EXACT, &optindex) != TCL_OK) {
                  result = IS_HELP(objv[i]);
                  goto error;
            }
            i++;
            switch ((enum envopen)optindex) {
            case ENV_SERVER:
            case ENV_SERVER_TO:
            case ENV_CLIENT_TO:
                  /*
                   * Already handled these, skip them and their arg.
                   */
                  i++;
                  break;
            case ENV_CDB:
                  FLD_SET(open_flags, DB_INIT_CDB | DB_INIT_MPOOL);
                  FLD_CLR(open_flags, DB_JOINENV);
                  break;
            case ENV_CDB_ALLDB:
                  FLD_SET(set_flag, DB_CDB_ALLDB);
                  break;
            case ENV_LOCK:
                  FLD_SET(open_flags, DB_INIT_LOCK | DB_INIT_MPOOL);
                  FLD_CLR(open_flags, DB_JOINENV);
                  break;
            case ENV_LOG:
                  FLD_SET(open_flags, DB_INIT_LOG | DB_INIT_MPOOL);
                  FLD_CLR(open_flags, DB_JOINENV);
                  break;
            case ENV_TXN:
                  FLD_SET(open_flags, DB_INIT_LOCK |
                      DB_INIT_LOG | DB_INIT_MPOOL | DB_INIT_TXN);
                  FLD_CLR(open_flags, DB_JOINENV);
                  /* Make sure we have an arg to check against! */
                  if (i < objc) {
                        arg = Tcl_GetStringFromObj(objv[i], NULL);
                        if (strcmp(arg, "nosync") == 0) {
                              FLD_SET(set_flag, DB_TXN_NOSYNC);
                              i++;
                        }
                  }
                  break;
            case ENV_CREATE:
                  FLD_SET(open_flags, DB_CREATE | DB_INIT_MPOOL);
                  FLD_CLR(open_flags, DB_JOINENV);
                  break;
            case ENV_HOME:
                  /* Make sure we have an arg to check against! */
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "?-home dir?");
                        result = TCL_ERROR;
                        break;
                  }
                  home = Tcl_GetStringFromObj(objv[i++], NULL);
                  break;
            case ENV_MODE:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "?-mode mode?");
                        result = TCL_ERROR;
                        break;
                  }
                  /*
                   * Don't need to check result here because
                   * if TCL_ERROR, the error message is already
                   * set up, and we'll bail out below.  If ok,
                   * the mode is set and we go on.
                   */
                  result = Tcl_GetIntFromObj(interp, objv[i++], &mode);
                  break;
            case ENV_NOMMAP:
                  FLD_SET(set_flag, DB_NOMMAP);
                  break;
            case ENV_PRIVATE:
                  FLD_SET(open_flags, DB_PRIVATE | DB_INIT_MPOOL);
                  FLD_CLR(open_flags, DB_JOINENV);
                  break;
            case ENV_RECOVER:
                  FLD_SET(open_flags, DB_RECOVER);
                  break;
            case ENV_RECOVER_FATAL:
                  FLD_SET(open_flags, DB_RECOVER_FATAL);
                  break;
            case ENV_SYSTEM_MEM:
                  FLD_SET(open_flags, DB_SYSTEM_MEM);
                  break;
            case ENV_USE_ENVIRON_ROOT:
                  FLD_SET(open_flags, DB_USE_ENVIRON_ROOT);
                  break;
            case ENV_USE_ENVIRON:
                  FLD_SET(open_flags, DB_USE_ENVIRON);
                  break;
            case ENV_VERBOSE:
                  result = Tcl_ListObjGetElements(interp, objv[i],
                      &myobjc, &myobjv);
                  if (result == TCL_OK)
                        i++;
                  else
                        break;
                  if (myobjc != 2) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "?-verbose {which on|off}?");
                        result = TCL_ERROR;
                        break;
                  }
                  result = tcl_EnvVerbose(interp, *env,
                      myobjv[0], myobjv[1]);
                  break;
            case ENV_REGION_INIT:
                  _debug_check();
                  ret = db_env_set_region_init(1);
                  result = _ReturnSetup(interp, ret, "region_init");
                  break;
            case ENV_CACHESIZE:
                  result = Tcl_ListObjGetElements(interp, objv[i],
                      &myobjc, &myobjv);
                  if (result == TCL_OK)
                        i++;
                  else
                        break;
                  j = 0;
                  if (myobjc != 3) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "?-cachesize {gbytes bytes ncaches}?");
                        result = TCL_ERROR;
                        break;
                  }
                  result = Tcl_GetIntFromObj(interp, myobjv[0], &itmp);
                  gbytes = itmp;
                  if (result != TCL_OK)
                        break;
                  result = Tcl_GetIntFromObj(interp, myobjv[1], &itmp);
                  bytes = itmp;
                  if (result != TCL_OK)
                        break;
                  result = Tcl_GetIntFromObj(interp, myobjv[2], &itmp);
                  ncaches = itmp;
                  if (result != TCL_OK)
                        break;
                  _debug_check();
                  ret = (*env)->set_cachesize(*env, gbytes, bytes,
                      ncaches);
                  result = _ReturnSetup(interp, ret, "set_cachesize");
                  break;
            case ENV_MMAPSIZE:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "?-mmapsize size?");
                        result = TCL_ERROR;
                        break;
                  }
                  result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
                  if (result == TCL_OK) {
                        _debug_check();
                        ret = (*env)->set_mp_mmapsize(*env,
                            (size_t)intarg);
                        result = _ReturnSetup(interp, ret, "mmapsize");
                  }
                  break;
            case ENV_SHM_KEY:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "?-shm_key key?");
                        result = TCL_ERROR;
                        break;
                  }
                  result = Tcl_GetLongFromObj(interp, objv[i++], &shm);
                  if (result == TCL_OK) {
                        _debug_check();
                        ret = (*env)->set_shm_key(*env, shm);
                        result = _ReturnSetup(interp, ret, "shm_key");
                  }
                  break;
            case ENV_LOG_MAX:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "?-log_max max?");
                        result = TCL_ERROR;
                        break;
                  }
                  result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
                  if (result == TCL_OK && logbufset) {
                        _debug_check();
                        ret = (*env)->set_lg_max(*env,
                            (u_int32_t)intarg);
                        result = _ReturnSetup(interp, ret, "log_max");
                        logbufset = 0;
                  } else
                        logmaxset = intarg;
                  break;
            case ENV_LOG_BUFFER:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "?-log_buffer size?");
                        result = TCL_ERROR;
                        break;
                  }
                  result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
                  if (result == TCL_OK) {
                        _debug_check();
                        ret = (*env)->set_lg_bsize(*env,
                            (u_int32_t)intarg);
                        result = _ReturnSetup(interp, ret, "log_bsize");
                        logbufset = 1;
                        if (logmaxset) {
                              _debug_check();
                              ret = (*env)->set_lg_max(*env,
                                  (u_int32_t)logmaxset);
                              result = _ReturnSetup(interp, ret,
                                  "log_max");
                              logmaxset = 0;
                              logbufset = 0;
                        }
                  }
                  break;
            case ENV_CONFLICT:
                  /*
                   * Get conflict list.  List is:
                   * {nmodes {matrix}}
                   *
                   * Where matrix must be nmodes*nmodes big.
                   * Set up conflicts array to pass.
                   */
                  result = Tcl_ListObjGetElements(interp, objv[i],
                      &myobjc, &myobjv);
                  if (result == TCL_OK)
                        i++;
                  else
                        break;
                  if (myobjc != 2) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "?-lock_conflict {nmodes {matrix}}?");
                        result = TCL_ERROR;
                        break;
                  }
                  result = Tcl_GetIntFromObj(interp, myobjv[0], &nmodes);
                  if (result != TCL_OK)
                        break;
                  result = Tcl_ListObjGetElements(interp, myobjv[1],
                      &myobjc, &myobjv1);
                  if (myobjc != (nmodes * nmodes)) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "?-lock_conflict {nmodes {matrix}}?");
                        result = TCL_ERROR;
                        break;
                  }
                  size = sizeof(u_int8_t) * nmodes*nmodes;
                  ret = __os_malloc(*env, size, NULL, &conflicts);
                  if (ret != 0) {
                        result = TCL_ERROR;
                        break;
                  }
                  for (j = 0; j < myobjc; j++) {
                        result = Tcl_GetIntFromObj(interp, myobjv1[j],
                            &temp);
                        conflicts[j] = temp;
                        if (result != TCL_OK) {
                              __os_free(conflicts, size);
                              break;
                        }
                  }
                  _debug_check();
                  ret = (*env)->set_lk_conflicts(*env,
                      (u_int8_t *)conflicts, nmodes);
                  __os_free(conflicts, size);
                  result = _ReturnSetup(interp, ret, "set_lk_conflicts");
                  break;
            case ENV_DETECT:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "?-lock_detect policy?");
                        result = TCL_ERROR;
                        break;
                  }
                  arg = Tcl_GetStringFromObj(objv[i++], NULL);
                  if (strcmp(arg, "default") == 0)
                        detect = DB_LOCK_DEFAULT;
                  else if (strcmp(arg, "oldest") == 0)
                        detect = DB_LOCK_OLDEST;
                  else if (strcmp(arg, "youngest") == 0)
                        detect = DB_LOCK_YOUNGEST;
                  else if (strcmp(arg, "random") == 0)
                        detect = DB_LOCK_RANDOM;
                  else {
                        Tcl_AddErrorInfo(interp,
                            "lock_detect: illegal policy");
                        result = TCL_ERROR;
                        break;
                  }
                  _debug_check();
                  ret = (*env)->set_lk_detect(*env, detect);
                  result = _ReturnSetup(interp, ret, "lock_detect");
                  break;
            case ENV_LOCK_MAX:
            case ENV_LOCK_MAX_LOCKS:
            case ENV_LOCK_MAX_LOCKERS:
            case ENV_LOCK_MAX_OBJECTS:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "?-lock_max max?");
                        result = TCL_ERROR;
                        break;
                  }
                  result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
                  if (result == TCL_OK) {
                        _debug_check();
                        switch ((enum envopen)optindex) {
                        case ENV_LOCK_MAX:
                              ret = (*env)->set_lk_max(*env,
                                  (u_int32_t)intarg);
                              break;
                        case ENV_LOCK_MAX_LOCKS:
                              ret = (*env)->set_lk_max_locks(*env,
                                  (u_int32_t)intarg);
                              break;
                        case ENV_LOCK_MAX_LOCKERS:
                              ret = (*env)->set_lk_max_lockers(*env,
                                  (u_int32_t)intarg);
                              break;
                        case ENV_LOCK_MAX_OBJECTS:
                              ret = (*env)->set_lk_max_objects(*env,
                                   (u_int32_t)intarg);
                              break;
                        default:
                              break;
                        }
                        result = _ReturnSetup(interp, ret, "lock_max");
                  }
                  break;
            case ENV_TXN_MAX:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "?-txn_max max?");
                        result = TCL_ERROR;
                        break;
                  }
                  result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
                  if (result == TCL_OK) {
                        _debug_check();
                        ret = (*env)->set_tx_max(*env,
                            (u_int32_t)intarg);
                        result = _ReturnSetup(interp, ret, "txn_max");
                  }
                  break;
            case ENV_TXN_TIME:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "?-txn_timestamp time?");
                        result = TCL_ERROR;
                        break;
                  }
                  result = Tcl_GetLongFromObj(interp, objv[i++],
                      (long *)&time);
                  if (result == TCL_OK) {
                        _debug_check();
                        ret = (*env)->set_tx_timestamp(*env, &time);
                        result = _ReturnSetup(interp, ret,
                            "txn_timestamp");
                  }
                  break;
            case ENV_ERRFILE:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "-errfile file");
                        result = TCL_ERROR;
                        break;
                  }
                  arg = Tcl_GetStringFromObj(objv[i++], NULL);
                  /*
                   * If the user already set one, close it.
                   */
                  if (ip->i_err != NULL)
                        fclose(ip->i_err);
                  ip->i_err = fopen(arg, "a");
                  if (ip->i_err != NULL) {
                        _debug_check();
                        (*env)->set_errfile(*env, ip->i_err);
                  }
                  break;
            case ENV_ERRPFX:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "-errpfx prefix");
                        result = TCL_ERROR;
                        break;
                  }
                  arg = Tcl_GetStringFromObj(objv[i++], NULL);
                  /*
                   * If the user already set one, free it.
                   */
                  if (ip->i_errpfx != NULL)
                        __os_freestr(ip->i_errpfx);
                  if ((ret =
                      __os_strdup(*env, arg, &ip->i_errpfx)) != 0) {
                        result = _ReturnSetup(interp, ret,
                            "__os_strdup");
                        break;
                  }
                  if (ip->i_errpfx != NULL) {
                        _debug_check();
                        (*env)->set_errpfx(*env, ip->i_errpfx);
                  }
                  break;
            case ENV_DATA_DIR:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "-data_dir dir");
                        result = TCL_ERROR;
                        break;
                  }
                  arg = Tcl_GetStringFromObj(objv[i++], NULL);
                  _debug_check();
                  ret = (*env)->set_data_dir(*env, arg);
                  result = _ReturnSetup(interp, ret, "set_data_dir");
                  break;
            case ENV_LOG_DIR:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "-log_dir dir");
                        result = TCL_ERROR;
                        break;
                  }
                  arg = Tcl_GetStringFromObj(objv[i++], NULL);
                  _debug_check();
                  ret = (*env)->set_lg_dir(*env, arg);
                  result = _ReturnSetup(interp, ret, "set_lg_dir");
                  break;
            case ENV_TMP_DIR:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "-tmp_dir dir");
                        result = TCL_ERROR;
                        break;
                  }
                  arg = Tcl_GetStringFromObj(objv[i++], NULL);
                  _debug_check();
                  ret = (*env)->set_tmp_dir(*env, arg);
                  result = _ReturnSetup(interp, ret, "set_tmp_dir");
                  break;
            }
            /*
             * If, at any time, parsing the args we get an error,
             * bail out and return.
             */
            if (result != TCL_OK)
                  goto error;
      }

      /*
       * We have to check this here.  We want to set the log buffer
       * size first, if it is specified.  So if the user did so,
       * then we took care of it above.  But, if we get out here and
       * logmaxset is non-zero, then they set the log_max without
       * resetting the log buffer size, so we now have to do the
       * call to set_lg_max, since we didn't do it above.
       */
      if (logmaxset) {
            _debug_check();
            ret = (*env)->set_lg_max(*env, (u_int32_t)logmaxset);
            result = _ReturnSetup(interp, ret, "log_max");
      }

      if (result != TCL_OK)
            goto error;

      if (set_flag) {
            ret = (*env)->set_flags(*env, set_flag, 1);
            result = _ReturnSetup(interp, ret, "set_flags");
            if (result == TCL_ERROR)
                  goto error;
            /*
             * If we are successful, clear the result so that the
             * return from set_flags isn't part of the result.
             */
            Tcl_ResetResult(interp);
      }
      /*
       * When we get here, we have already parsed all of our args
       * and made all our calls to set up the environment.  Everything
       * is okay so far, no errors, if we get here.
       *
       * Now open the environment.
       */
      _debug_check();
      ret = (*env)->open(*env, home, open_flags, mode);
      result = _ReturnSetup(interp, ret, "env open");

error:
      if (result == TCL_ERROR) {
            if (ip->i_err) {
                  fclose(ip->i_err);
                  ip->i_err = NULL;
            }
            (void)(*env)->close(*env, 0);
            *env = NULL;
      }
      return (result);
}

/*
 * bdb_DbOpen --
 *    Implements the "db_create/db_open" command.
 *    There are many, many options to the open command.
 *    Here is the general flow:
 *
 *    0.  Preparse args to determine if we have -env.
 *    1.  Call db_create to create the db handle.
 *    2.  Parse args tracking options.
 *    3.  Make any pre-open setup calls necessary.
 *    4.  Call DB->open to open the database.
 *    5.  Return db widget handle to user.
 */
static int
bdb_DbOpen(interp, objc, objv, ip, dbp)
      Tcl_Interp *interp;           /* Interpreter */
      int objc;               /* How many arguments? */
      Tcl_Obj *CONST objv[];        /* The argument objects */
      DBTCL_INFO *ip;               /* Our internal info */
      DB **dbp;               /* DB handle */
{
      static char *bdbenvopen[] = {
            "-env",     NULL
      };
      enum bdbenvopen {
            TCL_DB_ENV0
      };
      static char *bdbopen[] = {
            "-btree",
            "-cachesize",
            "-create",
            "-delim",
            "-dup",
            "-dupsort",
            "-env",
            "-errfile",
            "-errpfx",
            "-excl",
            "-extent",
            "-ffactor",
            "-hash",
            "-len",
            "-lorder",
            "-minkey",
            "-mode",
            "-nelem",
            "-nommap",
            "-pad",
            "-pagesize",
            "-queue",
            "-rdonly",
            "-recno",
            "-recnum",
            "-renumber",
            "-revsplitoff",
            "-snapshot",
            "-source",
            "-truncate",
            "-test",
            "-unknown",
            "--",
            NULL
      };
      enum bdbopen {
            TCL_DB_BTREE,
            TCL_DB_CACHESIZE,
            TCL_DB_CREATE,
            TCL_DB_DELIM,
            TCL_DB_DUP,
            TCL_DB_DUPSORT,
            TCL_DB_ENV,
            TCL_DB_ERRFILE,
            TCL_DB_ERRPFX,
            TCL_DB_EXCL,
            TCL_DB_EXTENT,
            TCL_DB_FFACTOR,
            TCL_DB_HASH,
            TCL_DB_LEN,
            TCL_DB_LORDER,
            TCL_DB_MINKEY,
            TCL_DB_MODE,
            TCL_DB_NELEM,
            TCL_DB_NOMMAP,
            TCL_DB_PAD,
            TCL_DB_PAGESIZE,
            TCL_DB_QUEUE,
            TCL_DB_RDONLY,
            TCL_DB_RECNO,
            TCL_DB_RECNUM,
            TCL_DB_RENUMBER,
            TCL_DB_REVSPLIT,
            TCL_DB_SNAPSHOT,
            TCL_DB_SOURCE,
            TCL_DB_TRUNCATE,
            TCL_DB_TEST,
            TCL_DB_UNKNOWN,
            TCL_DB_ENDARG
      };

      DBTCL_INFO *envip, *errip;
      DBTYPE type;
      DB_ENV *envp;
      Tcl_Obj **myobjv;
      u_int32_t gbytes, bytes, ncaches, open_flags;
      int endarg, i, intarg, itmp, j, mode, myobjc;
      int optindex, result, ret, set_err, set_flag, set_pfx, subdblen;
      u_char *subdbtmp;
      char *arg, *db, *subdb;
      extern u_int32_t __ham_test __P((DB *, const void *, u_int32_t));

      type = DB_UNKNOWN;
      endarg = mode = set_err = set_flag = set_pfx = 0;
      result = TCL_OK;
      subdbtmp = NULL;
      db = subdb = NULL;

      /*
       * XXX
       * If/when our Tcl interface becomes thread-safe, we should enable
       * DB_THREAD here.  See comment in bdb_EnvOpen().
       */
      open_flags = 0;
      envp = NULL;

      if (objc < 2) {
            Tcl_WrongNumArgs(interp, 2, objv, "?args?");
            return (TCL_ERROR);
      }

      /*
       * We must first parse for the environment flag, since that
       * is needed for db_create.  Then create the db handle.
       */
      i = 2;
      while (i < objc) {
            if (Tcl_GetIndexFromObj(interp, objv[i++], bdbenvopen,
                "option", TCL_EXACT, &optindex) != TCL_OK) {
                  /*
                   * Reset the result so we don't get
                   * an errant error message if there is another error.
                   */
                  Tcl_ResetResult(interp);
                  continue;
            }
            switch ((enum bdbenvopen)optindex) {
            case TCL_DB_ENV0:
                  arg = Tcl_GetStringFromObj(objv[i], NULL);
                  envp = NAME_TO_ENV(arg);
                  if (envp == NULL) {
                        Tcl_SetResult(interp,
                            "db open: illegal environment", TCL_STATIC);
                        return (TCL_ERROR);
                  }
            }
            break;
      }

      /*
       * Create the db handle before parsing the args
       * since we'll be modifying the database options as we parse.
       */
      ret = db_create(dbp, envp, 0);
      if (ret)
            return (_ReturnSetup(interp, ret, "db_create"));

      /*
       * XXX Remove restriction when err stuff is not tied to env.
       *
       * The DB->set_err* functions actually overwrite in the
       * environment.  So, if we are explicitly using an env,
       * don't overwrite what we have already set up.  If we are
       * not using one, then we set up since we get a private
       * default env.
       */
      /* XXX  - remove this conditional if/when err is not tied to env */
      if (envp == NULL) {
            (*dbp)->set_errpfx((*dbp), ip->i_name);
            (*dbp)->set_errcall((*dbp), _ErrorFunc);
      }
      envip = _PtrToInfo(envp); /* XXX */
      /*
       * If we are using an env, we keep track of err info in the env's ip.
       * Otherwise use the DB's ip.
       */
      if (envip)
            errip = envip;
      else
            errip = ip;
      /*
       * Get the option name index from the object based on the args
       * defined above.
       */
      i = 2;
      while (i < objc) {
            if (Tcl_GetIndexFromObj(interp, objv[i], bdbopen, "option",
                TCL_EXACT, &optindex) != TCL_OK) {
                  arg = Tcl_GetStringFromObj(objv[i], NULL);
                  if (arg[0] == '-') {
                        result = IS_HELP(objv[i]);
                        goto error;
                  } else
                        Tcl_ResetResult(interp);
                  break;
            }
            i++;
            switch ((enum bdbopen)optindex) {
            case TCL_DB_ENV:
                  /*
                   * Already parsed this, skip it and the env pointer.
                   */
                  i++;
                  continue;
            case TCL_DB_BTREE:
                  if (type != DB_UNKNOWN) {
                        Tcl_SetResult(interp,
                            "Too many DB types specified", TCL_STATIC);
                        result = TCL_ERROR;
                        goto error;
                  }
                  type = DB_BTREE;
                  break;
            case TCL_DB_HASH:
                  if (type != DB_UNKNOWN) {
                        Tcl_SetResult(interp,
                            "Too many DB types specified", TCL_STATIC);
                        result = TCL_ERROR;
                        goto error;
                  }
                  type = DB_HASH;
                  break;
            case TCL_DB_RECNO:
                  if (type != DB_UNKNOWN) {
                        Tcl_SetResult(interp,
                            "Too many DB types specified", TCL_STATIC);
                        result = TCL_ERROR;
                        goto error;
                  }
                  type = DB_RECNO;
                  break;
            case TCL_DB_QUEUE:
                  if (type != DB_UNKNOWN) {
                        Tcl_SetResult(interp,
                            "Too many DB types specified", TCL_STATIC);
                        result = TCL_ERROR;
                        goto error;
                  }
                  type = DB_QUEUE;
                  break;
            case TCL_DB_UNKNOWN:
                  if (type != DB_UNKNOWN) {
                        Tcl_SetResult(interp,
                            "Too many DB types specified", TCL_STATIC);
                        result = TCL_ERROR;
                        goto error;
                  }
                  break;
            case TCL_DB_CREATE:
                  open_flags |= DB_CREATE;
                  break;
            case TCL_DB_EXCL:
                  open_flags |= DB_EXCL;
                  break;
            case TCL_DB_RDONLY:
                  open_flags |= DB_RDONLY;
                  break;
            case TCL_DB_TRUNCATE:
                  open_flags |= DB_TRUNCATE;
                  break;
            case TCL_DB_TEST:
                  (*dbp)->set_h_hash(*dbp, __ham_test);
                  break;
            case TCL_DB_MODE:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "?-mode mode?");
                        result = TCL_ERROR;
                        break;
                  }
                  /*
                   * Don't need to check result here because
                   * if TCL_ERROR, the error message is already
                   * set up, and we'll bail out below.  If ok,
                   * the mode is set and we go on.
                   */
                  result = Tcl_GetIntFromObj(interp, objv[i++], &mode);
                  break;
            case TCL_DB_NOMMAP:
                  open_flags |= DB_NOMMAP;
                  break;
            case TCL_DB_DUP:
                  set_flag |= DB_DUP;
                  break;
            case TCL_DB_DUPSORT:
                  set_flag |= DB_DUPSORT;
                  break;
            case TCL_DB_RECNUM:
                  set_flag |= DB_RECNUM;
                  break;
            case TCL_DB_RENUMBER:
                  set_flag |= DB_RENUMBER;
                  break;
            case TCL_DB_REVSPLIT:
                  set_flag |= DB_REVSPLITOFF;
                  break;
            case TCL_DB_SNAPSHOT:
                  set_flag |= DB_SNAPSHOT;
                  break;
            case TCL_DB_FFACTOR:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "-ffactor density");
                        result = TCL_ERROR;
                        break;
                  }
                  result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
                  if (result == TCL_OK) {
                        _debug_check();
                        ret = (*dbp)->set_h_ffactor(*dbp,
                            (u_int32_t)intarg);
                        result = _ReturnSetup(interp, ret,
                            "set_h_ffactor");
                  }
                  break;
            case TCL_DB_NELEM:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "-nelem nelem");
                        result = TCL_ERROR;
                        break;
                  }
                  result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
                  if (result == TCL_OK) {
                        _debug_check();
                        ret = (*dbp)->set_h_nelem(*dbp,
                            (u_int32_t)intarg);
                        result = _ReturnSetup(interp, ret,
                            "set_h_nelem");
                  }
                  break;
            case TCL_DB_LORDER:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "-lorder 1234|4321");
                        result = TCL_ERROR;
                        break;
                  }
                  result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
                  if (result == TCL_OK) {
                        _debug_check();
                        ret = (*dbp)->set_lorder(*dbp,
                            (u_int32_t)intarg);
                        result = _ReturnSetup(interp, ret,
                            "set_lorder");
                  }
                  break;
            case TCL_DB_DELIM:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "-delim delim");
                        result = TCL_ERROR;
                        break;
                  }
                  result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
                  if (result == TCL_OK) {
                        _debug_check();
                        ret = (*dbp)->set_re_delim(*dbp, intarg);
                        result = _ReturnSetup(interp, ret,
                            "set_re_delim");
                  }
                  break;
            case TCL_DB_LEN:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "-len length");
                        result = TCL_ERROR;
                        break;
                  }
                  result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
                  if (result == TCL_OK) {
                        _debug_check();
                        ret = (*dbp)->set_re_len(*dbp,
                            (u_int32_t)intarg);
                        result = _ReturnSetup(interp, ret,
                            "set_re_len");
                  }
                  break;
            case TCL_DB_PAD:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "-pad pad");
                        result = TCL_ERROR;
                        break;
                  }
                  result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
                  if (result == TCL_OK) {
                        _debug_check();
                        ret = (*dbp)->set_re_pad(*dbp, intarg);
                        result = _ReturnSetup(interp, ret,
                            "set_re_pad");
                  }
                  break;
            case TCL_DB_SOURCE:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "-source file");
                        result = TCL_ERROR;
                        break;
                  }
                  arg = Tcl_GetStringFromObj(objv[i++], NULL);
                  _debug_check();
                  ret = (*dbp)->set_re_source(*dbp, arg);
                  result = _ReturnSetup(interp, ret, "set_re_source");
                  break;
            case TCL_DB_EXTENT:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "-extent size");
                        result = TCL_ERROR;
                        break;
                  }
                  result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
                  if (result == TCL_OK) {
                        _debug_check();
                        ret = (*dbp)->set_q_extentsize(*dbp,
                            (u_int32_t)intarg);
                        result = _ReturnSetup(interp, ret,
                            "set_q_extentsize");
                  }
                  break;
            case TCL_DB_MINKEY:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "-minkey minkey");
                        result = TCL_ERROR;
                        break;
                  }
                  result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
                  if (result == TCL_OK) {
                        _debug_check();
                        ret = (*dbp)->set_bt_minkey(*dbp, intarg);
                        result = _ReturnSetup(interp, ret,
                            "set_bt_minkey");
                  }
                  break;
            case TCL_DB_CACHESIZE:
                  result = Tcl_ListObjGetElements(interp, objv[i++],
                      &myobjc, &myobjv);
                  if (result != TCL_OK)
                        break;
                  j = 0;
                  if (myobjc != 3) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "?-cachesize {gbytes bytes ncaches}?");
                        result = TCL_ERROR;
                        break;
                  }
                  result = Tcl_GetIntFromObj(interp, myobjv[0], &itmp);
                  gbytes = itmp;
                  if (result != TCL_OK)
                        break;
                  result = Tcl_GetIntFromObj(interp, myobjv[1], &itmp);
                  bytes = itmp;
                  if (result != TCL_OK)
                        break;
                  result = Tcl_GetIntFromObj(interp, myobjv[2], &itmp);
                  ncaches = itmp;
                  if (result != TCL_OK)
                        break;
                  _debug_check();
                  ret = (*dbp)->set_cachesize(*dbp, gbytes, bytes,
                      ncaches);
                  result = _ReturnSetup(interp, ret,
                      "set_cachesize");
                  break;
            case TCL_DB_PAGESIZE:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "?-pagesize size?");
                        result = TCL_ERROR;
                        break;
                  }
                  result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
                  if (result == TCL_OK) {
                        _debug_check();
                        ret = (*dbp)->set_pagesize(*dbp,
                            (size_t)intarg);
                        result = _ReturnSetup(interp, ret,
                            "set pagesize");
                  }
                  break;
            case TCL_DB_ERRFILE:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "-errfile file");
                        result = TCL_ERROR;
                        break;
                  }
                  arg = Tcl_GetStringFromObj(objv[i++], NULL);
                  /*
                   * If the user already set one, close it.
                   */
                  if (errip->i_err != NULL)
                        fclose(errip->i_err);
                  errip->i_err = fopen(arg, "a");
                  if (errip->i_err != NULL) {
                        _debug_check();
                        (*dbp)->set_errfile(*dbp, errip->i_err);
                        set_err = 1;
                  }
                  break;
            case TCL_DB_ERRPFX:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "-errpfx prefix");
                        result = TCL_ERROR;
                        break;
                  }
                  arg = Tcl_GetStringFromObj(objv[i++], NULL);
                  /*
                   * If the user already set one, free it.
                   */
                  if (errip->i_errpfx != NULL)
                        __os_freestr(errip->i_errpfx);
                  if ((ret = __os_strdup((*dbp)->dbenv,
                      arg, &errip->i_errpfx)) != 0) {
                        result = _ReturnSetup(interp, ret,
                            "__os_strdup");
                        break;
                  }
                  if (errip->i_errpfx != NULL) {
                        _debug_check();
                        (*dbp)->set_errpfx(*dbp, errip->i_errpfx);
                        set_pfx = 1;
                  }
                  break;
            case TCL_DB_ENDARG:
                  endarg = 1;
                  break;
            } /* switch */

            /*
             * If, at any time, parsing the args we get an error,
             * bail out and return.
             */
            if (result != TCL_OK)
                  goto error;
            if (endarg)
                  break;
      }
      if (result != TCL_OK)
            goto error;

      /*
       * Any args we have left, (better be 0, 1 or 2 left) are
       * file names.  If we have 0, then an in-memory db.  If
       * there is 1, a db name, if 2 a db and subdb name.
       */
      if (i != objc) {
            /*
             * Dbs must be NULL terminated file names, but subdbs can
             * be anything.  Use Strings for the db name and byte
             * arrays for the subdb.
             */
            db = Tcl_GetStringFromObj(objv[i++], NULL);
            if (i != objc) {
                  subdbtmp =
                      Tcl_GetByteArrayFromObj(objv[i++], &subdblen);
                  if ((ret = __os_malloc(envp,
                     subdblen + 1, NULL, &subdb)) != 0) {
                        Tcl_SetResult(interp, db_strerror(ret),
                            TCL_STATIC);
                        return (0);
                  }
                  memcpy(subdb, subdbtmp, subdblen);
                  subdb[subdblen] = '\0';
            }
      }
      if (set_flag) {
            ret = (*dbp)->set_flags(*dbp, set_flag);
            result = _ReturnSetup(interp, ret, "set_flags");
            if (result == TCL_ERROR)
                  goto error;
            /*
             * If we are successful, clear the result so that the
             * return from set_flags isn't part of the result.
             */
            Tcl_ResetResult(interp);
      }

      /*
       * When we get here, we have already parsed all of our args and made
       * all our calls to set up the database.  Everything is okay so far,
       * no errors, if we get here.
       */
      _debug_check();

      /* Open the database. */
      ret = (*dbp)->open(*dbp, db, subdb, type, open_flags, mode);
      result = _ReturnSetup(interp, ret, "db open");

error:
      if (subdb)
            __os_free(subdb, subdblen + 1);
      if (result == TCL_ERROR) {
            /*
             * If we opened and set up the error file in the environment
             * on this open, but we failed for some other reason, clean
             * up and close the file.
             *
             * XXX when err stuff isn't tied to env, change to use ip,
             * instead of envip.  Also, set_err is irrelevant when that
             * happens.  It will just read:
             * if (ip->i_err)
             *    fclose(ip->i_err);
             */
            if (set_err && errip && errip->i_err != NULL) {
                  fclose(errip->i_err);
                  errip->i_err = NULL;
            }
            if (set_pfx && errip && errip->i_errpfx != NULL) {
                  __os_freestr(errip->i_errpfx);
                  errip->i_errpfx = NULL;
            }
            (void)(*dbp)->close(*dbp, 0);
            *dbp = NULL;
      }
      return (result);
}

/*
 * bdb_DbRemove --
 *    Implements the DB->remove command.
 */
static int
bdb_DbRemove(interp, objc, objv)
      Tcl_Interp *interp;           /* Interpreter */
      int objc;               /* How many arguments? */
      Tcl_Obj *CONST objv[];        /* The argument objects */
{
      static char *bdbrem[] = {
            "-env",     "--", NULL
      };
      enum bdbrem {
            TCL_DBREM_ENV,
            TCL_DBREM_ENDARG
      };
      DB_ENV *envp;
      DB *dbp;
      int endarg, i, optindex, result, ret, subdblen;
      u_char *subdbtmp;
      char *arg, *db, *subdb;

      envp = NULL;
      dbp = NULL;
      result = TCL_OK;
      subdbtmp = NULL;
      db = subdb = NULL;
      endarg = 0;

      if (objc < 2) {
            Tcl_WrongNumArgs(interp, 2, objv, "?args? filename ?database?");
            return (TCL_ERROR);
      }

      /*
       * We must first parse for the environment flag, since that
       * is needed for db_create.  Then create the db handle.
       */
      i = 2;
      while (i < objc) {
            if (Tcl_GetIndexFromObj(interp, objv[i], bdbrem,
                "option", TCL_EXACT, &optindex) != TCL_OK) {
                  arg = Tcl_GetStringFromObj(objv[i], NULL);
                  if (arg[0] == '-') {
                        result = IS_HELP(objv[i]);
                        goto error;
                  } else
                        Tcl_ResetResult(interp);
                  break;
            }
            i++;
            switch ((enum bdbrem)optindex) {
            case TCL_DBREM_ENV:
                  arg = Tcl_GetStringFromObj(objv[i++], NULL);
                  envp = NAME_TO_ENV(arg);
                  if (envp == NULL) {
                        Tcl_SetResult(interp,
                            "db remove: illegal environment",
                            TCL_STATIC);
                        return (TCL_ERROR);
                  }
                  break;
            case TCL_DBREM_ENDARG:
                  endarg = 1;
                  break;
            }
            /*
             * If, at any time, parsing the args we get an error,
             * bail out and return.
             */
            if (result != TCL_OK)
                  goto error;
            if (endarg)
                  break;
      }
      if (result != TCL_OK)
            goto error;
      /*
       * Any args we have left, (better be 1 or 2 left) are
       * file names. If there is 1, a db name, if 2 a db and subdb name.
       */
      if ((i != (objc - 1)) || (i != (objc - 2))) {
            /*
             * Dbs must be NULL terminated file names, but subdbs can
             * be anything.  Use Strings for the db name and byte
             * arrays for the subdb.
             */
            db = Tcl_GetStringFromObj(objv[i++], NULL);
            if (i != objc) {
                  subdbtmp =
                      Tcl_GetByteArrayFromObj(objv[i++], &subdblen);
                  if ((ret = __os_malloc(envp, subdblen + 1,
                      NULL, &subdb)) != 0) { Tcl_SetResult(interp,
                            db_strerror(ret), TCL_STATIC);
                        return (0);
                  }
                  memcpy(subdb, subdbtmp, subdblen);
                  subdb[subdblen] = '\0';
            }
      } else {
            Tcl_WrongNumArgs(interp, 2, objv, "?args? filename ?database?");
            result = TCL_ERROR;
            goto error;
      }
      ret = db_create(&dbp, envp, 0);
      if (ret) {
            result = _ReturnSetup(interp, ret, "db_create");
            goto error;
      }
      /*
       * No matter what, we NULL out dbp after this call.
       */
      ret = dbp->remove(dbp, db, subdb, 0);
      result = _ReturnSetup(interp, ret, "db remove");
      dbp = NULL;
error:
      if (subdb)
            __os_free(subdb, subdblen + 1);
      if (result == TCL_ERROR && dbp)
            (void)dbp->close(dbp, 0);
      return (result);
}

/*
 * bdb_DbRename --
 *    Implements the DB->rename command.
 */
static int
bdb_DbRename(interp, objc, objv)
      Tcl_Interp *interp;           /* Interpreter */
      int objc;               /* How many arguments? */
      Tcl_Obj *CONST objv[];        /* The argument objects */
{
      static char *bdbmv[] = {
            "-env",     "--", NULL
      };
      enum bdbmv {
            TCL_DBMV_ENV,
            TCL_DBMV_ENDARG
      };
      DB_ENV *envp;
      DB *dbp;
      int endarg, i, newlen, optindex, result, ret, subdblen;
      u_char *subdbtmp;
      char *arg, *db, *newname, *subdb;

      envp = NULL;
      dbp = NULL;
      result = TCL_OK;
      subdbtmp = NULL;
      db = newname = subdb = NULL;
      endarg = 0;

      if (objc < 2) {
            Tcl_WrongNumArgs(interp,
                  3, objv, "?args? filename ?database? ?newname?");
            return (TCL_ERROR);
      }

      /*
       * We must first parse for the environment flag, since that
       * is needed for db_create.  Then create the db handle.
       */
      i = 2;
      while (i < objc) {
            if (Tcl_GetIndexFromObj(interp, objv[i], bdbmv,
                "option", TCL_EXACT, &optindex) != TCL_OK) {
                  arg = Tcl_GetStringFromObj(objv[i], NULL);
                  if (arg[0] == '-') {
                        result = IS_HELP(objv[i]);
                        goto error;
                  } else
                        Tcl_ResetResult(interp);
                  break;
            }
            i++;
            switch ((enum bdbmv)optindex) {
            case TCL_DBMV_ENV:
                  arg = Tcl_GetStringFromObj(objv[i++], NULL);
                  envp = NAME_TO_ENV(arg);
                  if (envp == NULL) {
                        Tcl_SetResult(interp,
                            "db rename: illegal environment",
                            TCL_STATIC);
                        return (TCL_ERROR);
                  }
                  break;
            case TCL_DBMV_ENDARG:
                  endarg = 1;
                  break;
            }
            /*
             * If, at any time, parsing the args we get an error,
             * bail out and return.
             */
            if (result != TCL_OK)
                  goto error;
            if (endarg)
                  break;
      }
      if (result != TCL_OK)
            goto error;
      /*
       * Any args we have left, (better be 2 or 3 left) are
       * file names. If there is 2, a file name, if 3 a file and db name.
       */
      if ((i != (objc - 2)) || (i != (objc - 3))) {
            /*
             * Dbs must be NULL terminated file names, but subdbs can
             * be anything.  Use Strings for the db name and byte
             * arrays for the subdb.
             */
            db = Tcl_GetStringFromObj(objv[i++], NULL);
            if (i == objc - 2) {
                  subdbtmp =
                      Tcl_GetByteArrayFromObj(objv[i++], &subdblen);
                  if ((ret = __os_malloc(envp, subdblen + 1,
                      NULL, &subdb)) != 0) {
                        Tcl_SetResult(interp,
                            db_strerror(ret), TCL_STATIC);
                        return (0);
                  }
                  memcpy(subdb, subdbtmp, subdblen);
                  subdb[subdblen] = '\0';
            }
            subdbtmp =
                Tcl_GetByteArrayFromObj(objv[i++], &newlen);
            if ((ret = __os_malloc(envp, newlen + 1,
                NULL, &newname)) != 0) {
                  Tcl_SetResult(interp,
                      db_strerror(ret), TCL_STATIC);
                  return (0);
            }
            memcpy(newname, subdbtmp, newlen);
            newname[newlen] = '\0';
      } else {
            Tcl_WrongNumArgs(interp, 3, objv, "?args? filename ?database? ?newname?");
            result = TCL_ERROR;
            goto error;
      }
      ret = db_create(&dbp, envp, 0);
      if (ret) {
            result = _ReturnSetup(interp, ret, "db_create");
            goto error;
      }
      /*
       * No matter what, we NULL out dbp after this call.
       */
      ret = dbp->rename(dbp, db, subdb, newname, 0);
      result = _ReturnSetup(interp, ret, "db rename");
      dbp = NULL;
error:
      if (subdb)
            __os_free(subdb, subdblen + 1);
      if (newname)
            __os_free(newname, newlen + 1);
      if (result == TCL_ERROR && dbp)
            (void)dbp->close(dbp, 0);
      return (result);
}

/*
 * bdb_DbVerify --
 *    Implements the DB->verify command.
 */
static int
bdb_DbVerify(interp, objc, objv)
      Tcl_Interp *interp;           /* Interpreter */
      int objc;               /* How many arguments? */
      Tcl_Obj *CONST objv[];        /* The argument objects */
{
      static char *bdbverify[] = {
            "-env",     "-errfile", "-errpfx", "--", NULL
      };
      enum bdbvrfy {
            TCL_DBVRFY_ENV,
            TCL_DBVRFY_ERRFILE,
            TCL_DBVRFY_ERRPFX,
            TCL_DBVRFY_ENDARG
      };
      DB_ENV *envp;
      DB *dbp;
      FILE *errf;
      int endarg, i, optindex, result, ret, flags;
      char *arg, *db, *errpfx;

      envp = NULL;
      dbp = NULL;
      result = TCL_OK;
      db = errpfx = NULL;
      errf = NULL;
      flags = endarg = 0;

      if (objc < 2) {
            Tcl_WrongNumArgs(interp, 2, objv, "?args? filename");
            return (TCL_ERROR);
      }

      /*
       * We must first parse for the environment flag, since that
       * is needed for db_create.  Then create the db handle.
       */
      i = 2;
      while (i < objc) {
            if (Tcl_GetIndexFromObj(interp, objv[i], bdbverify,
                "option", TCL_EXACT, &optindex) != TCL_OK) {
                  arg = Tcl_GetStringFromObj(objv[i], NULL);
                  if (arg[0] == '-') {
                        result = IS_HELP(objv[i]);
                        goto error;
                  } else
                        Tcl_ResetResult(interp);
                  break;
            }
            i++;
            switch ((enum bdbvrfy)optindex) {
            case TCL_DBVRFY_ENV:
                  arg = Tcl_GetStringFromObj(objv[i++], NULL);
                  envp = NAME_TO_ENV(arg);
                  if (envp == NULL) {
                        Tcl_SetResult(interp,
                            "db verify: illegal environment",
                            TCL_STATIC);
                        result = TCL_ERROR;
                        break;
                  }
                  break;
            case TCL_DBVRFY_ERRFILE:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "-errfile file");
                        result = TCL_ERROR;
                        break;
                  }
                  arg = Tcl_GetStringFromObj(objv[i++], NULL);
                  /*
                   * If the user already set one, close it.
                   */
                  if (errf != NULL)
                        fclose(errf);
                  errf = fopen(arg, "a");
                  break;
            case TCL_DBVRFY_ERRPFX:
                  if (i >= objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "-errpfx prefix");
                        result = TCL_ERROR;
                        break;
                  }
                  arg = Tcl_GetStringFromObj(objv[i++], NULL);
                  /*
                   * If the user already set one, free it.
                   */
                  if (errpfx != NULL)
                        __os_freestr(errpfx);
                  if ((ret = __os_strdup(NULL, arg, &errpfx)) != 0) {
                        result = _ReturnSetup(interp, ret,
                            "__os_strdup");
                        break;
                  }
                  break;
            case TCL_DBVRFY_ENDARG:
                  endarg = 1;
                  break;
            }
            /*
             * If, at any time, parsing the args we get an error,
             * bail out and return.
             */
            if (result != TCL_OK)
                  goto error;
            if (endarg)
                  break;
      }
      if (result != TCL_OK)
            goto error;
      /*
       * The remaining arg is the db filename.
       */
      if (i == (objc - 1))
            db = Tcl_GetStringFromObj(objv[i++], NULL);
      else {
            Tcl_WrongNumArgs(interp, 2, objv, "?args? filename");
            result = TCL_ERROR;
            goto error;
      }
      ret = db_create(&dbp, envp, 0);
      if (ret) {
            result = _ReturnSetup(interp, ret, "db_create");
            goto error;
      }

      if (errf != NULL)
            dbp->set_errfile(dbp, errf);
      if (errpfx != NULL)
            dbp->set_errpfx(dbp, errpfx);

      ret = dbp->verify(dbp, db, NULL, NULL, flags);
      result = _ReturnSetup(interp, ret, "db verify");
error:
      if (errf != NULL)
            fclose(errf);
      if (errpfx != NULL)
            __os_freestr(errpfx);
      if (dbp)
            (void)dbp->close(dbp, 0);
      return (result);
}

/*
 * bdb_Version --
 *    Implements the version command.
 */
static int
bdb_Version(interp, objc, objv)
      Tcl_Interp *interp;           /* Interpreter */
      int objc;               /* How many arguments? */
      Tcl_Obj *CONST objv[];        /* The argument objects */
{
      static char *bdbver[] = {
            "-string", NULL
      };
      enum bdbver {
            TCL_VERSTRING
      };
      int i, optindex, maj, min, patch, result, string, verobjc;
      char *arg, *v;
      Tcl_Obj *res, *verobjv[3];

      result = TCL_OK;
      string = 0;

      if (objc < 2) {
            Tcl_WrongNumArgs(interp, 2, objv, "?args?");
            return (TCL_ERROR);
      }

      /*
       * We must first parse for the environment flag, since that
       * is needed for db_create.  Then create the db handle.
       */
      i = 2;
      while (i < objc) {
            if (Tcl_GetIndexFromObj(interp, objv[i], bdbver,
                "option", TCL_EXACT, &optindex) != TCL_OK) {
                  arg = Tcl_GetStringFromObj(objv[i], NULL);
                  if (arg[0] == '-') {
                        result = IS_HELP(objv[i]);
                        goto error;
                  } else
                        Tcl_ResetResult(interp);
                  break;
            }
            i++;
            switch ((enum bdbver)optindex) {
            case TCL_VERSTRING:
                  string = 1;
                  break;
            }
            /*
             * If, at any time, parsing the args we get an error,
             * bail out and return.
             */
            if (result != TCL_OK)
                  goto error;
      }
      if (result != TCL_OK)
            goto error;

      v = db_version(&maj, &min, &patch);
      if (string)
            res = Tcl_NewStringObj(v, strlen(v));
      else {
            verobjc = 3;
            verobjv[0] = Tcl_NewIntObj(maj);
            verobjv[1] = Tcl_NewIntObj(min);
            verobjv[2] = Tcl_NewIntObj(patch);
            res = Tcl_NewListObj(verobjc, verobjv);
      }
      Tcl_SetObjResult(interp, res);
error:
      return (result);
}

/*
 * bdb_Handles --
 *    Implements the handles command.
 */
static int
bdb_Handles(interp, objc, objv)
      Tcl_Interp *interp;           /* Interpreter */
      int objc;               /* How many arguments? */
      Tcl_Obj *CONST objv[];        /* The argument objects */
{
      DBTCL_INFO *p;
      Tcl_Obj *res, *handle;

      /*
       * No args.  Error if we have some
       */
      if (objc != 2) {
            Tcl_WrongNumArgs(interp, 2, objv, "");
            return (TCL_ERROR);
      }
      res = Tcl_NewListObj(0, NULL);

      for (p = LIST_FIRST(&__db_infohead); p != NULL;
          p = LIST_NEXT(p, entries)) {
            handle = Tcl_NewStringObj(p->i_name, strlen(p->i_name));
            if (Tcl_ListObjAppendElement(interp, res, handle) != TCL_OK)
                  return (TCL_ERROR);
      }
      Tcl_SetObjResult(interp, res);
      return (TCL_OK);
}

/*
 * bdb_DbUpgrade --
 *    Implements the DB->upgrade command.
 */
static int
bdb_DbUpgrade(interp, objc, objv)
      Tcl_Interp *interp;           /* Interpreter */
      int objc;               /* How many arguments? */
      Tcl_Obj *CONST objv[];        /* The argument objects */
{
      static char *bdbupg[] = {
            "-dupsort", "-env", "--", NULL
      };
      enum bdbupg {
            TCL_DBUPG_DUPSORT,
            TCL_DBUPG_ENV,
            TCL_DBUPG_ENDARG
      };
      DB_ENV *envp;
      DB *dbp;
      int endarg, i, optindex, result, ret, flags;
      char *arg, *db;

      envp = NULL;
      dbp = NULL;
      result = TCL_OK;
      db = NULL;
      flags = endarg = 0;

      if (objc < 2) {
            Tcl_WrongNumArgs(interp, 2, objv, "?args? filename");
            return (TCL_ERROR);
      }

      i = 2;
      while (i < objc) {
            if (Tcl_GetIndexFromObj(interp, objv[i], bdbupg,
                "option", TCL_EXACT, &optindex) != TCL_OK) {
                  arg = Tcl_GetStringFromObj(objv[i], NULL);
                  if (arg[0] == '-') {
                        result = IS_HELP(objv[i]);
                        goto error;
                  } else
                        Tcl_ResetResult(interp);
                  break;
            }
            i++;
            switch ((enum bdbupg)optindex) {
            case TCL_DBUPG_DUPSORT:
                  flags |= DB_DUPSORT;
                  break;
            case TCL_DBUPG_ENV:
                  arg = Tcl_GetStringFromObj(objv[i++], NULL);
                  envp = NAME_TO_ENV(arg);
                  if (envp == NULL) {
                        Tcl_SetResult(interp,
                            "db upgrade: illegal environment",
                            TCL_STATIC);
                        return (TCL_ERROR);
                  }
                  break;
            case TCL_DBUPG_ENDARG:
                  endarg = 1;
                  break;
            }
            /*
             * If, at any time, parsing the args we get an error,
             * bail out and return.
             */
            if (result != TCL_OK)
                  goto error;
            if (endarg)
                  break;
      }
      if (result != TCL_OK)
            goto error;
      /*
       * The remaining arg is the db filename.
       */
      if (i == (objc - 1))
            db = Tcl_GetStringFromObj(objv[i++], NULL);
      else {
            Tcl_WrongNumArgs(interp, 2, objv, "?args? filename");
            result = TCL_ERROR;
            goto error;
      }
      ret = db_create(&dbp, envp, 0);
      if (ret) {
            result = _ReturnSetup(interp, ret, "db_create");
            goto error;
      }

      ret = dbp->upgrade(dbp, db, flags);
      result = _ReturnSetup(interp, ret, "db upgrade");
error:
      if (dbp)
            (void)dbp->close(dbp, 0);
      return (result);
}

Generated by  Doxygen 1.6.0   Back to index