开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 数据库系统 > MySQL数据库 > 查看源码
tcl_db_pkg.c
资源名称：mysql-3.23.35.tar.gz　[点击查看]
上传用户：tsgydb
上传日期：2007-04-14
资源大小：10674k
文件大小：53k
源码类别：

MySQL数据库

开发平台：

Visual C++

tcl_db_pkg.c：源码内容
  1. /*-
  2.  * See the file LICENSE for redistribution information.
  3.  *
  4.  * Copyright (c) 1999, 2000
  5.  * Sleepycat Software.  All rights reserved.
  6.  */
  8. #include "db_config.h"
  10. #ifndef lint
  11. static const char revid[] = "$Id: tcl_db_pkg.c,v 11.76 2001/01/19 18:02:36 bostic Exp $";
  12. #endif /* not lint */
  14. #ifndef NO_SYSTEM_INCLUDES
  15. #include <sys/types.h>
  17. #include <stdlib.h>
  18. #include <string.h>
  19. #include <tcl.h>
  20. #endif
  22. #define DB_DBM_HSEARCH 1
  24. #include "db_int.h"
  25. #include "tcl_db.h"
  27. /*
  28.  * Prototypes for procedures defined later in this file:
  29.  */
  30. static int berkdb_Cmd __P((ClientData, Tcl_Interp *, int,
  31.     Tcl_Obj * CONST*));
  32. static int bdb_EnvOpen __P((Tcl_Interp *, int, Tcl_Obj * CONST*,
  33.     DBTCL_INFO *, DB_ENV **));
  34. static int bdb_DbOpen __P((Tcl_Interp *, int, Tcl_Obj * CONST*,
  35.     DBTCL_INFO *, DB **));
  36. static int bdb_DbRemove __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
  37. static int bdb_DbRename __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
  38. static int bdb_DbUpgrade __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
  39. static int bdb_DbVerify __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
  40. static int bdb_Version __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
  41. static int bdb_Handles __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
  43. /*
  44.  * Db_tcl_Init --
  45.  *
  46.  * This is a package initialization procedure, which is called by Tcl when
  47.  * this package is to be added to an interpreter.  The name is based on the
  48.  * name of the shared library, currently libdb_tcl-X.Y.so, which Tcl uses
  49.  * to determine the name of this function.
  50.  */
  51. int
  52. Db_tcl_Init(interp)
  53. Tcl_Interp *interp; /* Interpreter in which the package is
  54.  * to be made available. */
  55. {
  56. int code;
  58. code = Tcl_PkgProvide(interp, "Db_tcl", "1.0");
  59. if (code != TCL_OK)
  60. return (code);
  62. Tcl_CreateObjCommand(interp, "berkdb", (Tcl_ObjCmdProc *)berkdb_Cmd,
  63.     (ClientData)0, NULL);
  64. /*
  65.  * Create shared global debugging variables
  66.  */
  67. Tcl_LinkVar(interp, "__debug_on", (char *)&__debug_on, TCL_LINK_INT);
  68. Tcl_LinkVar(interp, "__debug_print", (char *)&__debug_print,
  69.     TCL_LINK_INT);
  70. Tcl_LinkVar(interp, "__debug_stop", (char *)&__debug_stop,
  71.     TCL_LINK_INT);
  72. Tcl_LinkVar(interp, "__debug_test", (char *)&__debug_test,
  73.     TCL_LINK_INT);
  74. LIST_INIT(&__db_infohead);
  75. return (TCL_OK);
  76. }
  78. /*
  79.  * berkdb_cmd --
  80.  * Implements the "berkdb" command.
  81.  * This command supports three sub commands:
  82.  * berkdb version - Returns a list {major minor patch}
  83.  * berkdb env - Creates a new DB_ENV and returns a binding
  84.  *   to a new command of the form dbenvX, where X is an
  85.  *   integer starting at 0 (dbenv0, dbenv1, ...)
  86.  * berkdb open - Creates a new DB (optionally within
  87.  *   the given environment.  Returns a binding to a new
  88.  *   command of the form dbX, where X is an integer
  89.  *   starting at 0 (db0, db1, ...)
  90.  */
  91. static int
  92. berkdb_Cmd(notused, interp, objc, objv)
  93. ClientData notused; /* Not used. */
  94. Tcl_Interp *interp; /* Interpreter */
  95. int objc; /* How many arguments? */
  96. Tcl_Obj *CONST objv[]; /* The argument objects */
  97. {
  98. static char *berkdbcmds[] = {
  99. "dbremove",
  100. "dbrename",
  101. "dbverify",
  102. "env",
  103. "envremove",
  104. "handles",
  105. "open",
  106. "upgrade",
  107. "version",
  108. /* All below are compatibility functions */
  109. "hcreate", "hsearch", "hdestroy",
  110. "dbminit", "fetch", "store",
  111. "delete", "firstkey", "nextkey",
  112. "ndbm_open", "dbmclose",
  113. /* All below are convenience functions */
  114. "rand", "random_int", "srand",
  115. "debug_check",
  116. NULL
  117. };
  118. /*
  119.  * All commands enums below ending in X are compatibility
  120.  */
  121. enum berkdbcmds {
  122. BDB_DBREMOVE,
  123. BDB_DBRENAME,
  124. BDB_DBVERIFY,
  125. BDB_ENV,
  126. BDB_ENVREMOVE,
  127. BDB_HANDLES,
  128. BDB_OPEN,
  129. BDB_UPGRADE,
  130. BDB_VERSION,
  131. BDB_HCREATEX, BDB_HSEARCHX, BDB_HDESTROYX,
  132. BDB_DBMINITX, BDB_FETCHX, BDB_STOREX,
  133. BDB_DELETEX, BDB_FIRSTKEYX, BDB_NEXTKEYX,
  134. BDB_NDBMOPENX, BDB_DBMCLOSEX,
  135. BDB_RANDX, BDB_RAND_INTX, BDB_SRANDX,
  136. BDB_DBGCKX
  137. };
  138. static int env_id = 0;
  139. static int db_id = 0;
  140. static int ndbm_id = 0;
  142. DB *dbp;
  143. DBM *ndbmp;
  144. DBTCL_INFO *ip;
  145. DB_ENV *envp;
  146. Tcl_Obj *res;
  147. int cmdindex, result;
  148. char newname[MSG_SIZE];
  150. COMPQUIET(notused, NULL);
  152. Tcl_ResetResult(interp);
  153. memset(newname, 0, MSG_SIZE);
  154. result = TCL_OK;
  155. if (objc <= 1) {
  156. Tcl_WrongNumArgs(interp, 1, objv, "command cmdargs");
  157. return (TCL_ERROR);
  158. }
  160. /*
  161.  * Get the command name index from the object based on the berkdbcmds
  162.  * defined above.
  163.  */
  164. if (Tcl_GetIndexFromObj(interp,
  165.     objv[1], berkdbcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
  166. return (IS_HELP(objv[1]));
  167. res = NULL;
  168. switch ((enum berkdbcmds)cmdindex) {
  169. case BDB_VERSION:
  170. _debug_check();
  171. result = bdb_Version(interp, objc, objv);
  172. break;
  173. case BDB_HANDLES:
  174. result = bdb_Handles(interp, objc, objv);
  175. break;
  176. case BDB_ENV:
  177. snprintf(newname, sizeof(newname), "env%d", env_id);
  178. ip = _NewInfo(interp, NULL, newname, I_ENV);
  179. if (ip != NULL) {
  180. result = bdb_EnvOpen(interp, objc, objv, ip, &envp);
  181. if (result == TCL_OK && envp != NULL) {
  182. env_id++;
  183. Tcl_CreateObjCommand(interp, newname,
  184.     (Tcl_ObjCmdProc *)env_Cmd,
  185.     (ClientData)envp, NULL);
  186. /* Use ip->i_name - newname is overwritten */
  187. res =
  188.     Tcl_NewStringObj(newname, strlen(newname));
  189. _SetInfoData(ip, envp);
  190. } else
  191. _DeleteInfo(ip);
  192. } else {
  193. Tcl_SetResult(interp, "Could not set up info",
  194.     TCL_STATIC);
  195. result = TCL_ERROR;
  196. }
  197. break;
  198. case BDB_DBREMOVE:
  199. result = bdb_DbRemove(interp, objc, objv);
  200. break;
  201. case BDB_DBRENAME:
  202. result = bdb_DbRename(interp, objc, objv);
  203. break;
  204. case BDB_UPGRADE:
  205. result = bdb_DbUpgrade(interp, objc, objv);
  206. break;
  207. case BDB_DBVERIFY:
  208. result = bdb_DbVerify(interp, objc, objv);
  209. break;
  210. case BDB_ENVREMOVE:
  211. result = tcl_EnvRemove(interp, objc, objv, NULL, NULL);
  212. break;
  213. case BDB_OPEN:
  214. snprintf(newname, sizeof(newname), "db%d", db_id);
  215. ip = _NewInfo(interp, NULL, newname, I_DB);
  216. if (ip != NULL) {
  217. result = bdb_DbOpen(interp, objc, objv, ip, &dbp);
  218. if (result == TCL_OK && dbp != NULL) {
  219. db_id++;
  220. Tcl_CreateObjCommand(interp, newname,
  221.     (Tcl_ObjCmdProc *)db_Cmd,
  222.     (ClientData)dbp, NULL);
  223. /* Use ip->i_name - newname is overwritten */
  224. res =
  225.     Tcl_NewStringObj(newname, strlen(newname));
  226. _SetInfoData(ip, dbp);
  227. } else
  228. _DeleteInfo(ip);
  229. } else {
  230. Tcl_SetResult(interp, "Could not set up info",
  231.     TCL_STATIC);
  232. result = TCL_ERROR;
  233. }
  234. break;
  235. case BDB_HCREATEX:
  236. case BDB_HSEARCHX:
  237. case BDB_HDESTROYX:
  238. result = bdb_HCommand(interp, objc, objv);
  239. break;
  240. case BDB_DBMINITX:
  241. case BDB_DBMCLOSEX:
  242. case BDB_FETCHX:
  243. case BDB_STOREX:
  244. case BDB_DELETEX:
  245. case BDB_FIRSTKEYX:
  246. case BDB_NEXTKEYX:
  247. result = bdb_DbmCommand(interp, objc, objv, DBTCL_DBM, NULL);
  248. break;
  249. case BDB_NDBMOPENX:
  250. snprintf(newname, sizeof(newname), "ndbm%d", ndbm_id);
  251. ip = _NewInfo(interp, NULL, newname, I_NDBM);
  252. if (ip != NULL) {
  253. result = bdb_NdbmOpen(interp, objc, objv, &ndbmp);
  254. if (result == TCL_OK) {
  255. ndbm_id++;
  256. Tcl_CreateObjCommand(interp, newname,
  257.     (Tcl_ObjCmdProc *)ndbm_Cmd,
  258.     (ClientData)ndbmp, NULL);
  259. /* Use ip->i_name - newname is overwritten */
  260. res =
  261.     Tcl_NewStringObj(newname, strlen(newname));
  262. _SetInfoData(ip, ndbmp);
  263. } else
  264. _DeleteInfo(ip);
  265. } else {
  266. Tcl_SetResult(interp, "Could not set up info",
  267.     TCL_STATIC);
  268. result = TCL_ERROR;
  269. }
  270. break;
  271. case BDB_RANDX:
  272. case BDB_RAND_INTX:
  273. case BDB_SRANDX:
  274. result = bdb_RandCommand(interp, objc, objv);
  275. break;
  276. case BDB_DBGCKX:
  277. _debug_check();
  278. res = Tcl_NewIntObj(0);
  279. break;
  280. }
  281. /*
  282.  * For each different arg call different function to create
  283.  * new commands (or if version, get/return it).
  284.  */
  285. if (result == TCL_OK && res != NULL)
  286. Tcl_SetObjResult(interp, res);
  287. return (result);
  288. }
  290. /*
  291.  * bdb_EnvOpen -
  292.  * Implements the environment open command.
  293.  * There are many, many options to the open command.
  294.  * Here is the general flow:
  295.  *
  296.  * 1.  Call db_env_create to create the env handle.
  297.  * 2.  Parse args tracking options.
  298.  * 3.  Make any pre-open setup calls necessary.
  299.  * 4.  Call DBENV->open to open the env.
  300.  * 5.  Return env widget handle to user.
  301.  */
  302. static int
  303. bdb_EnvOpen(interp, objc, objv, ip, env)
  304. Tcl_Interp *interp; /* Interpreter */
  305. int objc; /* How many arguments? */
  306. Tcl_Obj *CONST objv[]; /* The argument objects */
  307. DBTCL_INFO *ip; /* Our internal info */
  308. DB_ENV **env; /* Environment pointer */
  309. {
  310. static char *envopen[] = {
  311. "-cachesize",
  312. "-cdb",
  313. "-cdb_alldb",
  314. "-client_timeout",
  315. "-create",
  316. "-data_dir",
  317. "-errfile",
  318. "-errpfx",
  319. "-home",
  320. "-lock",
  321. "-lock_conflict",
  322. "-lock_detect",
  323. "-lock_max",
  324. "-lock_max_locks",
  325. "-lock_max_lockers",
  326. "-lock_max_objects",
  327. "-log",
  328. "-log_buffer",
  329. "-log_dir",
  330. "-log_max",
  331. "-mmapsize",
  332. "-mode",
  333. "-nommap",
  334. "-private",
  335. "-recover",
  336. "-recover_fatal",
  337. "-region_init",
  338. "-server",
  339. "-server_timeout",
  340. "-shm_key",
  341. "-system_mem",
  342. "-tmp_dir",
  343. "-txn",
  344. "-txn_max",
  345. "-txn_timestamp",
  346. "-use_environ",
  347. "-use_environ_root",
  348. "-verbose",
  349. NULL
  350. };
  351. /*
  352.  * !!!
  353.  * These have to be in the same order as the above,
  354.  * which is close to but not quite alphabetical.
  355.  */
  356. enum envopen {
  357. ENV_CACHESIZE,
  358. ENV_CDB,
  359. ENV_CDB_ALLDB,
  360. ENV_CLIENT_TO,
  361. ENV_CREATE,
  362. ENV_DATA_DIR,
  363. ENV_ERRFILE,
  364. ENV_ERRPFX,
  365. ENV_HOME,
  366. ENV_LOCK,
  367. ENV_CONFLICT,
  368. ENV_DETECT,
  369. ENV_LOCK_MAX,
  370. ENV_LOCK_MAX_LOCKS,
  371. ENV_LOCK_MAX_LOCKERS,
  372. ENV_LOCK_MAX_OBJECTS,
  373. ENV_LOG,
  374. ENV_LOG_BUFFER,
  375. ENV_LOG_DIR,
  376. ENV_LOG_MAX,
  377. ENV_MMAPSIZE,
  378. ENV_MODE,
  379. ENV_NOMMAP,
  380. ENV_PRIVATE,
  381. ENV_RECOVER,
  382. ENV_RECOVER_FATAL,
  383. ENV_REGION_INIT,
  384. ENV_SERVER,
  385. ENV_SERVER_TO,
  386. ENV_SHM_KEY,
  387. ENV_SYSTEM_MEM,
  388. ENV_TMP_DIR,
  389. ENV_TXN,
  390. ENV_TXN_MAX,
  391. ENV_TXN_TIME,
  392. ENV_USE_ENVIRON,
  393. ENV_USE_ENVIRON_ROOT,
  394. ENV_VERBOSE
  395. };
  396. Tcl_Obj **myobjv, **myobjv1;
  397. time_t time;
  398. u_int32_t detect, gbytes, bytes, ncaches, open_flags, set_flag, size;
  399. u_int8_t *conflicts;
  400. int i, intarg, itmp, j, logbufset, logmaxset;
  401. int mode, myobjc, nmodes, optindex, result, ret, temp;
  402. long client_to, server_to, shm;
  403. char *arg, *home, *server;
  405. result = TCL_OK;
  406. mode = 0;
  407. set_flag = 0;
  408. home = NULL;
  409. /*
  410.  * XXX
  411.  * If/when our Tcl interface becomes thread-safe, we should enable
  412.  * DB_THREAD here.  Note that DB_THREAD currently does not work
  413.  * with log_get -next, -prev;  if we wish to enable DB_THREAD,
  414.  * those must either be made thread-safe first or we must come up with
  415.  * a workaround.  (We used to specify DB_THREAD if and only if
  416.  * logging was not configured.)
  417.  */
  418. open_flags = DB_JOINENV;
  419. logmaxset = logbufset = 0;
  421. if (objc <= 2) {
  422. Tcl_WrongNumArgs(interp, 2, objv, "?args?");
  423. return (TCL_ERROR);
  424. }
  426. /*
  427.  * Server code must go before the call to db_env_create.
  428.  */
  429. server = NULL;
  430. server_to = client_to = 0;
  431. i = 2;
  432. while (i < objc) {
  433. if (Tcl_GetIndexFromObj(interp, objv[i++], envopen, "option",
  434.     TCL_EXACT, &optindex) != TCL_OK) {
  435. Tcl_ResetResult(interp);
  436. continue;
  437. }
  438. switch ((enum envopen)optindex) {
  439. case ENV_SERVER:
  440. if (i >= objc) {
  441. Tcl_WrongNumArgs(interp, 2, objv,
  442.     "?-server hostname");
  443. result = TCL_ERROR;
  444. break;
  445. }
  446. server = Tcl_GetStringFromObj(objv[i++], NULL);
  447. break;
  448. case ENV_SERVER_TO:
  449. if (i >= objc) {
  450. Tcl_WrongNumArgs(interp, 2, objv,
  451.     "?-server_to secs");
  452. result = TCL_ERROR;
  453. break;
  454. }
  455. result = Tcl_GetLongFromObj(interp, objv[i++],
  456.     &server_to);
  457. break;
  458. case ENV_CLIENT_TO:
  459. if (i >= objc) {
  460. Tcl_WrongNumArgs(interp, 2, objv,
  461.     "?-client_to secs");
  462. result = TCL_ERROR;
  463. break;
  464. }
  465. result = Tcl_GetLongFromObj(interp, objv[i++],
  466.     &client_to);
  467. break;
  468. default:
  469. break;
  470. }
  471. }
  472. if (server != NULL) {
  473. ret = db_env_create(env, DB_CLIENT);
  474. if (ret)
  475. return (_ReturnSetup(interp, ret, "db_env_create"));
  476. (*env)->set_errpfx((*env), ip->i_name);
  477. (*env)->set_errcall((*env), _ErrorFunc);
  478. if ((ret = (*env)->set_server((*env), server,
  479.     client_to, server_to, 0)) != 0) {
  480. result = TCL_ERROR;
  481. goto error;
  482. }
  483. } else {
  484. /*
  485.  * Create the environment handle before parsing the args
  486.  * since we'll be modifying the environment as we parse.
  487.  */
  488. ret = db_env_create(env, 0);
  489. if (ret)
  490. return (_ReturnSetup(interp, ret, "db_env_create"));
  491. (*env)->set_errpfx((*env), ip->i_name);
  492. (*env)->set_errcall((*env), _ErrorFunc);
  493. }
  495. /*
  496.  * Get the command name index from the object based on the bdbcmds
  497.  * defined above.
  498.  */
  499. i = 2;
  500. while (i < objc) {
  501. if (Tcl_GetIndexFromObj(interp, objv[i], envopen, "option",
  502.     TCL_EXACT, &optindex) != TCL_OK) {
  503. result = IS_HELP(objv[i]);
  504. goto error;
  505. }
  506. i++;
  507. switch ((enum envopen)optindex) {
  508. case ENV_SERVER:
  509. case ENV_SERVER_TO:
  510. case ENV_CLIENT_TO:
  511. /*
  512.  * Already handled these, skip them and their arg.
  513.  */
  514. i++;
  515. break;
  516. case ENV_CDB:
  517. FLD_SET(open_flags, DB_INIT_CDB | DB_INIT_MPOOL);
  518. FLD_CLR(open_flags, DB_JOINENV);
  519. break;
  520. case ENV_CDB_ALLDB:
  521. FLD_SET(set_flag, DB_CDB_ALLDB);
  522. break;
  523. case ENV_LOCK:
  524. FLD_SET(open_flags, DB_INIT_LOCK | DB_INIT_MPOOL);
  525. FLD_CLR(open_flags, DB_JOINENV);
  526. break;
  527. case ENV_LOG:
  528. FLD_SET(open_flags, DB_INIT_LOG | DB_INIT_MPOOL);
  529. FLD_CLR(open_flags, DB_JOINENV);
  530. break;
  531. case ENV_TXN:
  532. FLD_SET(open_flags, DB_INIT_LOCK |
  533.     DB_INIT_LOG | DB_INIT_MPOOL | DB_INIT_TXN);
  534. FLD_CLR(open_flags, DB_JOINENV);
  535. /* Make sure we have an arg to check against! */
  536. if (i < objc) {
  537. arg = Tcl_GetStringFromObj(objv[i], NULL);
  538. if (strcmp(arg, "nosync") == 0) {
  539. FLD_SET(set_flag, DB_TXN_NOSYNC);
  540. i++;
  541. }
  542. }
  543. break;
  544. case ENV_CREATE:
  545. FLD_SET(open_flags, DB_CREATE | DB_INIT_MPOOL);
  546. FLD_CLR(open_flags, DB_JOINENV);
  547. break;
  548. case ENV_HOME:
  549. /* Make sure we have an arg to check against! */
  550. if (i >= objc) {
  551. Tcl_WrongNumArgs(interp, 2, objv,
  552.     "?-home dir?");
  553. result = TCL_ERROR;
  554. break;
  555. }
  556. home = Tcl_GetStringFromObj(objv[i++], NULL);
  557. break;
  558. case ENV_MODE:
  559. if (i >= objc) {
  560. Tcl_WrongNumArgs(interp, 2, objv,
  561.     "?-mode mode?");
  562. result = TCL_ERROR;
  563. break;
  564. }
  565. /*
  566.  * Don't need to check result here because
  567.  * if TCL_ERROR, the error message is already
  568.  * set up, and we'll bail out below.  If ok,
  569.  * the mode is set and we go on.
  570.  */
  571. result = Tcl_GetIntFromObj(interp, objv[i++], &mode);
  572. break;
  573. case ENV_NOMMAP:
  574. FLD_SET(set_flag, DB_NOMMAP);
  575. break;
  576. case ENV_PRIVATE:
  577. FLD_SET(open_flags, DB_PRIVATE | DB_INIT_MPOOL);
  578. FLD_CLR(open_flags, DB_JOINENV);
  579. break;
  580. case ENV_RECOVER:
  581. FLD_SET(open_flags, DB_RECOVER);
  582. break;
  583. case ENV_RECOVER_FATAL:
  584. FLD_SET(open_flags, DB_RECOVER_FATAL);
  585. break;
  586. case ENV_SYSTEM_MEM:
  587. FLD_SET(open_flags, DB_SYSTEM_MEM);
  588. break;
  589. case ENV_USE_ENVIRON_ROOT:
  590. FLD_SET(open_flags, DB_USE_ENVIRON_ROOT);
  591. break;
  592. case ENV_USE_ENVIRON:
  593. FLD_SET(open_flags, DB_USE_ENVIRON);
  594. break;
  595. case ENV_VERBOSE:
  596. result = Tcl_ListObjGetElements(interp, objv[i],
  597.     &myobjc, &myobjv);
  598. if (result == TCL_OK)
  599. i++;
  600. else
  601. break;
  602. if (myobjc != 2) {
  603. Tcl_WrongNumArgs(interp, 2, objv,
  604.     "?-verbose {which on|off}?");
  605. result = TCL_ERROR;
  606. break;
  607. }
  608. result = tcl_EnvVerbose(interp, *env,
  609.     myobjv[0], myobjv[1]);
  610. break;
  611. case ENV_REGION_INIT:
  612. _debug_check();
  613. ret = db_env_set_region_init(1);
  614. result = _ReturnSetup(interp, ret, "region_init");
  615. break;
  616. case ENV_CACHESIZE:
  617. result = Tcl_ListObjGetElements(interp, objv[i],
  618.     &myobjc, &myobjv);
  619. if (result == TCL_OK)
  620. i++;
  621. else
  622. break;
  623. j = 0;
  624. if (myobjc != 3) {
  625. Tcl_WrongNumArgs(interp, 2, objv,
  626.     "?-cachesize {gbytes bytes ncaches}?");
  627. result = TCL_ERROR;
  628. break;
  629. }
  630. result = Tcl_GetIntFromObj(interp, myobjv[0], &itmp);
  631. gbytes = itmp;
  632. if (result != TCL_OK)
  633. break;
  634. result = Tcl_GetIntFromObj(interp, myobjv[1], &itmp);
  635. bytes = itmp;
  636. if (result != TCL_OK)
  637. break;
  638. result = Tcl_GetIntFromObj(interp, myobjv[2], &itmp);
  639. ncaches = itmp;
  640. if (result != TCL_OK)
  641. break;
  642. _debug_check();
  643. ret = (*env)->set_cachesize(*env, gbytes, bytes,
  644.     ncaches);
  645. result = _ReturnSetup(interp, ret, "set_cachesize");
  646. break;
  647. case ENV_MMAPSIZE:
  648. if (i >= objc) {
  649. Tcl_WrongNumArgs(interp, 2, objv,
  650.     "?-mmapsize size?");
  651. result = TCL_ERROR;
  652. break;
  653. }
  654. result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
  655. if (result == TCL_OK) {
  656. _debug_check();
  657. ret = (*env)->set_mp_mmapsize(*env,
  658.     (size_t)intarg);
  659. result = _ReturnSetup(interp, ret, "mmapsize");
  660. }
  661. break;
  662. case ENV_SHM_KEY:
  663. if (i >= objc) {
  664. Tcl_WrongNumArgs(interp, 2, objv,
  665.     "?-shm_key key?");
  666. result = TCL_ERROR;
  667. break;
  668. }
  669. result = Tcl_GetLongFromObj(interp, objv[i++], &shm);
  670. if (result == TCL_OK) {
  671. _debug_check();
  672. ret = (*env)->set_shm_key(*env, shm);
  673. result = _ReturnSetup(interp, ret, "shm_key");
  674. }
  675. break;
  676. case ENV_LOG_MAX:
  677. if (i >= objc) {
  678. Tcl_WrongNumArgs(interp, 2, objv,
  679.     "?-log_max max?");
  680. result = TCL_ERROR;
  681. break;
  682. }
  683. result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
  684. if (result == TCL_OK && logbufset) {
  685. _debug_check();
  686. ret = (*env)->set_lg_max(*env,
  687.     (u_int32_t)intarg);
  688. result = _ReturnSetup(interp, ret, "log_max");
  689. logbufset = 0;
  690. } else
  691. logmaxset = intarg;
  692. break;
  693. case ENV_LOG_BUFFER:
  694. if (i >= objc) {
  695. Tcl_WrongNumArgs(interp, 2, objv,
  696.     "?-log_buffer size?");
  697. result = TCL_ERROR;
  698. break;
  699. }
  700. result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
  701. if (result == TCL_OK) {
  702. _debug_check();
  703. ret = (*env)->set_lg_bsize(*env,
  704.     (u_int32_t)intarg);
  705. result = _ReturnSetup(interp, ret, "log_bsize");
  706. logbufset = 1;
  707. if (logmaxset) {
  708. _debug_check();
  709. ret = (*env)->set_lg_max(*env,
  710.     (u_int32_t)logmaxset);
  711. result = _ReturnSetup(interp, ret,
  712.     "log_max");
  713. logmaxset = 0;
  714. logbufset = 0;
  715. }
  716. }
  717. break;
  718. case ENV_CONFLICT:
  719. /*
  720.  * Get conflict list.  List is:
  721.  * {nmodes {matrix}}
  722.  *
  723.  * Where matrix must be nmodes*nmodes big.
  724.  * Set up conflicts array to pass.
  725.  */
  726. result = Tcl_ListObjGetElements(interp, objv[i],
  727.     &myobjc, &myobjv);
  728. if (result == TCL_OK)
  729. i++;
  730. else
  731. break;
  732. if (myobjc != 2) {
  733. Tcl_WrongNumArgs(interp, 2, objv,
  734.     "?-lock_conflict {nmodes {matrix}}?");
  735. result = TCL_ERROR;
  736. break;
  737. }
  738. result = Tcl_GetIntFromObj(interp, myobjv[0], &nmodes);
  739. if (result != TCL_OK)
  740. break;
  741. result = Tcl_ListObjGetElements(interp, myobjv[1],
  742.     &myobjc, &myobjv1);
  743. if (myobjc != (nmodes * nmodes)) {
  744. Tcl_WrongNumArgs(interp, 2, objv,
  745.     "?-lock_conflict {nmodes {matrix}}?");
  746. result = TCL_ERROR;
  747. break;
  748. }
  749. size = sizeof(u_int8_t) * nmodes*nmodes;
  750. ret = __os_malloc(*env, size, NULL, &conflicts);
  751. if (ret != 0) {
  752. result = TCL_ERROR;
  753. break;
  754. }
  755. for (j = 0; j < myobjc; j++) {
  756. result = Tcl_GetIntFromObj(interp, myobjv1[j],
  757.     &temp);
  758. conflicts[j] = temp;
  759. if (result != TCL_OK) {
  760. __os_free(conflicts, size);
  761. break;
  762. }
  763. }
  764. _debug_check();
  765. ret = (*env)->set_lk_conflicts(*env,
  766.     (u_int8_t *)conflicts, nmodes);
  767. __os_free(conflicts, size);
  768. result = _ReturnSetup(interp, ret, "set_lk_conflicts");
  769. break;
  770. case ENV_DETECT:
  771. if (i >= objc) {
  772. Tcl_WrongNumArgs(interp, 2, objv,
  773.     "?-lock_detect policy?");
  774. result = TCL_ERROR;
  775. break;
  776. }
  777. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  778. if (strcmp(arg, "default") == 0)
  779. detect = DB_LOCK_DEFAULT;
  780. else if (strcmp(arg, "oldest") == 0)
  781. detect = DB_LOCK_OLDEST;
  782. else if (strcmp(arg, "youngest") == 0)
  783. detect = DB_LOCK_YOUNGEST;
  784. else if (strcmp(arg, "random") == 0)
  785. detect = DB_LOCK_RANDOM;
  786. else {
  787. Tcl_AddErrorInfo(interp,
  788.     "lock_detect: illegal policy");
  789. result = TCL_ERROR;
  790. break;
  791. }
  792. _debug_check();
  793. ret = (*env)->set_lk_detect(*env, detect);
  794. result = _ReturnSetup(interp, ret, "lock_detect");
  795. break;
  796. case ENV_LOCK_MAX:
  797. case ENV_LOCK_MAX_LOCKS:
  798. case ENV_LOCK_MAX_LOCKERS:
  799. case ENV_LOCK_MAX_OBJECTS:
  800. if (i >= objc) {
  801. Tcl_WrongNumArgs(interp, 2, objv,
  802.     "?-lock_max max?");
  803. result = TCL_ERROR;
  804. break;
  805. }
  806. result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
  807. if (result == TCL_OK) {
  808. _debug_check();
  809. switch ((enum envopen)optindex) {
  810. case ENV_LOCK_MAX:
  811. ret = (*env)->set_lk_max(*env,
  812.     (u_int32_t)intarg);
  813. break;
  814. case ENV_LOCK_MAX_LOCKS:
  815. ret = (*env)->set_lk_max_locks(*env,
  816.     (u_int32_t)intarg);
  817. break;
  818. case ENV_LOCK_MAX_LOCKERS:
  819. ret = (*env)->set_lk_max_lockers(*env,
  820.     (u_int32_t)intarg);
  821. break;
  822. case ENV_LOCK_MAX_OBJECTS:
  823. ret = (*env)->set_lk_max_objects(*env,
  824.      (u_int32_t)intarg);
  825. break;
  826. default:
  827. break;
  828. }
  829. result = _ReturnSetup(interp, ret, "lock_max");
  830. }
  831. break;
  832. case ENV_TXN_MAX:
  833. if (i >= objc) {
  834. Tcl_WrongNumArgs(interp, 2, objv,
  835.     "?-txn_max max?");
  836. result = TCL_ERROR;
  837. break;
  838. }
  839. result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
  840. if (result == TCL_OK) {
  841. _debug_check();
  842. ret = (*env)->set_tx_max(*env,
  843.     (u_int32_t)intarg);
  844. result = _ReturnSetup(interp, ret, "txn_max");
  845. }
  846. break;
  847. case ENV_TXN_TIME:
  848. if (i >= objc) {
  849. Tcl_WrongNumArgs(interp, 2, objv,
  850.     "?-txn_timestamp time?");
  851. result = TCL_ERROR;
  852. break;
  853. }
  854. result = Tcl_GetLongFromObj(interp, objv[i++],
  855.     (long *)&time);
  856. if (result == TCL_OK) {
  857. _debug_check();
  858. ret = (*env)->set_tx_timestamp(*env, &time);
  859. result = _ReturnSetup(interp, ret,
  860.     "txn_timestamp");
  861. }
  862. break;
  863. case ENV_ERRFILE:
  864. if (i >= objc) {
  865. Tcl_WrongNumArgs(interp, 2, objv,
  866.     "-errfile file");
  867. result = TCL_ERROR;
  868. break;
  869. }
  870. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  871. /*
  872.  * If the user already set one, close it.
  873.  */
  874. if (ip->i_err != NULL)
  875. fclose(ip->i_err);
  876. ip->i_err = fopen(arg, "a");
  877. if (ip->i_err != NULL) {
  878. _debug_check();
  879. (*env)->set_errfile(*env, ip->i_err);
  880. }
  881. break;
  882. case ENV_ERRPFX:
  883. if (i >= objc) {
  884. Tcl_WrongNumArgs(interp, 2, objv,
  885.     "-errpfx prefix");
  886. result = TCL_ERROR;
  887. break;
  888. }
  889. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  890. /*
  891.  * If the user already set one, free it.
  892.  */
  893. if (ip->i_errpfx != NULL)
  894. __os_freestr(ip->i_errpfx);
  895. if ((ret =
  896.     __os_strdup(*env, arg, &ip->i_errpfx)) != 0) {
  897. result = _ReturnSetup(interp, ret,
  898.     "__os_strdup");
  899. break;
  900. }
  901. if (ip->i_errpfx != NULL) {
  902. _debug_check();
  903. (*env)->set_errpfx(*env, ip->i_errpfx);
  904. }
  905. break;
  906. case ENV_DATA_DIR:
  907. if (i >= objc) {
  908. Tcl_WrongNumArgs(interp, 2, objv,
  909.     "-data_dir dir");
  910. result = TCL_ERROR;
  911. break;
  912. }
  913. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  914. _debug_check();
  915. ret = (*env)->set_data_dir(*env, arg);
  916. result = _ReturnSetup(interp, ret, "set_data_dir");
  917. break;
  918. case ENV_LOG_DIR:
  919. if (i >= objc) {
  920. Tcl_WrongNumArgs(interp, 2, objv,
  921.     "-log_dir dir");
  922. result = TCL_ERROR;
  923. break;
  924. }
  925. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  926. _debug_check();
  927. ret = (*env)->set_lg_dir(*env, arg);
  928. result = _ReturnSetup(interp, ret, "set_lg_dir");
  929. break;
  930. case ENV_TMP_DIR:
  931. if (i >= objc) {
  932. Tcl_WrongNumArgs(interp, 2, objv,
  933.     "-tmp_dir dir");
  934. result = TCL_ERROR;
  935. break;
  936. }
  937. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  938. _debug_check();
  939. ret = (*env)->set_tmp_dir(*env, arg);
  940. result = _ReturnSetup(interp, ret, "set_tmp_dir");
  941. break;
  942. }
  943. /*
  944.  * If, at any time, parsing the args we get an error,
  945.  * bail out and return.
  946.  */
  947. if (result != TCL_OK)
  948. goto error;
  949. }
  951. /*
  952.  * We have to check this here.  We want to set the log buffer
  953.  * size first, if it is specified.  So if the user did so,
  954.  * then we took care of it above.  But, if we get out here and
  955.  * logmaxset is non-zero, then they set the log_max without
  956.  * resetting the log buffer size, so we now have to do the
  957.  * call to set_lg_max, since we didn't do it above.
  958.  */
  959. if (logmaxset) {
  960. _debug_check();
  961. ret = (*env)->set_lg_max(*env, (u_int32_t)logmaxset);
  962. result = _ReturnSetup(interp, ret, "log_max");
  963. }
  965. if (result != TCL_OK)
  966. goto error;
  968. if (set_flag) {
  969. ret = (*env)->set_flags(*env, set_flag, 1);
  970. result = _ReturnSetup(interp, ret, "set_flags");
  971. if (result == TCL_ERROR)
  972. goto error;
  973. /*
  974.  * If we are successful, clear the result so that the
  975.  * return from set_flags isn't part of the result.
  976.  */
  977. Tcl_ResetResult(interp);
  978. }
  979. /*
  980.  * When we get here, we have already parsed all of our args
  981.  * and made all our calls to set up the environment.  Everything
  982.  * is okay so far, no errors, if we get here.
  983.  *
  984.  * Now open the environment.
  985.  */
  986. _debug_check();
  987. ret = (*env)->open(*env, home, open_flags, mode);
  988. result = _ReturnSetup(interp, ret, "env open");
  990. error:
  991. if (result == TCL_ERROR) {
  992. if (ip->i_err) {
  993. fclose(ip->i_err);
  994. ip->i_err = NULL;
  995. }
  996. (void)(*env)->close(*env, 0);
  997. *env = NULL;
  998. }
  999. return (result);
  1000. }
  1002. /*
  1003.  * bdb_DbOpen --
  1004.  * Implements the "db_create/db_open" command.
  1005.  * There are many, many options to the open command.
  1006.  * Here is the general flow:
  1007.  *
  1008.  * 0.  Preparse args to determine if we have -env.
  1009.  * 1.  Call db_create to create the db handle.
  1010.  * 2.  Parse args tracking options.
  1011.  * 3.  Make any pre-open setup calls necessary.
  1012.  * 4.  Call DB->open to open the database.
  1013.  * 5.  Return db widget handle to user.
  1014.  */
  1015. static int
  1016. bdb_DbOpen(interp, objc, objv, ip, dbp)
  1017. Tcl_Interp *interp; /* Interpreter */
  1018. int objc; /* How many arguments? */
  1019. Tcl_Obj *CONST objv[]; /* The argument objects */
  1020. DBTCL_INFO *ip; /* Our internal info */
  1021. DB **dbp; /* DB handle */
  1022. {
  1023. static char *bdbenvopen[] = {
  1024. "-env", NULL
  1025. };
  1026. enum bdbenvopen {
  1027. TCL_DB_ENV0
  1028. };
  1029. static char *bdbopen[] = {
  1030. "-btree",
  1031. "-cachesize",
  1032. "-create",
  1033. "-delim",
  1034. "-dup",
  1035. "-dupsort",
  1036. "-env",
  1037. "-errfile",
  1038. "-errpfx",
  1039. "-excl",
  1040. "-extent",
  1041. "-ffactor",
  1042. "-hash",
  1043. "-len",
  1044. "-lorder",
  1045. "-minkey",
  1046. "-mode",
  1047. "-nelem",
  1048. "-nommap",
  1049. "-pad",
  1050. "-pagesize",
  1051. "-queue",
  1052. "-rdonly",
  1053. "-recno",
  1054. "-recnum",
  1055. "-renumber",
  1056. "-revsplitoff",
  1057. "-snapshot",
  1058. "-source",
  1059. "-truncate",
  1060. "-test",
  1061. "-unknown",
  1062. "--",
  1063. NULL
  1064. };
  1065. enum bdbopen {
  1066. TCL_DB_BTREE,
  1067. TCL_DB_CACHESIZE,
  1068. TCL_DB_CREATE,
  1069. TCL_DB_DELIM,
  1070. TCL_DB_DUP,
  1071. TCL_DB_DUPSORT,
  1072. TCL_DB_ENV,
  1073. TCL_DB_ERRFILE,
  1074. TCL_DB_ERRPFX,
  1075. TCL_DB_EXCL,
  1076. TCL_DB_EXTENT,
  1077. TCL_DB_FFACTOR,
  1078. TCL_DB_HASH,
  1079. TCL_DB_LEN,
  1080. TCL_DB_LORDER,
  1081. TCL_DB_MINKEY,
  1082. TCL_DB_MODE,
  1083. TCL_DB_NELEM,
  1084. TCL_DB_NOMMAP,
  1085. TCL_DB_PAD,
  1086. TCL_DB_PAGESIZE,
  1087. TCL_DB_QUEUE,
  1088. TCL_DB_RDONLY,
  1089. TCL_DB_RECNO,
  1090. TCL_DB_RECNUM,
  1091. TCL_DB_RENUMBER,
  1092. TCL_DB_REVSPLIT,
  1093. TCL_DB_SNAPSHOT,
  1094. TCL_DB_SOURCE,
  1095. TCL_DB_TRUNCATE,
  1096. TCL_DB_TEST,
  1097. TCL_DB_UNKNOWN,
  1098. TCL_DB_ENDARG
  1099. };
  1101. DBTCL_INFO *envip, *errip;
  1102. DBTYPE type;
  1103. DB_ENV *envp;
  1104. Tcl_Obj **myobjv;
  1105. u_int32_t gbytes, bytes, ncaches, open_flags;
  1106. int endarg, i, intarg, itmp, j, mode, myobjc;
  1107. int optindex, result, ret, set_err, set_flag, set_pfx, subdblen;
  1108. u_char *subdbtmp;
  1109. char *arg, *db, *subdb;
  1110. extern u_int32_t __ham_test __P((DB *, const void *, u_int32_t));
  1112. type = DB_UNKNOWN;
  1113. endarg = mode = set_err = set_flag = set_pfx = 0;
  1114. result = TCL_OK;
  1115. subdbtmp = NULL;
  1116. db = subdb = NULL;
  1118. /*
  1119.  * XXX
  1120.  * If/when our Tcl interface becomes thread-safe, we should enable
  1121.  * DB_THREAD here.  See comment in bdb_EnvOpen().
  1122.  */
  1123. open_flags = 0;
  1124. envp = NULL;
  1126. if (objc < 2) {
  1127. Tcl_WrongNumArgs(interp, 2, objv, "?args?");
  1128. return (TCL_ERROR);
  1129. }
  1131. /*
  1132.  * We must first parse for the environment flag, since that
  1133.  * is needed for db_create.  Then create the db handle.
  1134.  */
  1135. i = 2;
  1136. while (i < objc) {
  1137. if (Tcl_GetIndexFromObj(interp, objv[i++], bdbenvopen,
  1138.     "option", TCL_EXACT, &optindex) != TCL_OK) {
  1139. /*
  1140.  * Reset the result so we don't get
  1141.  * an errant error message if there is another error.
  1142.  */
  1143. Tcl_ResetResult(interp);
  1144. continue;
  1145. }
  1146. switch ((enum bdbenvopen)optindex) {
  1147. case TCL_DB_ENV0:
  1148. arg = Tcl_GetStringFromObj(objv[i], NULL);
  1149. envp = NAME_TO_ENV(arg);
  1150. if (envp == NULL) {
  1151. Tcl_SetResult(interp,
  1152.     "db open: illegal environment", TCL_STATIC);
  1153. return (TCL_ERROR);
  1154. }
  1155. }
  1156. break;
  1157. }
  1159. /*
  1160.  * Create the db handle before parsing the args
  1161.  * since we'll be modifying the database options as we parse.
  1162.  */
  1163. ret = db_create(dbp, envp, 0);
  1164. if (ret)
  1165. return (_ReturnSetup(interp, ret, "db_create"));
  1167. /*
  1168.  * XXX Remove restriction when err stuff is not tied to env.
  1169.  *
  1170.  * The DB->set_err* functions actually overwrite in the
  1171.  * environment.  So, if we are explicitly using an env,
  1172.  * don't overwrite what we have already set up.  If we are
  1173.  * not using one, then we set up since we get a private
  1174.  * default env.
  1175.  */
  1176. /* XXX  - remove this conditional if/when err is not tied to env */
  1177. if (envp == NULL) {
  1178. (*dbp)->set_errpfx((*dbp), ip->i_name);
  1179. (*dbp)->set_errcall((*dbp), _ErrorFunc);
  1180. }
  1181. envip = _PtrToInfo(envp); /* XXX */
  1182. /*
  1183.  * If we are using an env, we keep track of err info in the env's ip.
  1184.  * Otherwise use the DB's ip.
  1185.  */
  1186. if (envip)
  1187. errip = envip;
  1188. else
  1189. errip = ip;
  1190. /*
  1191.  * Get the option name index from the object based on the args
  1192.  * defined above.
  1193.  */
  1194. i = 2;
  1195. while (i < objc) {
  1196. if (Tcl_GetIndexFromObj(interp, objv[i], bdbopen, "option",
  1197.     TCL_EXACT, &optindex) != TCL_OK) {
  1198. arg = Tcl_GetStringFromObj(objv[i], NULL);
  1199. if (arg[0] == '-') {
  1200. result = IS_HELP(objv[i]);
  1201. goto error;
  1202. } else
  1203. Tcl_ResetResult(interp);
  1204. break;
  1205. }
  1206. i++;
  1207. switch ((enum bdbopen)optindex) {
  1208. case TCL_DB_ENV:
  1209. /*
  1210.  * Already parsed this, skip it and the env pointer.
  1211.  */
  1212. i++;
  1213. continue;
  1214. case TCL_DB_BTREE:
  1215. if (type != DB_UNKNOWN) {
  1216. Tcl_SetResult(interp,
  1217.     "Too many DB types specified", TCL_STATIC);
  1218. result = TCL_ERROR;
  1219. goto error;
  1220. }
  1221. type = DB_BTREE;
  1222. break;
  1223. case TCL_DB_HASH:
  1224. if (type != DB_UNKNOWN) {
  1225. Tcl_SetResult(interp,
  1226.     "Too many DB types specified", TCL_STATIC);
  1227. result = TCL_ERROR;
  1228. goto error;
  1229. }
  1230. type = DB_HASH;
  1231. break;
  1232. case TCL_DB_RECNO:
  1233. if (type != DB_UNKNOWN) {
  1234. Tcl_SetResult(interp,
  1235.     "Too many DB types specified", TCL_STATIC);
  1236. result = TCL_ERROR;
  1237. goto error;
  1238. }
  1239. type = DB_RECNO;
  1240. break;
  1241. case TCL_DB_QUEUE:
  1242. if (type != DB_UNKNOWN) {
  1243. Tcl_SetResult(interp,
  1244.     "Too many DB types specified", TCL_STATIC);
  1245. result = TCL_ERROR;
  1246. goto error;
  1247. }
  1248. type = DB_QUEUE;
  1249. break;
  1250. case TCL_DB_UNKNOWN:
  1251. if (type != DB_UNKNOWN) {
  1252. Tcl_SetResult(interp,
  1253.     "Too many DB types specified", TCL_STATIC);
  1254. result = TCL_ERROR;
  1255. goto error;
  1256. }
  1257. break;
  1258. case TCL_DB_CREATE:
  1259. open_flags |= DB_CREATE;
  1260. break;
  1261. case TCL_DB_EXCL:
  1262. open_flags |= DB_EXCL;
  1263. break;
  1264. case TCL_DB_RDONLY:
  1265. open_flags |= DB_RDONLY;
  1266. break;
  1267. case TCL_DB_TRUNCATE:
  1268. open_flags |= DB_TRUNCATE;
  1269. break;
  1270. case TCL_DB_TEST:
  1271. (*dbp)->set_h_hash(*dbp, __ham_test);
  1272. break;
  1273. case TCL_DB_MODE:
  1274. if (i >= objc) {
  1275. Tcl_WrongNumArgs(interp, 2, objv,
  1276.     "?-mode mode?");
  1277. result = TCL_ERROR;
  1278. break;
  1279. }
  1280. /*
  1281.  * Don't need to check result here because
  1282.  * if TCL_ERROR, the error message is already
  1283.  * set up, and we'll bail out below.  If ok,
  1284.  * the mode is set and we go on.
  1285.  */
  1286. result = Tcl_GetIntFromObj(interp, objv[i++], &mode);
  1287. break;
  1288. case TCL_DB_NOMMAP:
  1289. open_flags |= DB_NOMMAP;
  1290. break;
  1291. case TCL_DB_DUP:
  1292. set_flag |= DB_DUP;
  1293. break;
  1294. case TCL_DB_DUPSORT:
  1295. set_flag |= DB_DUPSORT;
  1296. break;
  1297. case TCL_DB_RECNUM:
  1298. set_flag |= DB_RECNUM;
  1299. break;
  1300. case TCL_DB_RENUMBER:
  1301. set_flag |= DB_RENUMBER;
  1302. break;
  1303. case TCL_DB_REVSPLIT:
  1304. set_flag |= DB_REVSPLITOFF;
  1305. break;
  1306. case TCL_DB_SNAPSHOT:
  1307. set_flag |= DB_SNAPSHOT;
  1308. break;
  1309. case TCL_DB_FFACTOR:
  1310. if (i >= objc) {
  1311. Tcl_WrongNumArgs(interp, 2, objv,
  1312.     "-ffactor density");
  1313. result = TCL_ERROR;
  1314. break;
  1315. }
  1316. result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
  1317. if (result == TCL_OK) {
  1318. _debug_check();
  1319. ret = (*dbp)->set_h_ffactor(*dbp,
  1320.     (u_int32_t)intarg);
  1321. result = _ReturnSetup(interp, ret,
  1322.     "set_h_ffactor");
  1323. }
  1324. break;
  1325. case TCL_DB_NELEM:
  1326. if (i >= objc) {
  1327. Tcl_WrongNumArgs(interp, 2, objv,
  1328.     "-nelem nelem");
  1329. result = TCL_ERROR;
  1330. break;
  1331. }
  1332. result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
  1333. if (result == TCL_OK) {
  1334. _debug_check();
  1335. ret = (*dbp)->set_h_nelem(*dbp,
  1336.     (u_int32_t)intarg);
  1337. result = _ReturnSetup(interp, ret,
  1338.     "set_h_nelem");
  1339. }
  1340. break;
  1341. case TCL_DB_LORDER:
  1342. if (i >= objc) {
  1343. Tcl_WrongNumArgs(interp, 2, objv,
  1344.     "-lorder 1234|4321");
  1345. result = TCL_ERROR;
  1346. break;
  1347. }
  1348. result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
  1349. if (result == TCL_OK) {
  1350. _debug_check();
  1351. ret = (*dbp)->set_lorder(*dbp,
  1352.     (u_int32_t)intarg);
  1353. result = _ReturnSetup(interp, ret,
  1354.     "set_lorder");
  1355. }
  1356. break;
  1357. case TCL_DB_DELIM:
  1358. if (i >= objc) {
  1359. Tcl_WrongNumArgs(interp, 2, objv,
  1360.     "-delim delim");
  1361. result = TCL_ERROR;
  1362. break;
  1363. }
  1364. result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
  1365. if (result == TCL_OK) {
  1366. _debug_check();
  1367. ret = (*dbp)->set_re_delim(*dbp, intarg);
  1368. result = _ReturnSetup(interp, ret,
  1369.     "set_re_delim");
  1370. }
  1371. break;
  1372. case TCL_DB_LEN:
  1373. if (i >= objc) {
  1374. Tcl_WrongNumArgs(interp, 2, objv,
  1375.     "-len length");
  1376. result = TCL_ERROR;
  1377. break;
  1378. }
  1379. result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
  1380. if (result == TCL_OK) {
  1381. _debug_check();
  1382. ret = (*dbp)->set_re_len(*dbp,
  1383.     (u_int32_t)intarg);
  1384. result = _ReturnSetup(interp, ret,
  1385.     "set_re_len");
  1386. }
  1387. break;
  1388. case TCL_DB_PAD:
  1389. if (i >= objc) {
  1390. Tcl_WrongNumArgs(interp, 2, objv,
  1391.     "-pad pad");
  1392. result = TCL_ERROR;
  1393. break;
  1394. }
  1395. result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
  1396. if (result == TCL_OK) {
  1397. _debug_check();
  1398. ret = (*dbp)->set_re_pad(*dbp, intarg);
  1399. result = _ReturnSetup(interp, ret,
  1400.     "set_re_pad");
  1401. }
  1402. break;
  1403. case TCL_DB_SOURCE:
  1404. if (i >= objc) {
  1405. Tcl_WrongNumArgs(interp, 2, objv,
  1406.     "-source file");
  1407. result = TCL_ERROR;
  1408. break;
  1409. }
  1410. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  1411. _debug_check();
  1412. ret = (*dbp)->set_re_source(*dbp, arg);
  1413. result = _ReturnSetup(interp, ret, "set_re_source");
  1414. break;
  1415. case TCL_DB_EXTENT:
  1416. if (i >= objc) {
  1417. Tcl_WrongNumArgs(interp, 2, objv,
  1418.     "-extent size");
  1419. result = TCL_ERROR;
  1420. break;
  1421. }
  1422. result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
  1423. if (result == TCL_OK) {
  1424. _debug_check();
  1425. ret = (*dbp)->set_q_extentsize(*dbp,
  1426.     (u_int32_t)intarg);
  1427. result = _ReturnSetup(interp, ret,
  1428.     "set_q_extentsize");
  1429. }
  1430. break;
  1431. case TCL_DB_MINKEY:
  1432. if (i >= objc) {
  1433. Tcl_WrongNumArgs(interp, 2, objv,
  1434.     "-minkey minkey");
  1435. result = TCL_ERROR;
  1436. break;
  1437. }
  1438. result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
  1439. if (result == TCL_OK) {
  1440. _debug_check();
  1441. ret = (*dbp)->set_bt_minkey(*dbp, intarg);
  1442. result = _ReturnSetup(interp, ret,
  1443.     "set_bt_minkey");
  1444. }
  1445. break;
  1446. case TCL_DB_CACHESIZE:
  1447. result = Tcl_ListObjGetElements(interp, objv[i++],
  1448.     &myobjc, &myobjv);
  1449. if (result != TCL_OK)
  1450. break;
  1451. j = 0;
  1452. if (myobjc != 3) {
  1453. Tcl_WrongNumArgs(interp, 2, objv,
  1454.     "?-cachesize {gbytes bytes ncaches}?");
  1455. result = TCL_ERROR;
  1456. break;
  1457. }
  1458. result = Tcl_GetIntFromObj(interp, myobjv[0], &itmp);
  1459. gbytes = itmp;
  1460. if (result != TCL_OK)
  1461. break;
  1462. result = Tcl_GetIntFromObj(interp, myobjv[1], &itmp);
  1463. bytes = itmp;
  1464. if (result != TCL_OK)
  1465. break;
  1466. result = Tcl_GetIntFromObj(interp, myobjv[2], &itmp);
  1467. ncaches = itmp;
  1468. if (result != TCL_OK)
  1469. break;
  1470. _debug_check();
  1471. ret = (*dbp)->set_cachesize(*dbp, gbytes, bytes,
  1472.     ncaches);
  1473. result = _ReturnSetup(interp, ret,
  1474.     "set_cachesize");
  1475. break;
  1476. case TCL_DB_PAGESIZE:
  1477. if (i >= objc) {
  1478. Tcl_WrongNumArgs(interp, 2, objv,
  1479.     "?-pagesize size?");
  1480. result = TCL_ERROR;
  1481. break;
  1482. }
  1483. result = Tcl_GetIntFromObj(interp, objv[i++], &intarg);
  1484. if (result == TCL_OK) {
  1485. _debug_check();
  1486. ret = (*dbp)->set_pagesize(*dbp,
  1487.     (size_t)intarg);
  1488. result = _ReturnSetup(interp, ret,
  1489.     "set pagesize");
  1490. }
  1491. break;
  1492. case TCL_DB_ERRFILE:
  1493. if (i >= objc) {
  1494. Tcl_WrongNumArgs(interp, 2, objv,
  1495.     "-errfile file");
  1496. result = TCL_ERROR;
  1497. break;
  1498. }
  1499. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  1500. /*
  1501.  * If the user already set one, close it.
  1502.  */
  1503. if (errip->i_err != NULL)
  1504. fclose(errip->i_err);
  1505. errip->i_err = fopen(arg, "a");
  1506. if (errip->i_err != NULL) {
  1507. _debug_check();
  1508. (*dbp)->set_errfile(*dbp, errip->i_err);
  1509. set_err = 1;
  1510. }
  1511. break;
  1512. case TCL_DB_ERRPFX:
  1513. if (i >= objc) {
  1514. Tcl_WrongNumArgs(interp, 2, objv,
  1515.     "-errpfx prefix");
  1516. result = TCL_ERROR;
  1517. break;
  1518. }
  1519. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  1520. /*
  1521.  * If the user already set one, free it.
  1522.  */
  1523. if (errip->i_errpfx != NULL)
  1524. __os_freestr(errip->i_errpfx);
  1525. if ((ret = __os_strdup((*dbp)->dbenv,
  1526.     arg, &errip->i_errpfx)) != 0) {
  1527. result = _ReturnSetup(interp, ret,
  1528.     "__os_strdup");
  1529. break;
  1530. }
  1531. if (errip->i_errpfx != NULL) {
  1532. _debug_check();
  1533. (*dbp)->set_errpfx(*dbp, errip->i_errpfx);
  1534. set_pfx = 1;
  1535. }
  1536. break;
  1537. case TCL_DB_ENDARG:
  1538. endarg = 1;
  1539. break;
  1540. } /* switch */
  1542. /*
  1543.  * If, at any time, parsing the args we get an error,
  1544.  * bail out and return.
  1545.  */
  1546. if (result != TCL_OK)
  1547. goto error;
  1548. if (endarg)
  1549. break;
  1550. }
  1551. if (result != TCL_OK)
  1552. goto error;
  1554. /*
  1555.  * Any args we have left, (better be 0, 1 or 2 left) are
  1556.  * file names.  If we have 0, then an in-memory db.  If
  1557.  * there is 1, a db name, if 2 a db and subdb name.
  1558.  */
  1559. if (i != objc) {
  1560. /*
  1561.  * Dbs must be NULL terminated file names, but subdbs can
  1562.  * be anything.  Use Strings for the db name and byte
  1563.  * arrays for the subdb.
  1564.  */
  1565. db = Tcl_GetStringFromObj(objv[i++], NULL);
  1566. if (i != objc) {
  1567. subdbtmp =
  1568.     Tcl_GetByteArrayFromObj(objv[i++], &subdblen);
  1569. if ((ret = __os_malloc(envp,
  1570.    subdblen + 1, NULL, &subdb)) != 0) {
  1571. Tcl_SetResult(interp, db_strerror(ret),
  1572.     TCL_STATIC);
  1573. return (0);
  1574. }
  1575. memcpy(subdb, subdbtmp, subdblen);
  1576. subdb[subdblen] = '';
  1577. }
  1578. }
  1579. if (set_flag) {
  1580. ret = (*dbp)->set_flags(*dbp, set_flag);
  1581. result = _ReturnSetup(interp, ret, "set_flags");
  1582. if (result == TCL_ERROR)
  1583. goto error;
  1584. /*
  1585.  * If we are successful, clear the result so that the
  1586.  * return from set_flags isn't part of the result.
  1587.  */
  1588. Tcl_ResetResult(interp);
  1589. }
  1591. /*
  1592.  * When we get here, we have already parsed all of our args and made
  1593.  * all our calls to set up the database.  Everything is okay so far,
  1594.  * no errors, if we get here.
  1595.  */
  1596. _debug_check();
  1598. /* Open the database. */
  1599. ret = (*dbp)->open(*dbp, db, subdb, type, open_flags, mode);
  1600. result = _ReturnSetup(interp, ret, "db open");
  1602. error:
  1603. if (subdb)
  1604. __os_free(subdb, subdblen + 1);
  1605. if (result == TCL_ERROR) {
  1606. /*
  1607.  * If we opened and set up the error file in the environment
  1608.  * on this open, but we failed for some other reason, clean
  1609.  * up and close the file.
  1610.  *
  1611.  * XXX when err stuff isn't tied to env, change to use ip,
  1612.  * instead of envip.  Also, set_err is irrelevant when that
  1613.  * happens.  It will just read:
  1614.  * if (ip->i_err)
  1615.  * fclose(ip->i_err);
  1616.  */
  1617. if (set_err && errip && errip->i_err != NULL) {
  1618. fclose(errip->i_err);
  1619. errip->i_err = NULL;
  1620. }
  1621. if (set_pfx && errip && errip->i_errpfx != NULL) {
  1622. __os_freestr(errip->i_errpfx);
  1623. errip->i_errpfx = NULL;
  1624. }
  1625. (void)(*dbp)->close(*dbp, 0);
  1626. *dbp = NULL;
  1627. }
  1628. return (result);
  1629. }
  1631. /*
  1632.  * bdb_DbRemove --
  1633.  * Implements the DB->remove command.
  1634.  */
  1635. static int
  1636. bdb_DbRemove(interp, objc, objv)
  1637. Tcl_Interp *interp; /* Interpreter */
  1638. int objc; /* How many arguments? */
  1639. Tcl_Obj *CONST objv[]; /* The argument objects */
  1640. {
  1641. static char *bdbrem[] = {
  1642. "-env", "--", NULL
  1643. };
  1644. enum bdbrem {
  1645. TCL_DBREM_ENV,
  1646. TCL_DBREM_ENDARG
  1647. };
  1648. DB_ENV *envp;
  1649. DB *dbp;
  1650. int endarg, i, optindex, result, ret, subdblen;
  1651. u_char *subdbtmp;
  1652. char *arg, *db, *subdb;
  1654. envp = NULL;
  1655. dbp = NULL;
  1656. result = TCL_OK;
  1657. subdbtmp = NULL;
  1658. db = subdb = NULL;
  1659. endarg = 0;
  1661. if (objc < 2) {
  1662. Tcl_WrongNumArgs(interp, 2, objv, "?args? filename ?database?");
  1663. return (TCL_ERROR);
  1664. }
  1666. /*
  1667.  * We must first parse for the environment flag, since that
  1668.  * is needed for db_create.  Then create the db handle.
  1669.  */
  1670. i = 2;
  1671. while (i < objc) {
  1672. if (Tcl_GetIndexFromObj(interp, objv[i], bdbrem,
  1673.     "option", TCL_EXACT, &optindex) != TCL_OK) {
  1674. arg = Tcl_GetStringFromObj(objv[i], NULL);
  1675. if (arg[0] == '-') {
  1676. result = IS_HELP(objv[i]);
  1677. goto error;
  1678. } else
  1679. Tcl_ResetResult(interp);
  1680. break;
  1681. }
  1682. i++;
  1683. switch ((enum bdbrem)optindex) {
  1684. case TCL_DBREM_ENV:
  1685. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  1686. envp = NAME_TO_ENV(arg);
  1687. if (envp == NULL) {
  1688. Tcl_SetResult(interp,
  1689.     "db remove: illegal environment",
  1690.     TCL_STATIC);
  1691. return (TCL_ERROR);
  1692. }
  1693. break;
  1694. case TCL_DBREM_ENDARG:
  1695. endarg = 1;
  1696. break;
  1697. }
  1698. /*
  1699.  * If, at any time, parsing the args we get an error,
  1700.  * bail out and return.
  1701.  */
  1702. if (result != TCL_OK)
  1703. goto error;
  1704. if (endarg)
  1705. break;
  1706. }
  1707. if (result != TCL_OK)
  1708. goto error;
  1709. /*
  1710.  * Any args we have left, (better be 1 or 2 left) are
  1711.  * file names. If there is 1, a db name, if 2 a db and subdb name.
  1712.  */
  1713. if ((i != (objc - 1)) || (i != (objc - 2))) {
  1714. /*
  1715.  * Dbs must be NULL terminated file names, but subdbs can
  1716.  * be anything.  Use Strings for the db name and byte
  1717.  * arrays for the subdb.
  1718.  */
  1719. db = Tcl_GetStringFromObj(objv[i++], NULL);
  1720. if (i != objc) {
  1721. subdbtmp =
  1722.     Tcl_GetByteArrayFromObj(objv[i++], &subdblen);
  1723. if ((ret = __os_malloc(envp, subdblen + 1,
  1724.     NULL, &subdb)) != 0) { Tcl_SetResult(interp,
  1725.     db_strerror(ret), TCL_STATIC);
  1726. return (0);
  1727. }
  1728. memcpy(subdb, subdbtmp, subdblen);
  1729. subdb[subdblen] = '';
  1730. }
  1731. } else {
  1732. Tcl_WrongNumArgs(interp, 2, objv, "?args? filename ?database?");
  1733. result = TCL_ERROR;
  1734. goto error;
  1735. }
  1736. ret = db_create(&dbp, envp, 0);
  1737. if (ret) {
  1738. result = _ReturnSetup(interp, ret, "db_create");
  1739. goto error;
  1740. }
  1741. /*
  1742.  * No matter what, we NULL out dbp after this call.
  1743.  */
  1744. ret = dbp->remove(dbp, db, subdb, 0);
  1745. result = _ReturnSetup(interp, ret, "db remove");
  1746. dbp = NULL;
  1747. error:
  1748. if (subdb)
  1749. __os_free(subdb, subdblen + 1);
  1750. if (result == TCL_ERROR && dbp)
  1751. (void)dbp->close(dbp, 0);
  1752. return (result);
  1753. }
  1755. /*
  1756.  * bdb_DbRename --
  1757.  * Implements the DB->rename command.
  1758.  */
  1759. static int
  1760. bdb_DbRename(interp, objc, objv)
  1761. Tcl_Interp *interp; /* Interpreter */
  1762. int objc; /* How many arguments? */
  1763. Tcl_Obj *CONST objv[]; /* The argument objects */
  1764. {
  1765. static char *bdbmv[] = {
  1766. "-env", "--", NULL
  1767. };
  1768. enum bdbmv {
  1769. TCL_DBMV_ENV,
  1770. TCL_DBMV_ENDARG
  1771. };
  1772. DB_ENV *envp;
  1773. DB *dbp;
  1774. int endarg, i, newlen, optindex, result, ret, subdblen;
  1775. u_char *subdbtmp;
  1776. char *arg, *db, *newname, *subdb;
  1778. envp = NULL;
  1779. dbp = NULL;
  1780. result = TCL_OK;
  1781. subdbtmp = NULL;
  1782. db = newname = subdb = NULL;
  1783. endarg = 0;
  1785. if (objc < 2) {
  1786. Tcl_WrongNumArgs(interp,
  1787. 3, objv, "?args? filename ?database? ?newname?");
  1788. return (TCL_ERROR);
  1789. }
  1791. /*
  1792.  * We must first parse for the environment flag, since that
  1793.  * is needed for db_create.  Then create the db handle.
  1794.  */
  1795. i = 2;
  1796. while (i < objc) {
  1797. if (Tcl_GetIndexFromObj(interp, objv[i], bdbmv,
  1798.     "option", TCL_EXACT, &optindex) != TCL_OK) {
  1799. arg = Tcl_GetStringFromObj(objv[i], NULL);
  1800. if (arg[0] == '-') {
  1801. result = IS_HELP(objv[i]);
  1802. goto error;
  1803. } else
  1804. Tcl_ResetResult(interp);
  1805. break;
  1806. }
  1807. i++;
  1808. switch ((enum bdbmv)optindex) {
  1809. case TCL_DBMV_ENV:
  1810. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  1811. envp = NAME_TO_ENV(arg);
  1812. if (envp == NULL) {
  1813. Tcl_SetResult(interp,
  1814.     "db rename: illegal environment",
  1815.     TCL_STATIC);
  1816. return (TCL_ERROR);
  1817. }
  1818. break;
  1819. case TCL_DBMV_ENDARG:
  1820. endarg = 1;
  1821. break;
  1822. }
  1823. /*
  1824.  * If, at any time, parsing the args we get an error,
  1825.  * bail out and return.
  1826.  */
  1827. if (result != TCL_OK)
  1828. goto error;
  1829. if (endarg)
  1830. break;
  1831. }
  1832. if (result != TCL_OK)
  1833. goto error;
  1834. /*
  1835.  * Any args we have left, (better be 2 or 3 left) are
  1836.  * file names. If there is 2, a file name, if 3 a file and db name.
  1837.  */
  1838. if ((i != (objc - 2)) || (i != (objc - 3))) {
  1839. /*
  1840.  * Dbs must be NULL terminated file names, but subdbs can
  1841.  * be anything.  Use Strings for the db name and byte
  1842.  * arrays for the subdb.
  1843.  */
  1844. db = Tcl_GetStringFromObj(objv[i++], NULL);
  1845. if (i == objc - 2) {
  1846. subdbtmp =
  1847.     Tcl_GetByteArrayFromObj(objv[i++], &subdblen);
  1848. if ((ret = __os_malloc(envp, subdblen + 1,
  1849.     NULL, &subdb)) != 0) {
  1850. Tcl_SetResult(interp,
  1851.     db_strerror(ret), TCL_STATIC);
  1852. return (0);
  1853. }
  1854. memcpy(subdb, subdbtmp, subdblen);
  1855. subdb[subdblen] = '';
  1856. }
  1857. subdbtmp =
  1858.     Tcl_GetByteArrayFromObj(objv[i++], &newlen);
  1859. if ((ret = __os_malloc(envp, newlen + 1,
  1860.     NULL, &newname)) != 0) {
  1861. Tcl_SetResult(interp,
  1862.     db_strerror(ret), TCL_STATIC);
  1863. return (0);
  1864. }
  1865. memcpy(newname, subdbtmp, newlen);
  1866. newname[newlen] = '';
  1867. } else {
  1868. Tcl_WrongNumArgs(interp, 3, objv, "?args? filename ?database? ?newname?");
  1869. result = TCL_ERROR;
  1870. goto error;
  1871. }
  1872. ret = db_create(&dbp, envp, 0);
  1873. if (ret) {
  1874. result = _ReturnSetup(interp, ret, "db_create");
  1875. goto error;
  1876. }
  1877. /*
  1878.  * No matter what, we NULL out dbp after this call.
  1879.  */
  1880. ret = dbp->rename(dbp, db, subdb, newname, 0);
  1881. result = _ReturnSetup(interp, ret, "db rename");
  1882. dbp = NULL;
  1883. error:
  1884. if (subdb)
  1885. __os_free(subdb, subdblen + 1);
  1886. if (newname)
  1887. __os_free(newname, newlen + 1);
  1888. if (result == TCL_ERROR && dbp)
  1889. (void)dbp->close(dbp, 0);
  1890. return (result);
  1891. }
  1893. /*
  1894.  * bdb_DbVerify --
  1895.  * Implements the DB->verify command.
  1896.  */
  1897. static int
  1898. bdb_DbVerify(interp, objc, objv)
  1899. Tcl_Interp *interp; /* Interpreter */
  1900. int objc; /* How many arguments? */
  1901. Tcl_Obj *CONST objv[]; /* The argument objects */
  1902. {
  1903. static char *bdbverify[] = {
  1904. "-env", "-errfile", "-errpfx", "--", NULL
  1905. };
  1906. enum bdbvrfy {
  1907. TCL_DBVRFY_ENV,
  1908. TCL_DBVRFY_ERRFILE,
  1909. TCL_DBVRFY_ERRPFX,
  1910. TCL_DBVRFY_ENDARG
  1911. };
  1912. DB_ENV *envp;
  1913. DB *dbp;
  1914. FILE *errf;
  1915. int endarg, i, optindex, result, ret, flags;
  1916. char *arg, *db, *errpfx;
  1918. envp = NULL;
  1919. dbp = NULL;
  1920. result = TCL_OK;
  1921. db = errpfx = NULL;
  1922. errf = NULL;
  1923. flags = endarg = 0;
  1925. if (objc < 2) {
  1926. Tcl_WrongNumArgs(interp, 2, objv, "?args? filename");
  1927. return (TCL_ERROR);
  1928. }
  1930. /*
  1931.  * We must first parse for the environment flag, since that
  1932.  * is needed for db_create.  Then create the db handle.
  1933.  */
  1934. i = 2;
  1935. while (i < objc) {
  1936. if (Tcl_GetIndexFromObj(interp, objv[i], bdbverify,
  1937.     "option", TCL_EXACT, &optindex) != TCL_OK) {
  1938. arg = Tcl_GetStringFromObj(objv[i], NULL);
  1939. if (arg[0] == '-') {
  1940. result = IS_HELP(objv[i]);
  1941. goto error;
  1942. } else
  1943. Tcl_ResetResult(interp);
  1944. break;
  1945. }
  1946. i++;
  1947. switch ((enum bdbvrfy)optindex) {
  1948. case TCL_DBVRFY_ENV:
  1949. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  1950. envp = NAME_TO_ENV(arg);
  1951. if (envp == NULL) {
  1952. Tcl_SetResult(interp,
  1953.     "db verify: illegal environment",
  1954.     TCL_STATIC);
  1955. result = TCL_ERROR;
  1956. break;
  1957. }
  1958. break;
  1959. case TCL_DBVRFY_ERRFILE:
  1960. if (i >= objc) {
  1961. Tcl_WrongNumArgs(interp, 2, objv,
  1962.     "-errfile file");
  1963. result = TCL_ERROR;
  1964. break;
  1965. }
  1966. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  1967. /*
  1968.  * If the user already set one, close it.
  1969.  */
  1970. if (errf != NULL)
  1971. fclose(errf);
  1972. errf = fopen(arg, "a");
  1973. break;
  1974. case TCL_DBVRFY_ERRPFX:
  1975. if (i >= objc) {
  1976. Tcl_WrongNumArgs(interp, 2, objv,
  1977.     "-errpfx prefix");
  1978. result = TCL_ERROR;
  1979. break;
  1980. }
  1981. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  1982. /*
  1983.  * If the user already set one, free it.
  1984.  */
  1985. if (errpfx != NULL)
  1986. __os_freestr(errpfx);
  1987. if ((ret = __os_strdup(NULL, arg, &errpfx)) != 0) {
  1988. result = _ReturnSetup(interp, ret,
  1989.     "__os_strdup");
  1990. break;
  1991. }
  1992. break;
  1993. case TCL_DBVRFY_ENDARG:
  1994. endarg = 1;
  1995. break;
  1996. }
  1997. /*
  1998.  * If, at any time, parsing the args we get an error,
  1999.  * bail out and return.
  2000.  */
  2001. if (result != TCL_OK)
  2002. goto error;
  2003. if (endarg)
  2004. break;
  2005. }
  2006. if (result != TCL_OK)
  2007. goto error;
  2008. /*
  2009.  * The remaining arg is the db filename.
  2010.  */
  2011. if (i == (objc - 1))
  2012. db = Tcl_GetStringFromObj(objv[i++], NULL);
  2013. else {
  2014. Tcl_WrongNumArgs(interp, 2, objv, "?args? filename");
  2015. result = TCL_ERROR;
  2016. goto error;
  2017. }
  2018. ret = db_create(&dbp, envp, 0);
  2019. if (ret) {
  2020. result = _ReturnSetup(interp, ret, "db_create");
  2021. goto error;
  2022. }
  2024. if (errf != NULL)
  2025. dbp->set_errfile(dbp, errf);
  2026. if (errpfx != NULL)
  2027. dbp->set_errpfx(dbp, errpfx);
  2029. ret = dbp->verify(dbp, db, NULL, NULL, flags);
  2030. result = _ReturnSetup(interp, ret, "db verify");
  2031. error:
  2032. if (errf != NULL)
  2033. fclose(errf);
  2034. if (errpfx != NULL)
  2035. __os_freestr(errpfx);
  2036. if (dbp)
  2037. (void)dbp->close(dbp, 0);
  2038. return (result);
  2039. }
  2041. /*
  2042.  * bdb_Version --
  2043.  * Implements the version command.
  2044.  */
  2045. static int
  2046. bdb_Version(interp, objc, objv)
  2047. Tcl_Interp *interp; /* Interpreter */
  2048. int objc; /* How many arguments? */
  2049. Tcl_Obj *CONST objv[]; /* The argument objects */
  2050. {
  2051. static char *bdbver[] = {
  2052. "-string", NULL
  2053. };
  2054. enum bdbver {
  2055. TCL_VERSTRING
  2056. };
  2057. int i, optindex, maj, min, patch, result, string, verobjc;
  2058. char *arg, *v;
  2059. Tcl_Obj *res, *verobjv[3];
  2061. result = TCL_OK;
  2062. string = 0;
  2064. if (objc < 2) {
  2065. Tcl_WrongNumArgs(interp, 2, objv, "?args?");
  2066. return (TCL_ERROR);
  2067. }
  2069. /*
  2070.  * We must first parse for the environment flag, since that
  2071.  * is needed for db_create.  Then create the db handle.
  2072.  */
  2073. i = 2;
  2074. while (i < objc) {
  2075. if (Tcl_GetIndexFromObj(interp, objv[i], bdbver,
  2076.     "option", TCL_EXACT, &optindex) != TCL_OK) {
  2077. arg = Tcl_GetStringFromObj(objv[i], NULL);
  2078. if (arg[0] == '-') {
  2079. result = IS_HELP(objv[i]);
  2080. goto error;
  2081. } else
  2082. Tcl_ResetResult(interp);
  2083. break;
  2084. }
  2085. i++;
  2086. switch ((enum bdbver)optindex) {
  2087. case TCL_VERSTRING:
  2088. string = 1;
  2089. break;
  2090. }
  2091. /*
  2092.  * If, at any time, parsing the args we get an error,
  2093.  * bail out and return.
  2094.  */
  2095. if (result != TCL_OK)
  2096. goto error;
  2097. }
  2098. if (result != TCL_OK)
  2099. goto error;
  2101. v = db_version(&maj, &min, &patch);
  2102. if (string)
  2103. res = Tcl_NewStringObj(v, strlen(v));
  2104. else {
  2105. verobjc = 3;
  2106. verobjv[0] = Tcl_NewIntObj(maj);
  2107. verobjv[1] = Tcl_NewIntObj(min);
  2108. verobjv[2] = Tcl_NewIntObj(patch);
  2109. res = Tcl_NewListObj(verobjc, verobjv);
  2110. }
  2111. Tcl_SetObjResult(interp, res);
  2112. error:
  2113. return (result);
  2114. }
  2116. /*
  2117.  * bdb_Handles --
  2118.  * Implements the handles command.
  2119.  */
  2120. static int
  2121. bdb_Handles(interp, objc, objv)
  2122. Tcl_Interp *interp; /* Interpreter */
  2123. int objc; /* How many arguments? */
  2124. Tcl_Obj *CONST objv[]; /* The argument objects */
  2125. {
  2126. DBTCL_INFO *p;
  2127. Tcl_Obj *res, *handle;
  2129. /*
  2130.  * No args.  Error if we have some
  2131.  */
  2132. if (objc != 2) {
  2133. Tcl_WrongNumArgs(interp, 2, objv, "");
  2134. return (TCL_ERROR);
  2135. }
  2136. res = Tcl_NewListObj(0, NULL);
  2138. for (p = LIST_FIRST(&__db_infohead); p != NULL;
  2139.     p = LIST_NEXT(p, entries)) {
  2140. handle = Tcl_NewStringObj(p->i_name, strlen(p->i_name));
  2141. if (Tcl_ListObjAppendElement(interp, res, handle) != TCL_OK)
  2142. return (TCL_ERROR);
  2143. }
  2144. Tcl_SetObjResult(interp, res);
  2145. return (TCL_OK);
  2146. }
  2148. /*
  2149.  * bdb_DbUpgrade --
  2150.  * Implements the DB->upgrade command.
  2151.  */
  2152. static int
  2153. bdb_DbUpgrade(interp, objc, objv)
  2154. Tcl_Interp *interp; /* Interpreter */
  2155. int objc; /* How many arguments? */
  2156. Tcl_Obj *CONST objv[]; /* The argument objects */
  2157. {
  2158. static char *bdbupg[] = {
  2159. "-dupsort", "-env", "--", NULL
  2160. };
  2161. enum bdbupg {
  2162. TCL_DBUPG_DUPSORT,
  2163. TCL_DBUPG_ENV,
  2164. TCL_DBUPG_ENDARG
  2165. };
  2166. DB_ENV *envp;
  2167. DB *dbp;
  2168. int endarg, i, optindex, result, ret, flags;
  2169. char *arg, *db;
  2171. envp = NULL;
  2172. dbp = NULL;
  2173. result = TCL_OK;
  2174. db = NULL;
  2175. flags = endarg = 0;
  2177. if (objc < 2) {
  2178. Tcl_WrongNumArgs(interp, 2, objv, "?args? filename");
  2179. return (TCL_ERROR);
  2180. }
  2182. i = 2;
  2183. while (i < objc) {
  2184. if (Tcl_GetIndexFromObj(interp, objv[i], bdbupg,
  2185.     "option", TCL_EXACT, &optindex) != TCL_OK) {
  2186. arg = Tcl_GetStringFromObj(objv[i], NULL);
  2187. if (arg[0] == '-') {
  2188. result = IS_HELP(objv[i]);
  2189. goto error;
  2190. } else
  2191. Tcl_ResetResult(interp);
  2192. break;
  2193. }
  2194. i++;
  2195. switch ((enum bdbupg)optindex) {
  2196. case TCL_DBUPG_DUPSORT:
  2197. flags |= DB_DUPSORT;
  2198. break;
  2199. case TCL_DBUPG_ENV:
  2200. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  2201. envp = NAME_TO_ENV(arg);
  2202. if (envp == NULL) {
  2203. Tcl_SetResult(interp,
  2204.     "db upgrade: illegal environment",
  2205.     TCL_STATIC);
  2206. return (TCL_ERROR);
  2207. }
  2208. break;
  2209. case TCL_DBUPG_ENDARG:
  2210. endarg = 1;
  2211. break;
  2212. }
  2213. /*
  2214.  * If, at any time, parsing the args we get an error,
  2215.  * bail out and return.
  2216.  */
  2217. if (result != TCL_OK)
  2218. goto error;
  2219. if (endarg)
  2220. break;
  2221. }
  2222. if (result != TCL_OK)
  2223. goto error;
  2224. /*
  2225.  * The remaining arg is the db filename.
  2226.  */
  2227. if (i == (objc - 1))
  2228. db = Tcl_GetStringFromObj(objv[i++], NULL);
  2229. else {
  2230. Tcl_WrongNumArgs(interp, 2, objv, "?args? filename");
  2231. result = TCL_ERROR;
  2232. goto error;
  2233. }
  2234. ret = db_create(&dbp, envp, 0);
  2235. if (ret) {
  2236. result = _ReturnSetup(interp, ret, "db_create");
  2237. goto error;
  2238. }
  2240. ret = dbp->upgrade(dbp, db, flags);
  2241. result = _ReturnSetup(interp, ret, "db upgrade");
  2242. error:
  2243. if (dbp)
  2244. (void)dbp->close(dbp, 0);
  2245. return (result);
  2246. }