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

源码开发语言/平台
当前位置：首页 > 源码/资料 > 数据库系统 > MySQL数据库 > 查看源码
tcl_db.c
资源名称：mysql-4.1.16-win-src.zip　[点击查看]
上传用户：romrleung
上传日期：2022-05-23
资源大小：18897k
文件大小：57k
源码类别：

MySQL数据库

开发平台：

Visual C++

tcl_db.c：源码内容
  1. /*-
  2.  * See the file LICENSE for redistribution information.
  3.  *
  4.  * Copyright (c) 1999-2002
  5.  * Sleepycat Software.  All rights reserved.
  6.  */
  8. #include "db_config.h"
  10. #ifndef lint
  11. static const char revid[] = "$Id: tcl_db.c,v 11.107 2002/08/06 06:20:31 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. #include "db_int.h"
  23. #include "dbinc/db_page.h"
  24. #include "dbinc/db_am.h"
  25. #include "dbinc/tcl_db.h"
  27. /*
  28.  * Prototypes for procedures defined later in this file:
  29.  */
  30. static int tcl_DbAssociate __P((Tcl_Interp *,
  31.     int, Tcl_Obj * CONST*, DB *));
  32. static int tcl_DbClose __P((Tcl_Interp *,
  33.     int, Tcl_Obj * CONST*, DB *, DBTCL_INFO *));
  34. static int tcl_DbDelete __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *));
  35. static int tcl_DbGet __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *, int));
  36. static int tcl_DbKeyRange __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *));
  37. static int tcl_DbPut __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *));
  38. static int tcl_DbStat __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *));
  39. static int tcl_DbTruncate __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *));
  40. static int tcl_DbCursor __P((Tcl_Interp *,
  41.     int, Tcl_Obj * CONST*, DB *, DBC **));
  42. static int tcl_DbJoin __P((Tcl_Interp *,
  43.     int, Tcl_Obj * CONST*, DB *, DBC **));
  44. static int tcl_DbGetjoin __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *));
  45. static int tcl_DbCount __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB *));
  46. static int tcl_second_call __P((DB *, const DBT *, const DBT *, DBT *));
  48. /*
  49.  * _DbInfoDelete --
  50.  *
  51.  * PUBLIC: void _DbInfoDelete __P((Tcl_Interp *, DBTCL_INFO *));
  52.  */
  53. void
  54. _DbInfoDelete(interp, dbip)
  55. Tcl_Interp *interp;
  56. DBTCL_INFO *dbip;
  57. {
  58. DBTCL_INFO *nextp, *p;
  59. /*
  60.  * First we have to close any open cursors.  Then we close
  61.  * our db.
  62.  */
  63. for (p = LIST_FIRST(&__db_infohead); p != NULL; p = nextp) {
  64. nextp = LIST_NEXT(p, entries);
  65. /*
  66.  * Check if this is a cursor info structure and if
  67.  * it is, if it belongs to this DB.  If so, remove
  68.  * its commands and info structure.
  69.  */
  70. if (p->i_parent == dbip && p->i_type == I_DBC) {
  71. (void)Tcl_DeleteCommand(interp, p->i_name);
  72. _DeleteInfo(p);
  73. }
  74. }
  75. (void)Tcl_DeleteCommand(interp, dbip->i_name);
  76. _DeleteInfo(dbip);
  77. }
  79. /*
  80.  *
  81.  * PUBLIC: int db_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*));
  82.  *
  83.  * db_Cmd --
  84.  * Implements the "db" widget.
  85.  */
  86. int
  87. db_Cmd(clientData, interp, objc, objv)
  88. ClientData clientData; /* DB handle */
  89. Tcl_Interp *interp; /* Interpreter */
  90. int objc; /* How many arguments? */
  91. Tcl_Obj *CONST objv[]; /* The argument objects */
  92. {
  93. static char *dbcmds[] = {
  94. #if CONFIG_TEST
  95. "keyrange",
  96. "pget",
  97. "rpcid",
  98. "test",
  99. #endif
  100. "associate",
  101. "close",
  102. "count",
  103. "cursor",
  104. "del",
  105. "get",
  106. "get_join",
  107. "get_type",
  108. "is_byteswapped",
  109. "join",
  110. "put",
  111. "stat",
  112. "sync",
  113. "truncate",
  114. NULL
  115. };
  116. enum dbcmds {
  117. #if CONFIG_TEST
  118. DBKEYRANGE,
  119. DBPGET,
  120. DBRPCID,
  121. DBTEST,
  122. #endif
  123. DBASSOCIATE,
  124. DBCLOSE,
  125. DBCOUNT,
  126. DBCURSOR,
  127. DBDELETE,
  128. DBGET,
  129. DBGETJOIN,
  130. DBGETTYPE,
  131. DBSWAPPED,
  132. DBJOIN,
  133. DBPUT,
  134. DBSTAT,
  135. DBSYNC,
  136. DBTRUNCATE
  137. };
  138. DB *dbp;
  139. DBC *dbc;
  140. DBTCL_INFO *dbip;
  141. DBTCL_INFO *ip;
  142. DBTYPE type;
  143. Tcl_Obj *res;
  144. int cmdindex, isswapped, result, ret;
  145. char newname[MSG_SIZE];
  147. Tcl_ResetResult(interp);
  148. dbp = (DB *)clientData;
  149. dbip = _PtrToInfo((void *)dbp);
  150. memset(newname, 0, MSG_SIZE);
  151. result = TCL_OK;
  152. if (objc <= 1) {
  153. Tcl_WrongNumArgs(interp, 1, objv, "command cmdargs");
  154. return (TCL_ERROR);
  155. }
  156. if (dbp == NULL) {
  157. Tcl_SetResult(interp, "NULL db pointer", TCL_STATIC);
  158. return (TCL_ERROR);
  159. }
  160. if (dbip == NULL) {
  161. Tcl_SetResult(interp, "NULL db info pointer", TCL_STATIC);
  162. return (TCL_ERROR);
  163. }
  165. /*
  166.  * Get the command name index from the object based on the dbcmds
  167.  * defined above.
  168.  */
  169. if (Tcl_GetIndexFromObj(interp,
  170.     objv[1], dbcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
  171. return (IS_HELP(objv[1]));
  173. res = NULL;
  174. switch ((enum dbcmds)cmdindex) {
  175. #if CONFIG_TEST
  176. case DBKEYRANGE:
  177. result = tcl_DbKeyRange(interp, objc, objv, dbp);
  178. break;
  179. case DBPGET:
  180. result = tcl_DbGet(interp, objc, objv, dbp, 1);
  181. break;
  182. case DBRPCID:
  183. /*
  184.  * No args for this.  Error if there are some.
  185.  */
  186. if (objc > 2) {
  187. Tcl_WrongNumArgs(interp, 2, objv, NULL);
  188. return (TCL_ERROR);
  189. }
  190. /*
  191.  * !!! Retrieve the client ID from the dbp handle directly.
  192.  * This is for testing purposes only.  It is dbp-private data.
  193.  */
  194. res = Tcl_NewLongObj(dbp->cl_id);
  195. break;
  196. case DBTEST:
  197. result = tcl_EnvTest(interp, objc, objv, dbp->dbenv);
  198. break;
  199. #endif
  200. case DBASSOCIATE:
  201. result = tcl_DbAssociate(interp, objc, objv, dbp);
  202. break;
  203. case DBCLOSE:
  204. result = tcl_DbClose(interp, objc, objv, dbp, dbip);
  205. break;
  206. case DBDELETE:
  207. result = tcl_DbDelete(interp, objc, objv, dbp);
  208. break;
  209. case DBGET:
  210. result = tcl_DbGet(interp, objc, objv, dbp, 0);
  211. break;
  212. case DBPUT:
  213. result = tcl_DbPut(interp, objc, objv, dbp);
  214. break;
  215. case DBCOUNT:
  216. result = tcl_DbCount(interp, objc, objv, dbp);
  217. break;
  218. case DBSWAPPED:
  219. /*
  220.  * No args for this.  Error if there are some.
  221.  */
  222. if (objc > 2) {
  223. Tcl_WrongNumArgs(interp, 2, objv, NULL);
  224. return (TCL_ERROR);
  225. }
  226. _debug_check();
  227. ret = dbp->get_byteswapped(dbp, &isswapped);
  228. res = Tcl_NewIntObj(isswapped);
  229. break;
  230. case DBGETTYPE:
  231. /*
  232.  * No args for this.  Error if there are some.
  233.  */
  234. if (objc > 2) {
  235. Tcl_WrongNumArgs(interp, 2, objv, NULL);
  236. return (TCL_ERROR);
  237. }
  238. _debug_check();
  239. ret = dbp->get_type(dbp, &type);
  240. if (type == DB_BTREE)
  241. res = Tcl_NewStringObj("btree", strlen("btree"));
  242. else if (type == DB_HASH)
  243. res = Tcl_NewStringObj("hash", strlen("hash"));
  244. else if (type == DB_RECNO)
  245. res = Tcl_NewStringObj("recno", strlen("recno"));
  246. else if (type == DB_QUEUE)
  247. res = Tcl_NewStringObj("queue", strlen("queue"));
  248. else {
  249. Tcl_SetResult(interp,
  250.     "db gettype: Returned unknown typen", TCL_STATIC);
  251. result = TCL_ERROR;
  252. }
  253. break;
  254. case DBSTAT:
  255. result = tcl_DbStat(interp, objc, objv, dbp);
  256. break;
  257. case DBSYNC:
  258. /*
  259.  * No args for this.  Error if there are some.
  260.  */
  261. if (objc > 2) {
  262. Tcl_WrongNumArgs(interp, 2, objv, NULL);
  263. return (TCL_ERROR);
  264. }
  265. _debug_check();
  266. ret = dbp->sync(dbp, 0);
  267. res = Tcl_NewIntObj(ret);
  268. if (ret != 0) {
  269. Tcl_SetObjResult(interp, res);
  270. result = TCL_ERROR;
  271. }
  272. break;
  273. case DBCURSOR:
  274. snprintf(newname, sizeof(newname),
  275.     "%s.c%d", dbip->i_name, dbip->i_dbdbcid);
  276. ip = _NewInfo(interp, NULL, newname, I_DBC);
  277. if (ip != NULL) {
  278. result = tcl_DbCursor(interp, objc, objv, dbp, &dbc);
  279. if (result == TCL_OK) {
  280. dbip->i_dbdbcid++;
  281. ip->i_parent = dbip;
  282. Tcl_CreateObjCommand(interp, newname,
  283.     (Tcl_ObjCmdProc *)dbc_Cmd,
  284.     (ClientData)dbc, NULL);
  285. res =
  286.     Tcl_NewStringObj(newname, strlen(newname));
  287. _SetInfoData(ip, dbc);
  288. } else
  289. _DeleteInfo(ip);
  290. } else {
  291. Tcl_SetResult(interp,
  292.     "Could not set up info", TCL_STATIC);
  293. result = TCL_ERROR;
  294. }
  295. break;
  296. case DBJOIN:
  297. snprintf(newname, sizeof(newname),
  298.     "%s.c%d", dbip->i_name, dbip->i_dbdbcid);
  299. ip = _NewInfo(interp, NULL, newname, I_DBC);
  300. if (ip != NULL) {
  301. result = tcl_DbJoin(interp, objc, objv, dbp, &dbc);
  302. if (result == TCL_OK) {
  303. dbip->i_dbdbcid++;
  304. ip->i_parent = dbip;
  305. Tcl_CreateObjCommand(interp, newname,
  306.     (Tcl_ObjCmdProc *)dbc_Cmd,
  307.     (ClientData)dbc, NULL);
  308. res =
  309.     Tcl_NewStringObj(newname, strlen(newname));
  310. _SetInfoData(ip, dbc);
  311. } else
  312. _DeleteInfo(ip);
  313. } else {
  314. Tcl_SetResult(interp,
  315.     "Could not set up info", TCL_STATIC);
  316. result = TCL_ERROR;
  317. }
  318. break;
  319. case DBGETJOIN:
  320. result = tcl_DbGetjoin(interp, objc, objv, dbp);
  321. break;
  322. case DBTRUNCATE:
  323. result = tcl_DbTruncate(interp, objc, objv, dbp);
  324. break;
  325. }
  326. /*
  327.  * Only set result if we have a res.  Otherwise, lower
  328.  * functions have already done so.
  329.  */
  330. if (result == TCL_OK && res)
  331. Tcl_SetObjResult(interp, res);
  332. return (result);
  333. }
  335. /*
  336.  * tcl_db_stat --
  337.  */
  338. static int
  339. tcl_DbStat(interp, objc, objv, dbp)
  340. Tcl_Interp *interp; /* Interpreter */
  341. int objc; /* How many arguments? */
  342. Tcl_Obj *CONST objv[]; /* The argument objects */
  343. DB *dbp; /* Database pointer */
  344. {
  345. DB_BTREE_STAT *bsp;
  346. DB_HASH_STAT *hsp;
  347. DB_QUEUE_STAT *qsp;
  348. void *sp;
  349. Tcl_Obj *res, *flaglist, *myobjv[2];
  350. DBTYPE type;
  351. u_int32_t flag;
  352. int result, ret;
  353. char *arg;
  355. result = TCL_OK;
  356. flag = 0;
  358. if (objc > 3) {
  359. Tcl_WrongNumArgs(interp, 2, objv, "?-faststat?");
  360. return (TCL_ERROR);
  361. }
  363. if (objc == 3) {
  364. arg = Tcl_GetStringFromObj(objv[2], NULL);
  365. if (strcmp(arg, "-faststat") == 0)
  366. flag = DB_FAST_STAT;
  367. else {
  368. Tcl_SetResult(interp,
  369.     "db stat: unknown arg", TCL_STATIC);
  370. return (TCL_ERROR);
  371. }
  372. }
  374. _debug_check();
  375. ret = dbp->stat(dbp, &sp, flag);
  376. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db stat");
  377. if (result == TCL_ERROR)
  378. return (result);
  380. (void)dbp->get_type(dbp, &type);
  381. /*
  382.  * Have our stats, now construct the name value
  383.  * list pairs and free up the memory.
  384.  */
  385. res = Tcl_NewObj();
  387. /*
  388.  * MAKE_STAT_LIST assumes 'res' and 'error' label.
  389.  */
  390. if (type == DB_HASH) {
  391. hsp = (DB_HASH_STAT *)sp;
  392. MAKE_STAT_LIST("Magic", hsp->hash_magic);
  393. MAKE_STAT_LIST("Version", hsp->hash_version);
  394. MAKE_STAT_LIST("Page size", hsp->hash_pagesize);
  395. MAKE_STAT_LIST("Number of keys", hsp->hash_nkeys);
  396. MAKE_STAT_LIST("Number of records", hsp->hash_ndata);
  397. MAKE_STAT_LIST("Fill factor", hsp->hash_ffactor);
  398. MAKE_STAT_LIST("Buckets", hsp->hash_buckets);
  399. if (flag != DB_FAST_STAT) {
  400. MAKE_STAT_LIST("Free pages", hsp->hash_free);
  401. MAKE_STAT_LIST("Bytes free", hsp->hash_bfree);
  402. MAKE_STAT_LIST("Number of big pages",
  403.     hsp->hash_bigpages);
  404. MAKE_STAT_LIST("Big pages bytes free",
  405.     hsp->hash_big_bfree);
  406. MAKE_STAT_LIST("Overflow pages", hsp->hash_overflows);
  407. MAKE_STAT_LIST("Overflow bytes free",
  408.     hsp->hash_ovfl_free);
  409. MAKE_STAT_LIST("Duplicate pages", hsp->hash_dup);
  410. MAKE_STAT_LIST("Duplicate pages bytes free",
  411.     hsp->hash_dup_free);
  412. }
  413. } else if (type == DB_QUEUE) {
  414. qsp = (DB_QUEUE_STAT *)sp;
  415. MAKE_STAT_LIST("Magic", qsp->qs_magic);
  416. MAKE_STAT_LIST("Version", qsp->qs_version);
  417. MAKE_STAT_LIST("Page size", qsp->qs_pagesize);
  418. MAKE_STAT_LIST("Extent size", qsp->qs_extentsize);
  419. MAKE_STAT_LIST("Number of records", qsp->qs_nkeys);
  420. MAKE_STAT_LIST("Record length", qsp->qs_re_len);
  421. MAKE_STAT_LIST("Record pad", qsp->qs_re_pad);
  422. MAKE_STAT_LIST("First record number", qsp->qs_first_recno);
  423. MAKE_STAT_LIST("Last record number", qsp->qs_cur_recno);
  424. if (flag != DB_FAST_STAT) {
  425. MAKE_STAT_LIST("Number of pages", qsp->qs_pages);
  426. MAKE_STAT_LIST("Bytes free", qsp->qs_pgfree);
  427. }
  428. } else { /* BTREE and RECNO are same stats */
  429. bsp = (DB_BTREE_STAT *)sp;
  430. MAKE_STAT_LIST("Magic", bsp->bt_magic);
  431. MAKE_STAT_LIST("Version", bsp->bt_version);
  432. MAKE_STAT_LIST("Number of keys", bsp->bt_nkeys);
  433. MAKE_STAT_LIST("Number of records", bsp->bt_ndata);
  434. MAKE_STAT_LIST("Minimum keys per page", bsp->bt_minkey);
  435. MAKE_STAT_LIST("Fixed record length", bsp->bt_re_len);
  436. MAKE_STAT_LIST("Record pad", bsp->bt_re_pad);
  437. MAKE_STAT_LIST("Page size", bsp->bt_pagesize);
  438. if (flag != DB_FAST_STAT) {
  439. MAKE_STAT_LIST("Levels", bsp->bt_levels);
  440. MAKE_STAT_LIST("Internal pages", bsp->bt_int_pg);
  441. MAKE_STAT_LIST("Leaf pages", bsp->bt_leaf_pg);
  442. MAKE_STAT_LIST("Duplicate pages", bsp->bt_dup_pg);
  443. MAKE_STAT_LIST("Overflow pages", bsp->bt_over_pg);
  444. MAKE_STAT_LIST("Pages on freelist", bsp->bt_free);
  445. MAKE_STAT_LIST("Internal pages bytes free",
  446.     bsp->bt_int_pgfree);
  447. MAKE_STAT_LIST("Leaf pages bytes free",
  448.     bsp->bt_leaf_pgfree);
  449. MAKE_STAT_LIST("Duplicate pages bytes free",
  450.     bsp->bt_dup_pgfree);
  451. MAKE_STAT_LIST("Bytes free in overflow pages",
  452.     bsp->bt_over_pgfree);
  453. }
  454. }
  456. /*
  457.  * Construct a {name {flag1 flag2 ... flagN}} list for the
  458.  * dbp flags.  These aren't access-method dependent, but they
  459.  * include all the interesting flags, and the integer value
  460.  * isn't useful from Tcl--return the strings instead.
  461.  */
  462. myobjv[0] = Tcl_NewStringObj("Flags", strlen("Flags"));
  463. myobjv[1] = _GetFlagsList(interp, dbp->flags, __db_inmemdbflags);
  464. flaglist = Tcl_NewListObj(2, myobjv);
  465. if (flaglist == NULL) {
  466. result = TCL_ERROR;
  467. goto error;
  468. }
  469. if ((result =
  470.     Tcl_ListObjAppendElement(interp, res, flaglist)) != TCL_OK)
  471. goto error;
  473. Tcl_SetObjResult(interp, res);
  474. error:
  475. free(sp);
  476. return (result);
  477. }
  479. /*
  480.  * tcl_db_close --
  481.  */
  482. static int
  483. tcl_DbClose(interp, objc, objv, dbp, dbip)
  484. Tcl_Interp *interp; /* Interpreter */
  485. int objc; /* How many arguments? */
  486. Tcl_Obj *CONST objv[]; /* The argument objects */
  487. DB *dbp; /* Database pointer */
  488. DBTCL_INFO *dbip; /* Info pointer */
  489. {
  490. static char *dbclose[] = {
  491. "-nosync", "--", NULL
  492. };
  493. enum dbclose {
  494. TCL_DBCLOSE_NOSYNC,
  495. TCL_DBCLOSE_ENDARG
  496. };
  497. u_int32_t flag;
  498. int endarg, i, optindex, result, ret;
  499. char *arg;
  501. result = TCL_OK;
  502. endarg = 0;
  503. flag = 0;
  504. if (objc > 4) {
  505. Tcl_WrongNumArgs(interp, 2, objv, "?-nosync?");
  506. return (TCL_ERROR);
  507. }
  509. i = 2;
  510. while (i < objc) {
  511. if (Tcl_GetIndexFromObj(interp, objv[i], dbclose,
  512.     "option", TCL_EXACT, &optindex) != TCL_OK) {
  513. arg = Tcl_GetStringFromObj(objv[i], NULL);
  514. if (arg[0] == '-')
  515. return (IS_HELP(objv[i]));
  516. else
  517. Tcl_ResetResult(interp);
  518. break;
  519. }
  520. i++;
  521. switch ((enum dbclose)optindex) {
  522. case TCL_DBCLOSE_NOSYNC:
  523. flag = DB_NOSYNC;
  524. break;
  525. case TCL_DBCLOSE_ENDARG:
  526. endarg = 1;
  527. break;
  528. }
  529. /*
  530.  * If, at any time, parsing the args we get an error,
  531.  * bail out and return.
  532.  */
  533. if (result != TCL_OK)
  534. return (result);
  535. if (endarg)
  536. break;
  537. }
  538. _DbInfoDelete(interp, dbip);
  539. _debug_check();
  541. /* Paranoia. */
  542. dbp->api_internal = NULL;
  544. ret = (dbp)->close(dbp, flag);
  545. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db close");
  546. return (result);
  547. }
  549. /*
  550.  * tcl_db_put --
  551.  */
  552. static int
  553. tcl_DbPut(interp, objc, objv, dbp)
  554. Tcl_Interp *interp; /* Interpreter */
  555. int objc; /* How many arguments? */
  556. Tcl_Obj *CONST objv[]; /* The argument objects */
  557. DB *dbp; /* Database pointer */
  558. {
  559. static char *dbputopts[] = {
  560. #if CONFIG_TEST
  561. "-nodupdata",
  562. #endif
  563. "-append",
  564. "-auto_commit",
  565. "-nooverwrite",
  566. "-partial",
  567. "-txn",
  568. NULL
  569. };
  570. enum dbputopts {
  571. #if CONFIG_TEST
  572. DBGET_NODUPDATA,
  573. #endif
  574. DBPUT_APPEND,
  575. DBPUT_AUTO_COMMIT,
  576. DBPUT_NOOVER,
  577. DBPUT_PART,
  578. DBPUT_TXN
  579. };
  580. static char *dbputapp[] = {
  581. "-append", NULL
  582. };
  583. enum dbputapp { DBPUT_APPEND0 };
  584. DBT key, data;
  585. DBTYPE type;
  586. DB_TXN *txn;
  587. Tcl_Obj **elemv, *res;
  588. void *dtmp, *ktmp;
  589. db_recno_t recno;
  590. u_int32_t flag;
  591. int auto_commit, elemc, end, freekey, freedata;
  592. int i, optindex, result, ret;
  593. char *arg, msg[MSG_SIZE];
  595. txn = NULL;
  596. result = TCL_OK;
  597. flag = 0;
  598. if (objc <= 3) {
  599. Tcl_WrongNumArgs(interp, 2, objv, "?-args? key data");
  600. return (TCL_ERROR);
  601. }
  603. freekey = freedata = 0;
  604. memset(&key, 0, sizeof(key));
  605. memset(&data, 0, sizeof(data));
  607. /*
  608.  * If it is a QUEUE or RECNO database, the key is a record number
  609.  * and must be setup up to contain a db_recno_t.  Otherwise the
  610.  * key is a "string".
  611.  */
  612. (void)dbp->get_type(dbp, &type);
  614. /*
  615.  * We need to determine where the end of required args are.  If we
  616.  * are using a QUEUE/RECNO db and -append, then there is just one
  617.  * req arg (data).  Otherwise there are two (key data).
  618.  *
  619.  * We preparse the list to determine this since we need to know
  620.  * to properly check # of args for other options below.
  621.  */
  622. end = objc - 2;
  623. if (type == DB_QUEUE || type == DB_RECNO) {
  624. i = 2;
  625. while (i < objc - 1) {
  626. if (Tcl_GetIndexFromObj(interp, objv[i++], dbputapp,
  627.     "option", TCL_EXACT, &optindex) != TCL_OK)
  628. continue;
  629. switch ((enum dbputapp)optindex) {
  630. case DBPUT_APPEND0:
  631. end = objc - 1;
  632. break;
  633. }
  634. }
  635. }
  636. Tcl_ResetResult(interp);
  638. /*
  639.  * Get the command name index from the object based on the options
  640.  * defined above.
  641.  */
  642. i = 2;
  643. auto_commit = 0;
  644. while (i < end) {
  645. if (Tcl_GetIndexFromObj(interp, objv[i],
  646.     dbputopts, "option", TCL_EXACT, &optindex) != TCL_OK)
  647. return (IS_HELP(objv[i]));
  648. i++;
  649. switch ((enum dbputopts)optindex) {
  650. #if CONFIG_TEST
  651. case DBGET_NODUPDATA:
  652. FLAG_CHECK(flag);
  653. flag = DB_NODUPDATA;
  654. break;
  655. #endif
  656. case DBPUT_TXN:
  657. if (i > (end - 1)) {
  658. Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
  659. result = TCL_ERROR;
  660. break;
  661. }
  662. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  663. txn = NAME_TO_TXN(arg);
  664. if (txn == NULL) {
  665. snprintf(msg, MSG_SIZE,
  666.     "Put: Invalid txn: %sn", arg);
  667. Tcl_SetResult(interp, msg, TCL_VOLATILE);
  668. result = TCL_ERROR;
  669. }
  670. break;
  671. case DBPUT_AUTO_COMMIT:
  672. auto_commit = 1;
  673. break;
  674. case DBPUT_APPEND:
  675. FLAG_CHECK(flag);
  676. flag = DB_APPEND;
  677. break;
  678. case DBPUT_NOOVER:
  679. FLAG_CHECK(flag);
  680. flag = DB_NOOVERWRITE;
  681. break;
  682. case DBPUT_PART:
  683. if (i > (end - 1)) {
  684. Tcl_WrongNumArgs(interp, 2, objv,
  685.     "?-partial {offset length}?");
  686. result = TCL_ERROR;
  687. break;
  688. }
  689. /*
  690.  * Get sublist as {offset length}
  691.  */
  692. result = Tcl_ListObjGetElements(interp, objv[i++],
  693.     &elemc, &elemv);
  694. if (elemc != 2) {
  695. Tcl_SetResult(interp,
  696.     "List must be {offset length}", TCL_STATIC);
  697. result = TCL_ERROR;
  698. break;
  699. }
  700. data.flags = DB_DBT_PARTIAL;
  701. result = _GetUInt32(interp, elemv[0], &data.doff);
  702. if (result != TCL_OK)
  703. break;
  704. result = _GetUInt32(interp, elemv[1], &data.dlen);
  705. /*
  706.  * NOTE: We don't check result here because all we'd
  707.  * do is break anyway, and we are doing that.  If you
  708.  * add code here, you WILL need to add the check
  709.  * for result.  (See the check for save.doff, a few
  710.  * lines above and copy that.)
  711.  */
  712. break;
  713. }
  714. if (result != TCL_OK)
  715. break;
  716. }
  717. if (auto_commit)
  718. flag |= DB_AUTO_COMMIT;
  720. if (result == TCL_ERROR)
  721. return (result);
  723. /*
  724.  * If we are a recno db and we are NOT using append, then the 2nd
  725.  * last arg is the key.
  726.  */
  727. if (type == DB_QUEUE || type == DB_RECNO) {
  728. key.data = &recno;
  729. key.ulen = key.size = sizeof(db_recno_t);
  730. key.flags = DB_DBT_USERMEM;
  731. if (flag == DB_APPEND)
  732. recno = 0;
  733. else {
  734. result = _GetUInt32(interp, objv[objc-2], &recno);
  735. if (result != TCL_OK)
  736. return (result);
  737. }
  738. } else {
  739. ret = _CopyObjBytes(interp, objv[objc-2], &ktmp,
  740.     &key.size, &freekey);
  741. if (ret != 0) {
  742. result = _ReturnSetup(interp, ret,
  743.     DB_RETOK_DBPUT(ret), "db put");
  744. return (result);
  745. }
  746. key.data = ktmp;
  747. }
  748. ret = _CopyObjBytes(interp, objv[objc-1], &dtmp,
  749.     &data.size, &freedata);
  750. if (ret != 0) {
  751. result = _ReturnSetup(interp, ret,
  752.     DB_RETOK_DBPUT(ret), "db put");
  753. goto out;
  754. }
  755. data.data = dtmp;
  756. _debug_check();
  757. ret = dbp->put(dbp, txn, &key, &data, flag);
  758. result = _ReturnSetup(interp, ret, DB_RETOK_DBPUT(ret), "db put");
  759. if (ret == 0 &&
  760.     (type == DB_RECNO || type == DB_QUEUE) && flag == DB_APPEND) {
  761. res = Tcl_NewLongObj((long)recno);
  762. Tcl_SetObjResult(interp, res);
  763. }
  764. out:
  765. if (freedata)
  766. (void)__os_free(dbp->dbenv, dtmp);
  767. if (freekey)
  768. (void)__os_free(dbp->dbenv, ktmp);
  769. return (result);
  770. }
  772. /*
  773.  * tcl_db_get --
  774.  */
  775. static int
  776. tcl_DbGet(interp, objc, objv, dbp, ispget)
  777. Tcl_Interp *interp; /* Interpreter */
  778. int objc; /* How many arguments? */
  779. Tcl_Obj *CONST objv[]; /* The argument objects */
  780. DB *dbp; /* Database pointer */
  781. int ispget; /* 1 for pget, 0 for get */
  782. {
  783. static char *dbgetopts[] = {
  784. #if CONFIG_TEST
  785. "-dirty",
  786. "-multi",
  787. #endif
  788. "-consume",
  789. "-consume_wait",
  790. "-get_both",
  791. "-glob",
  792. "-partial",
  793. "-recno",
  794. "-rmw",
  795. "-txn",
  796. "--",
  797. NULL
  798. };
  799. enum dbgetopts {
  800. #if CONFIG_TEST
  801. DBGET_DIRTY,
  802. DBGET_MULTI,
  803. #endif
  804. DBGET_CONSUME,
  805. DBGET_CONSUME_WAIT,
  806. DBGET_BOTH,
  807. DBGET_GLOB,
  808. DBGET_PART,
  809. DBGET_RECNO,
  810. DBGET_RMW,
  811. DBGET_TXN,
  812. DBGET_ENDARG
  813. };
  814. DBC *dbc;
  815. DBT key, pkey, data, save;
  816. DBTYPE type;
  817. DB_TXN *txn;
  818. Tcl_Obj **elemv, *retlist;
  819. void *dtmp, *ktmp;
  820. u_int32_t flag, cflag, isdup, mflag, rmw;
  821. int bufsize, elemc, end, endarg, freekey, freedata, i;
  822. int optindex, result, ret, useglob, useprecno, userecno;
  823. char *arg, *pattern, *prefix, msg[MSG_SIZE];
  824. db_recno_t precno, recno;
  826. result = TCL_OK;
  827. freekey = freedata = 0;
  828. cflag = endarg = flag = mflag = rmw = 0;
  829. useglob = userecno = useprecno = 0;
  830. txn = NULL;
  831. pattern = prefix = NULL;
  833. if (objc < 3) {
  834. Tcl_WrongNumArgs(interp, 2, objv, "?-args? key");
  835. return (TCL_ERROR);
  836. }
  838. memset(&key, 0, sizeof(key));
  839. memset(&data, 0, sizeof(data));
  840. memset(&save, 0, sizeof(save));
  842. /* For the primary key in a pget call. */
  843. memset(&pkey, 0, sizeof(pkey));
  845. /*
  846.  * Get the command name index from the object based on the options
  847.  * defined above.
  848.  */
  849. i = 2;
  850. (void)dbp->get_type(dbp, &type);
  851. end = objc;
  852. while (i < end) {
  853. if (Tcl_GetIndexFromObj(interp, objv[i], dbgetopts, "option",
  854.     TCL_EXACT, &optindex) != TCL_OK) {
  855. arg = Tcl_GetStringFromObj(objv[i], NULL);
  856. if (arg[0] == '-') {
  857. result = IS_HELP(objv[i]);
  858. goto out;
  859. } else
  860. Tcl_ResetResult(interp);
  861. break;
  862. }
  863. i++;
  864. switch ((enum dbgetopts)optindex) {
  865. #if CONFIG_TEST
  866. case DBGET_DIRTY:
  867. rmw |= DB_DIRTY_READ;
  868. break;
  869. case DBGET_MULTI:
  870. mflag |= DB_MULTIPLE;
  871. result = Tcl_GetIntFromObj(interp, objv[i], &bufsize);
  872. if (result != TCL_OK)
  873. goto out;
  874. i++;
  875. break;
  876. #endif
  877. case DBGET_BOTH:
  878. /*
  879.  * Change 'end' and make sure we aren't already past
  880.  * the new end.
  881.  */
  882. if (i > objc - 2) {
  883. Tcl_WrongNumArgs(interp, 2, objv,
  884.     "?-get_both key data?");
  885. result = TCL_ERROR;
  886. break;
  887. }
  888. end = objc - 2;
  889. FLAG_CHECK(flag);
  890. flag = DB_GET_BOTH;
  891. break;
  892. case DBGET_TXN:
  893. if (i >= end) {
  894. Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
  895. result = TCL_ERROR;
  896. break;
  897. }
  898. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  899. txn = NAME_TO_TXN(arg);
  900. if (txn == NULL) {
  901. snprintf(msg, MSG_SIZE,
  902.     "Get: Invalid txn: %sn", arg);
  903. Tcl_SetResult(interp, msg, TCL_VOLATILE);
  904. result = TCL_ERROR;
  905. }
  906. break;
  907. case DBGET_GLOB:
  908. useglob = 1;
  909. end = objc - 1;
  910. break;
  911. case DBGET_CONSUME:
  912. FLAG_CHECK(flag);
  913. flag = DB_CONSUME;
  914. break;
  915. case DBGET_CONSUME_WAIT:
  916. FLAG_CHECK(flag);
  917. flag = DB_CONSUME_WAIT;
  918. break;
  919. case DBGET_RECNO:
  920. end = objc - 1;
  921. userecno = 1;
  922. if (type != DB_RECNO && type != DB_QUEUE) {
  923. FLAG_CHECK(flag);
  924. flag = DB_SET_RECNO;
  925. }
  926. break;
  927. case DBGET_RMW:
  928. rmw |= DB_RMW;
  929. break;
  930. case DBGET_PART:
  931. end = objc - 1;
  932. if (i == end) {
  933. Tcl_WrongNumArgs(interp, 2, objv,
  934.     "?-partial {offset length}?");
  935. result = TCL_ERROR;
  936. break;
  937. }
  938. /*
  939.  * Get sublist as {offset length}
  940.  */
  941. result = Tcl_ListObjGetElements(interp, objv[i++],
  942.     &elemc, &elemv);
  943. if (elemc != 2) {
  944. Tcl_SetResult(interp,
  945.     "List must be {offset length}", TCL_STATIC);
  946. result = TCL_ERROR;
  947. break;
  948. }
  949. save.flags = DB_DBT_PARTIAL;
  950. result = _GetUInt32(interp, elemv[0], &save.doff);
  951. if (result != TCL_OK)
  952. break;
  953. result = _GetUInt32(interp, elemv[1], &save.dlen);
  954. /*
  955.  * NOTE: We don't check result here because all we'd
  956.  * do is break anyway, and we are doing that.  If you
  957.  * add code here, you WILL need to add the check
  958.  * for result.  (See the check for save.doff, a few
  959.  * lines above and copy that.)
  960.  */
  961. break;
  962. case DBGET_ENDARG:
  963. endarg = 1;
  964. break;
  965. } /* switch */
  966. if (result != TCL_OK)
  967. break;
  968. if (endarg)
  969. break;
  970. }
  971. if (result != TCL_OK)
  972. goto out;
  974. if (type == DB_RECNO || type == DB_QUEUE)
  975. userecno = 1;
  977. /*
  978.  * Check args we have left versus the flags we were given.
  979.  * We might have 0, 1 or 2 left.  If we have 0, it must
  980.  * be DB_CONSUME*, if 2, then DB_GET_BOTH, all others should
  981.  * be 1.
  982.  */
  983. if (((flag == DB_CONSUME || flag == DB_CONSUME_WAIT) && i != objc) ||
  984.     (flag == DB_GET_BOTH && i != objc - 2)) {
  985. Tcl_SetResult(interp,
  986.     "Wrong number of key/data given based on flags specifiedn",
  987.     TCL_STATIC);
  988. result = TCL_ERROR;
  989. goto out;
  990. } else if (flag == 0 && i != objc - 1) {
  991. Tcl_SetResult(interp,
  992.     "Wrong number of key/data givenn", TCL_STATIC);
  993. result = TCL_ERROR;
  994. goto out;
  995. }
  997. /*
  998.  * XXX
  999.  * We technically shouldn't be looking inside the dbp like this,
  1000.  * but this is the only way to figure out whether the primary
  1001.  * key should also be a recno.
  1002.  */
  1003. if (ispget) {
  1004. if (dbp->s_primary != NULL &&
  1005.     (dbp->s_primary->type == DB_RECNO ||
  1006.     dbp->s_primary->type == DB_QUEUE))
  1007. useprecno = 1;
  1008. }
  1010. /*
  1011.  * Check for illegal combos of options.
  1012.  */
  1013. if (useglob && (userecno || flag == DB_SET_RECNO ||
  1014.     type == DB_RECNO || type == DB_QUEUE)) {
  1015. Tcl_SetResult(interp,
  1016.     "Cannot use -glob and record numbers.n",
  1017.     TCL_STATIC);
  1018. result = TCL_ERROR;
  1019. goto out;
  1020. }
  1021. if (useglob && flag == DB_GET_BOTH) {
  1022. Tcl_SetResult(interp,
  1023.     "Only one of -glob or -get_both can be specified.n",
  1024.     TCL_STATIC);
  1025. result = TCL_ERROR;
  1026. goto out;
  1027. }
  1029. if (useglob)
  1030. pattern = Tcl_GetStringFromObj(objv[objc - 1], NULL);
  1032. /*
  1033.  * This is the list we return
  1034.  */
  1035. retlist = Tcl_NewListObj(0, NULL);
  1036. save.flags |= DB_DBT_MALLOC;
  1038. /*
  1039.  * isdup is used to know if we support duplicates.  If not, we
  1040.  * can just do a db->get call and avoid using cursors.
  1041.  * XXX
  1042.  * When there is a db->get_flags method, it should be used.
  1043.  * isdup = dbp->get_flags(dbp) & DB_DUP;
  1044.  * For now we illegally peek.
  1045.  * XXX
  1046.  */
  1047. isdup = dbp->flags & DB_AM_DUP;
  1049. /*
  1050.  * If the database doesn't support duplicates or we're performing
  1051.  * ops that don't require returning multiple items, use DB->get
  1052.  * instead of a cursor operation.
  1053.  */
  1054. if (pattern == NULL && (isdup == 0 || mflag != 0 ||
  1055.     flag == DB_SET_RECNO || flag == DB_GET_BOTH ||
  1056.     flag == DB_CONSUME || flag == DB_CONSUME_WAIT)) {
  1057. if (flag == DB_GET_BOTH) {
  1058. if (userecno) {
  1059. result = _GetUInt32(interp,
  1060.     objv[(objc - 2)], &recno);
  1061. if (result == TCL_OK) {
  1062. key.data = &recno;
  1063. key.size = sizeof(db_recno_t);
  1064. } else
  1065. goto out;
  1066. } else {
  1067. /*
  1068.  * Some get calls (SET_*) can change the
  1069.  * key pointers.  So, we need to store
  1070.  * the allocated key space in a tmp.
  1071.  */
  1072. ret = _CopyObjBytes(interp, objv[objc-2],
  1073.     &ktmp, &key.size, &freekey);
  1074. if (ret != 0) {
  1075. result = _ReturnSetup(interp, ret,
  1076.     DB_RETOK_DBGET(ret), "db get");
  1077. goto out;
  1078. }
  1079. key.data = ktmp;
  1080. }
  1081. /*
  1082.  * Already checked args above.  Fill in key and save.
  1083.  * Save is used in the dbp->get call below to fill in
  1084.  * data.
  1085.  *
  1086.  * If the "data" here is really a primary key--that
  1087.  * is, if we're in a pget--and that primary key
  1088.  * is a recno, treat it appropriately as an int.
  1089.  */
  1090. if (useprecno) {
  1091. result = _GetUInt32(interp,
  1092.     objv[objc - 1], &precno);
  1093. if (result == TCL_OK) {
  1094. save.data = &precno;
  1095. save.size = sizeof(db_recno_t);
  1096. } else
  1097. goto out;
  1098. } else {
  1099. ret = _CopyObjBytes(interp, objv[objc-1],
  1100.     &dtmp, &save.size, &freedata);
  1101. if (ret != 0) {
  1102. result = _ReturnSetup(interp, ret,
  1103.     DB_RETOK_DBGET(ret), "db get");
  1104. goto out;
  1105. }
  1106. save.data = dtmp;
  1107. }
  1108. } else if (flag != DB_CONSUME && flag != DB_CONSUME_WAIT) {
  1109. if (userecno) {
  1110. result = _GetUInt32(
  1111.     interp, objv[(objc - 1)], &recno);
  1112. if (result == TCL_OK) {
  1113. key.data = &recno;
  1114. key.size = sizeof(db_recno_t);
  1115. } else
  1116. goto out;
  1117. } else {
  1118. /*
  1119.  * Some get calls (SET_*) can change the
  1120.  * key pointers.  So, we need to store
  1121.  * the allocated key space in a tmp.
  1122.  */
  1123. ret = _CopyObjBytes(interp, objv[objc-1],
  1124.     &ktmp, &key.size, &freekey);
  1125. if (ret != 0) {
  1126. result = _ReturnSetup(interp, ret,
  1127.     DB_RETOK_DBGET(ret), "db get");
  1128. goto out;
  1129. }
  1130. key.data = ktmp;
  1131. }
  1132. if (mflag & DB_MULTIPLE) {
  1133. if ((ret = __os_malloc(dbp->dbenv,
  1134.     bufsize, &save.data)) != 0) {
  1135. Tcl_SetResult(interp,
  1136.     db_strerror(ret), TCL_STATIC);
  1137. goto out;
  1138. }
  1139. save.ulen = bufsize;
  1140. F_CLR(&save, DB_DBT_MALLOC);
  1141. F_SET(&save, DB_DBT_USERMEM);
  1142. }
  1143. }
  1145. data = save;
  1147. if (ispget) {
  1148. if (flag == DB_GET_BOTH) {
  1149. pkey.data = save.data;
  1150. pkey.size = save.size;
  1151. data.data = NULL;
  1152. data.size = 0;
  1153. }
  1154. F_SET(&pkey, DB_DBT_MALLOC);
  1155. _debug_check();
  1156. ret = dbp->pget(dbp,
  1157.     txn, &key, &pkey, &data, flag | rmw);
  1158. } else {
  1159. _debug_check();
  1160. ret = dbp->get(dbp,
  1161.     txn, &key, &data, flag | rmw | mflag);
  1162. }
  1163. result = _ReturnSetup(interp, ret, DB_RETOK_DBGET(ret),
  1164.     "db get");
  1165. if (ret == 0) {
  1166. /*
  1167.  * Success.  Return a list of the form {name value}
  1168.  * If it was a recno in key.data, we need to convert
  1169.  * into a string/object representation of that recno.
  1170.  */
  1171. if (mflag & DB_MULTIPLE)
  1172. result = _SetMultiList(interp,
  1173.     retlist, &key, &data, type, flag);
  1174. else if (type == DB_RECNO || type == DB_QUEUE)
  1175. if (ispget)
  1176. result = _Set3DBTList(interp,
  1177.     retlist, &key, 1, &pkey,
  1178.     useprecno, &data);
  1179. else
  1180. result = _SetListRecnoElem(interp,
  1181.     retlist, *(db_recno_t *)key.data,
  1182.     data.data, data.size);
  1183. else {
  1184. if (ispget)
  1185. result = _Set3DBTList(interp,
  1186.     retlist, &key, 0, &pkey,
  1187.     useprecno, &data);
  1188. else
  1189. result = _SetListElem(interp, retlist,
  1190.     key.data, key.size,
  1191.     data.data, data.size);
  1192. }
  1193. }
  1194. /*
  1195.  * Free space from DBT.
  1196.  *
  1197.  * If we set DB_DBT_MALLOC, we need to free the space if
  1198.  * and only if we succeeded (and thus if DB allocated
  1199.  * anything).  If DB_DBT_MALLOC is not set, this is a bulk
  1200.  * get buffer, and needs to be freed no matter what.
  1201.  */
  1202. if (F_ISSET(&data, DB_DBT_MALLOC) && ret == 0)
  1203. __os_ufree(dbp->dbenv, data.data);
  1204. else if (!F_ISSET(&data, DB_DBT_MALLOC))
  1205. __os_free(dbp->dbenv, data.data);
  1206. if (ispget && ret == 0)
  1207. __os_ufree(dbp->dbenv, pkey.data);
  1208. if (result == TCL_OK)
  1209. Tcl_SetObjResult(interp, retlist);
  1210. goto out;
  1211. }
  1213. if (userecno) {
  1214. result = _GetUInt32(interp, objv[(objc - 1)], &recno);
  1215. if (result == TCL_OK) {
  1216. key.data = &recno;
  1217. key.size = sizeof(db_recno_t);
  1218. } else
  1219. goto out;
  1220. } else {
  1221. /*
  1222.  * Some get calls (SET_*) can change the
  1223.  * key pointers.  So, we need to store
  1224.  * the allocated key space in a tmp.
  1225.  */
  1226. ret = _CopyObjBytes(interp, objv[objc-1], &ktmp,
  1227.     &key.size, &freekey);
  1228. if (ret != 0) {
  1229. result = _ReturnSetup(interp, ret,
  1230.     DB_RETOK_DBGET(ret), "db get");
  1231. return (result);
  1232. }
  1233. key.data = ktmp;
  1234. }
  1235. ret = dbp->cursor(dbp, txn, &dbc, 0);
  1236. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db cursor");
  1237. if (result == TCL_ERROR)
  1238. goto out;
  1240. /*
  1241.  * At this point, we have a cursor, if we have a pattern,
  1242.  * we go to the nearest one and step forward until we don't
  1243.  * have any more that match the pattern prefix.  If we have
  1244.  * an exact key, we go to that key position, and step through
  1245.  * all the duplicates.  In either case we build up a list of
  1246.  * the form {{key data} {key data}...} along the way.
  1247.  */
  1248. memset(&data, 0, sizeof(data));
  1249. /*
  1250.  * Restore any "partial" info we have saved.
  1251.  */
  1252. data = save;
  1253. if (pattern) {
  1254. /*
  1255.  * Note, prefix is returned in new space.  Must free it.
  1256.  */
  1257. ret = _GetGlobPrefix(pattern, &prefix);
  1258. if (ret) {
  1259. result = TCL_ERROR;
  1260. Tcl_SetResult(interp,
  1261.     "Unable to allocate pattern space", TCL_STATIC);
  1262. goto out1;
  1263. }
  1264. key.data = prefix;
  1265. key.size = strlen(prefix);
  1266. /*
  1267.  * If they give us an empty pattern string
  1268.  * (i.e. -glob *), go through entire DB.
  1269.  */
  1270. if (strlen(prefix) == 0)
  1271. cflag = DB_FIRST;
  1272. else
  1273. cflag = DB_SET_RANGE;
  1274. } else
  1275. cflag = DB_SET;
  1276. if (ispget) {
  1277. _debug_check();
  1278. F_SET(&pkey, DB_DBT_MALLOC);
  1279. ret = dbc->c_pget(dbc, &key, &pkey, &data, cflag | rmw);
  1280. } else {
  1281. _debug_check();
  1282. ret = dbc->c_get(dbc, &key, &data, cflag | rmw);
  1283. }
  1284. result = _ReturnSetup(interp, ret, DB_RETOK_DBCGET(ret),
  1285.     "db get (cursor)");
  1286. if (result == TCL_ERROR)
  1287. goto out1;
  1288. if (ret == 0 && pattern &&
  1289.     memcmp(key.data, prefix, strlen(prefix)) != 0) {
  1290. /*
  1291.  * Free space from DB_DBT_MALLOC
  1292.  */
  1293. free(data.data);
  1294. goto out1;
  1295. }
  1296. if (pattern)
  1297. cflag = DB_NEXT;
  1298.  else
  1299. cflag = DB_NEXT_DUP;
  1301. while (ret == 0 && result == TCL_OK) {
  1302. /*
  1303.  * Build up our {name value} sublist
  1304.  */
  1305. if (ispget)
  1306. result = _Set3DBTList(interp, retlist, &key, 0,
  1307.     &pkey, useprecno, &data);
  1308. else
  1309. result = _SetListElem(interp, retlist,
  1310.     key.data, key.size, data.data, data.size);
  1311. /*
  1312.  * Free space from DB_DBT_MALLOC
  1313.  */
  1314. if (ispget)
  1315. free(pkey.data);
  1316. free(data.data);
  1317. if (result != TCL_OK)
  1318. break;
  1319. /*
  1320.  * Append {name value} to return list
  1321.  */
  1322. memset(&key, 0, sizeof(key));
  1323. memset(&pkey, 0, sizeof(pkey));
  1324. memset(&data, 0, sizeof(data));
  1325. /*
  1326.  * Restore any "partial" info we have saved.
  1327.  */
  1328. data = save;
  1329. if (ispget) {
  1330. F_SET(&pkey, DB_DBT_MALLOC);
  1331. ret = dbc->c_pget(dbc, &key, &pkey, &data, cflag | rmw);
  1332. } else
  1333. ret = dbc->c_get(dbc, &key, &data, cflag | rmw);
  1334. if (ret == 0 && pattern &&
  1335.     memcmp(key.data, prefix, strlen(prefix)) != 0) {
  1336. /*
  1337.  * Free space from DB_DBT_MALLOC
  1338.  */
  1339. free(data.data);
  1340. break;
  1341. }
  1342. }
  1343. out1:
  1344. dbc->c_close(dbc);
  1345. if (result == TCL_OK)
  1346. Tcl_SetObjResult(interp, retlist);
  1347. out:
  1348. /*
  1349.  * _GetGlobPrefix(), the function which allocates prefix, works
  1350.  * by copying and condensing another string.  Thus prefix may
  1351.  * have multiple nuls at the end, so we free using __os_free().
  1352.  */
  1353. if (prefix != NULL)
  1354. __os_free(dbp->dbenv, prefix);
  1355. if (freedata)
  1356. (void)__os_free(dbp->dbenv, dtmp);
  1357. if (freekey)
  1358. (void)__os_free(dbp->dbenv, ktmp);
  1359. return (result);
  1360. }
  1362. /*
  1363.  * tcl_db_delete --
  1364.  */
  1365. static int
  1366. tcl_DbDelete(interp, objc, objv, dbp)
  1367. Tcl_Interp *interp; /* Interpreter */
  1368. int objc; /* How many arguments? */
  1369. Tcl_Obj *CONST objv[]; /* The argument objects */
  1370. DB *dbp; /* Database pointer */
  1371. {
  1372. static char *dbdelopts[] = {
  1373. "-auto_commit",
  1374. "-glob",
  1375. "-txn",
  1376. NULL
  1377. };
  1378. enum dbdelopts {
  1379. DBDEL_AUTO_COMMIT,
  1380. DBDEL_GLOB,
  1381. DBDEL_TXN
  1382. };
  1383. DBC *dbc;
  1384. DBT key, data;
  1385. DBTYPE type;
  1386. DB_TXN *txn;
  1387. void *ktmp;
  1388. db_recno_t recno;
  1389. int freekey, i, optindex, result, ret;
  1390. u_int32_t flag;
  1391. char *arg, *pattern, *prefix, msg[MSG_SIZE];
  1393. result = TCL_OK;
  1394. freekey = 0;
  1395. flag = 0;
  1396. pattern = prefix = NULL;
  1397. txn = NULL;
  1398. if (objc < 3) {
  1399. Tcl_WrongNumArgs(interp, 2, objv, "?-args? key");
  1400. return (TCL_ERROR);
  1401. }
  1403. memset(&key, 0, sizeof(key));
  1404. /*
  1405.  * The first arg must be -auto_commit, -glob, -txn or a list of keys.
  1406.  */
  1407. i = 2;
  1408. while (i < objc) {
  1409. if (Tcl_GetIndexFromObj(interp, objv[i], dbdelopts, "option",
  1410.     TCL_EXACT, &optindex) != TCL_OK) {
  1411. /*
  1412.  * If we don't have a -auto_commit, -glob or -txn,
  1413.  * then the remaining args must be exact keys.
  1414.  * Reset the result so we don't get an errant error
  1415.  * message if there is another error.
  1416.  */
  1417. if (IS_HELP(objv[i]) == TCL_OK)
  1418. return (TCL_OK);
  1419. Tcl_ResetResult(interp);
  1420. break;
  1421. }
  1422. i++;
  1423. switch ((enum dbdelopts)optindex) {
  1424. case DBDEL_TXN:
  1425. if (i == objc) {
  1426. /*
  1427.  * Someone could conceivably have a key of
  1428.  * the same name.  So just break and use it.
  1429.  */
  1430. i--;
  1431. break;
  1432. }
  1433. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  1434. txn = NAME_TO_TXN(arg);
  1435. if (txn == NULL) {
  1436. snprintf(msg, MSG_SIZE,
  1437.     "Delete: Invalid txn: %sn", arg);
  1438. Tcl_SetResult(interp, msg, TCL_VOLATILE);
  1439. result = TCL_ERROR;
  1440. }
  1441. break;
  1442. case DBDEL_AUTO_COMMIT:
  1443. flag |= DB_AUTO_COMMIT;
  1444. break;
  1445. case DBDEL_GLOB:
  1446. /*
  1447.  * Get the pattern.  Get the prefix and use cursors to
  1448.  * get all the data items.
  1449.  */
  1450. if (i == objc) {
  1451. /*
  1452.  * Someone could conceivably have a key of
  1453.  * the same name.  So just break and use it.
  1454.  */
  1455. i--;
  1456. break;
  1457. }
  1458. pattern = Tcl_GetStringFromObj(objv[i++], NULL);
  1459. break;
  1460. }
  1461. if (result != TCL_OK)
  1462. break;
  1463. }
  1465. if (result != TCL_OK)
  1466. goto out;
  1467. /*
  1468.  * XXX
  1469.  * For consistency with get, we have decided for the moment, to
  1470.  * allow -glob, or one key, not many.  The code was originally
  1471.  * written to take many keys and we'll leave it that way, because
  1472.  * tcl_DbGet may one day accept many disjoint keys to get, rather
  1473.  * than one, and at that time we'd make delete be consistent.  In
  1474.  * any case, the code is already here and there is no need to remove,
  1475.  * just check that we only have one arg left.
  1476.  *
  1477.  * If we have a pattern AND more keys to process, there is an error.
  1478.  * Either we have some number of exact keys, or we have a pattern.
  1479.  *
  1480.  * If we have a pattern and an auto commit flag, there is an error.
  1481.  */
  1482. if (pattern == NULL) {
  1483. if (i != (objc - 1)) {
  1484. Tcl_WrongNumArgs(
  1485.     interp, 2, objv, "?args? -glob pattern | key");
  1486. result = TCL_ERROR;
  1487. goto out;
  1488. }
  1489. } else {
  1490. if (i != objc) {
  1491. Tcl_WrongNumArgs(
  1492.     interp, 2, objv, "?args? -glob pattern | key");
  1493. result = TCL_ERROR;
  1494. goto out;
  1495. }
  1496. if (flag & DB_AUTO_COMMIT) {
  1497. Tcl_SetResult(interp,
  1498.     "Cannot use -auto_commit and patterns.n",
  1499.     TCL_STATIC);
  1500. result = TCL_ERROR;
  1501. goto out;
  1502. }
  1503. }
  1505. /*
  1506.  * If we have remaining args, they are all exact keys.  Call
  1507.  * DB->del on each of those keys.
  1508.  *
  1509.  * If it is a RECNO database, the key is a record number and must be
  1510.  * setup up to contain a db_recno_t.  Otherwise the key is a "string".
  1511.  */
  1512. (void)dbp->get_type(dbp, &type);
  1513. ret = 0;
  1514. while (i < objc && ret == 0) {
  1515. memset(&key, 0, sizeof(key));
  1516. if (type == DB_RECNO || type == DB_QUEUE) {
  1517. result = _GetUInt32(interp, objv[i++], &recno);
  1518. if (result == TCL_OK) {
  1519. key.data = &recno;
  1520. key.size = sizeof(db_recno_t);
  1521. } else
  1522. return (result);
  1523. } else {
  1524. ret = _CopyObjBytes(interp, objv[i++], &ktmp,
  1525.     &key.size, &freekey);
  1526. if (ret != 0) {
  1527. result = _ReturnSetup(interp, ret,
  1528.     DB_RETOK_DBDEL(ret), "db del");
  1529. return (result);
  1530. }
  1531. key.data = ktmp;
  1532. }
  1533. _debug_check();
  1534. ret = dbp->del(dbp, txn, &key, flag);
  1535. /*
  1536.  * If we have any error, set up return result and stop
  1537.  * processing keys.
  1538.  */
  1539. if (freekey)
  1540. (void)__os_free(dbp->dbenv, ktmp);
  1541. if (ret != 0)
  1542. break;
  1543. }
  1544. result = _ReturnSetup(interp, ret, DB_RETOK_DBDEL(ret), "db del");
  1546. /*
  1547.  * At this point we've either finished or, if we have a pattern,
  1548.  * we go to the nearest one and step forward until we don't
  1549.  * have any more that match the pattern prefix.
  1550.  */
  1551. if (pattern) {
  1552. ret = dbp->cursor(dbp, txn, &dbc, 0);
  1553. if (ret != 0) {
  1554. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  1555.     "db cursor");
  1556. goto out;
  1557. }
  1558. /*
  1559.  * Note, prefix is returned in new space.  Must free it.
  1560.  */
  1561. memset(&key, 0, sizeof(key));
  1562. memset(&data, 0, sizeof(data));
  1563. ret = _GetGlobPrefix(pattern, &prefix);
  1564. if (ret) {
  1565. result = TCL_ERROR;
  1566. Tcl_SetResult(interp,
  1567.     "Unable to allocate pattern space", TCL_STATIC);
  1568. goto out;
  1569. }
  1570. key.data = prefix;
  1571. key.size = strlen(prefix);
  1572. if (strlen(prefix) == 0)
  1573. flag = DB_FIRST;
  1574. else
  1575. flag = DB_SET_RANGE;
  1576. ret = dbc->c_get(dbc, &key, &data, flag);
  1577. while (ret == 0 &&
  1578.     memcmp(key.data, prefix, strlen(prefix)) == 0) {
  1579. /*
  1580.  * Each time through here the cursor is pointing
  1581.  * at the current valid item.  Delete it and
  1582.  * move ahead.
  1583.  */
  1584. _debug_check();
  1585. ret = dbc->c_del(dbc, 0);
  1586. if (ret != 0) {
  1587. result = _ReturnSetup(interp, ret,
  1588.     DB_RETOK_DBCDEL(ret), "db c_del");
  1589. break;
  1590. }
  1591. /*
  1592.  * Deleted the current, now move to the next item
  1593.  * in the list, check if it matches the prefix pattern.
  1594.  */
  1595. memset(&key, 0, sizeof(key));
  1596. memset(&data, 0, sizeof(data));
  1597. ret = dbc->c_get(dbc, &key, &data, DB_NEXT);
  1598. }
  1599. if (ret == DB_NOTFOUND)
  1600. ret = 0;
  1601. /*
  1602.  * _GetGlobPrefix(), the function which allocates prefix, works
  1603.  * by copying and condensing another string.  Thus prefix may
  1604.  * have multiple nuls at the end, so we free using __os_free().
  1605.  */
  1606. __os_free(dbp->dbenv, prefix);
  1607. dbc->c_close(dbc);
  1608. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db del");
  1609. }
  1610. out:
  1611. return (result);
  1612. }
  1614. /*
  1615.  * tcl_db_cursor --
  1616.  */
  1617. static int
  1618. tcl_DbCursor(interp, objc, objv, dbp, dbcp)
  1619. Tcl_Interp *interp; /* Interpreter */
  1620. int objc; /* How many arguments? */
  1621. Tcl_Obj *CONST objv[]; /* The argument objects */
  1622. DB *dbp; /* Database pointer */
  1623. DBC **dbcp; /* Return cursor pointer */
  1624. {
  1625. static char *dbcuropts[] = {
  1626. #if CONFIG_TEST
  1627. "-dirty",
  1628. "-update",
  1629. #endif
  1630. "-txn",
  1631. NULL
  1632. };
  1633. enum dbcuropts {
  1634. #if CONFIG_TEST
  1635. DBCUR_DIRTY,
  1636. DBCUR_UPDATE,
  1637. #endif
  1638. DBCUR_TXN
  1639. };
  1640. DB_TXN *txn;
  1641. u_int32_t flag;
  1642. int i, optindex, result, ret;
  1643. char *arg, msg[MSG_SIZE];
  1645. result = TCL_OK;
  1646. flag = 0;
  1647. txn = NULL;
  1648. i = 2;
  1649. while (i < objc) {
  1650. if (Tcl_GetIndexFromObj(interp, objv[i], dbcuropts, "option",
  1651.     TCL_EXACT, &optindex) != TCL_OK) {
  1652. result = IS_HELP(objv[i]);
  1653. goto out;
  1654. }
  1655. i++;
  1656. switch ((enum dbcuropts)optindex) {
  1657. #if CONFIG_TEST
  1658. case DBCUR_DIRTY:
  1659. flag |= DB_DIRTY_READ;
  1660. break;
  1661. case DBCUR_UPDATE:
  1662. flag |= DB_WRITECURSOR;
  1663. break;
  1664. #endif
  1665. case DBCUR_TXN:
  1666. if (i == objc) {
  1667. Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
  1668. result = TCL_ERROR;
  1669. break;
  1670. }
  1671. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  1672. txn = NAME_TO_TXN(arg);
  1673. if (txn == NULL) {
  1674. snprintf(msg, MSG_SIZE,
  1675.     "Cursor: Invalid txn: %sn", arg);
  1676. Tcl_SetResult(interp, msg, TCL_VOLATILE);
  1677. result = TCL_ERROR;
  1678. }
  1679. break;
  1680. }
  1681. if (result != TCL_OK)
  1682. break;
  1683. }
  1684. if (result != TCL_OK)
  1685. goto out;
  1687. _debug_check();
  1688. ret = dbp->cursor(dbp, txn, dbcp, flag);
  1689. if (ret != 0)
  1690. result = _ErrorSetup(interp, ret, "db cursor");
  1691. out:
  1692. return (result);
  1693. }
  1695. /*
  1696.  * tcl_DbAssociate --
  1697.  * Call DB->associate().
  1698.  */
  1699. static int
  1700. tcl_DbAssociate(interp, objc, objv, dbp)
  1701. Tcl_Interp *interp;
  1702. int objc;
  1703. Tcl_Obj *CONST objv[];
  1704. DB *dbp;
  1705. {
  1706. static char *dbaopts[] = {
  1707. "-auto_commit",
  1708. "-create",
  1709. "-txn",
  1710. NULL
  1711. };
  1712. enum dbaopts {
  1713. DBA_AUTO_COMMIT,
  1714. DBA_CREATE,
  1715. DBA_TXN
  1716. };
  1717. DB *sdbp;
  1718. DB_TXN *txn;
  1719. DBTCL_INFO *sdbip;
  1720. int i, optindex, result, ret;
  1721. char *arg, msg[MSG_SIZE];
  1722. u_int32_t flag;
  1724. txn = NULL;
  1725. result = TCL_OK;
  1726. flag = 0;
  1727. if (objc < 2) {
  1728. Tcl_WrongNumArgs(interp, 2, objv, "[callback] secondary");
  1729. return (TCL_ERROR);
  1730. }
  1732. i = 2;
  1733. while (i < objc) {
  1734. if (Tcl_GetIndexFromObj(interp, objv[i], dbaopts, "option",
  1735.     TCL_EXACT, &optindex) != TCL_OK) {
  1736. result = IS_HELP(objv[i]);
  1737. if (result == TCL_OK)
  1738. return (result);
  1739. result = TCL_OK;
  1740. Tcl_ResetResult(interp);
  1741. break;
  1742. }
  1743. i++;
  1744. switch ((enum dbaopts)optindex) {
  1745. case DBA_AUTO_COMMIT:
  1746. flag |= DB_AUTO_COMMIT;
  1747. break;
  1748. case DBA_CREATE:
  1749. flag |= DB_CREATE;
  1750. break;
  1751. case DBA_TXN:
  1752. if (i > (objc - 1)) {
  1753. Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
  1754. result = TCL_ERROR;
  1755. break;
  1756. }
  1757. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  1758. txn = NAME_TO_TXN(arg);
  1759. if (txn == NULL) {
  1760. snprintf(msg, MSG_SIZE,
  1761.     "Associate: Invalid txn: %sn", arg);
  1762. Tcl_SetResult(interp, msg, TCL_VOLATILE);
  1763. result = TCL_ERROR;
  1764. }
  1765. break;
  1766. }
  1767. }
  1768. if (result != TCL_OK)
  1769. return (result);
  1771. /*
  1772.  * Better be 1 or 2 args left.  The last arg must be the sdb
  1773.  * handle.  If 2 args then objc-2 is the callback proc, else
  1774.  * we have a NULL callback.
  1775.  */
  1776. /* Get the secondary DB handle. */
  1777. arg = Tcl_GetStringFromObj(objv[objc - 1], NULL);
  1778. sdbp = NAME_TO_DB(arg);
  1779. if (sdbp == NULL) {
  1780. snprintf(msg, MSG_SIZE,
  1781.     "Associate: Invalid database handle: %sn", arg);
  1782. Tcl_SetResult(interp, msg, TCL_VOLATILE);
  1783. return (TCL_ERROR);
  1784. }
  1786. /*
  1787.  * The callback is simply a Tcl object containing the name
  1788.  * of the callback proc, which is the second-to-last argument.
  1789.  *
  1790.  * Note that the callback needs to go in the *secondary* DB handle's
  1791.  * info struct;  we may have multiple secondaries with different
  1792.  * callbacks.
  1793.  */
  1794. sdbip = (DBTCL_INFO *)sdbp->api_internal;
  1795. if (i != objc - 1) {
  1796. /*
  1797.  * We have 2 args, get the callback.
  1798.  */
  1799. sdbip->i_second_call = objv[objc - 2];
  1800. Tcl_IncrRefCount(sdbip->i_second_call);
  1802. /* Now call associate. */
  1803. _debug_check();
  1804. ret = dbp->associate(dbp, txn, sdbp, tcl_second_call, flag);
  1805. } else {
  1806. /*
  1807.  * We have a NULL callback.
  1808.  */
  1809. sdbip->i_second_call = NULL;
  1810. ret = dbp->associate(dbp, txn, sdbp, NULL, flag);
  1811. }
  1812. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "associate");
  1814. return (result);
  1815. }
  1817. /*
  1818.  * tcl_second_call --
  1819.  * Callback function for secondary indices.  Get the callback
  1820.  * out of ip->i_second_call and call it.
  1821.  */
  1822. static int
  1823. tcl_second_call(dbp, pkey, data, skey)
  1824. DB *dbp;
  1825. const DBT *pkey, *data;
  1826. DBT *skey;
  1827. {
  1828. DBTCL_INFO *ip;
  1829. Tcl_Interp *interp;
  1830. Tcl_Obj *pobj, *dobj, *objv[3];
  1831. int len, result, ret;
  1832. void *retbuf, *databuf;
  1834. ip = (DBTCL_INFO *)dbp->api_internal;
  1835. interp = ip->i_interp;
  1836. objv[0] = ip->i_second_call;
  1838. /*
  1839.  * Create two ByteArray objects, with the contents of the pkey
  1840.  * and data DBTs that are our inputs.
  1841.  */
  1842. pobj = Tcl_NewByteArrayObj(pkey->data, pkey->size);
  1843. Tcl_IncrRefCount(pobj);
  1844. dobj = Tcl_NewByteArrayObj(data->data, data->size);
  1845. Tcl_IncrRefCount(dobj);
  1847. objv[1] = pobj;
  1848. objv[2] = dobj;
  1850. result = Tcl_EvalObjv(interp, 3, objv, 0);
  1852. Tcl_DecrRefCount(pobj);
  1853. Tcl_DecrRefCount(dobj);
  1855. if (result != TCL_OK) {
  1856. __db_err(dbp->dbenv,
  1857.     "Tcl callback function failed with code %d", result);
  1858. return (EINVAL);
  1859. }
  1861. retbuf =
  1862.     Tcl_GetByteArrayFromObj(Tcl_GetObjResult(interp), &len);
  1864. /*
  1865.  * retbuf is owned by Tcl; copy it into malloc'ed memory.
  1866.  * We need to use __os_umalloc rather than ufree because this will
  1867.  * be freed by DB using __os_ufree--the DB_DBT_APPMALLOC flag
  1868.  * tells DB to free application-allocated memory.
  1869.  */
  1870. if ((ret = __os_umalloc(dbp->dbenv, len, &databuf)) != 0)
  1871. return (ret);
  1872. memcpy(databuf, retbuf, len);
  1874. skey->data = databuf;
  1875. skey->size = len;
  1876. F_SET(skey, DB_DBT_APPMALLOC);
  1878. return (0);
  1879. }
  1881. /*
  1882.  * tcl_db_join --
  1883.  */
  1884. static int
  1885. tcl_DbJoin(interp, objc, objv, dbp, dbcp)
  1886. Tcl_Interp *interp; /* Interpreter */
  1887. int objc; /* How many arguments? */
  1888. Tcl_Obj *CONST objv[]; /* The argument objects */
  1889. DB *dbp; /* Database pointer */
  1890. DBC **dbcp; /* Cursor pointer */
  1891. {
  1892. static char *dbjopts[] = {
  1893. "-nosort",
  1894. NULL
  1895. };
  1896. enum dbjopts {
  1897. DBJ_NOSORT
  1898. };
  1899. DBC **listp;
  1900. u_int32_t flag;
  1901. int adj, i, j, optindex, size, result, ret;
  1902. char *arg, msg[MSG_SIZE];
  1904. result = TCL_OK;
  1905. flag = 0;
  1906. if (objc < 3) {
  1907. Tcl_WrongNumArgs(interp, 2, objv, "curs1 curs2 ...");
  1908. return (TCL_ERROR);
  1909. }
  1911. i = 2;
  1912. adj = i;
  1913. while (i < objc) {
  1914. if (Tcl_GetIndexFromObj(interp, objv[i], dbjopts, "option",
  1915.     TCL_EXACT, &optindex) != TCL_OK) {
  1916. result = IS_HELP(objv[i]);
  1917. if (result == TCL_OK)
  1918. return (result);
  1919. result = TCL_OK;
  1920. Tcl_ResetResult(interp);
  1921. break;
  1922. }
  1923. i++;
  1924. switch ((enum dbjopts)optindex) {
  1925. case DBJ_NOSORT:
  1926. flag |= DB_JOIN_NOSORT;
  1927. adj++;
  1928. break;
  1929. }
  1930. }
  1931. if (result != TCL_OK)
  1932. return (result);
  1933. /*
  1934.  * Allocate one more for NULL ptr at end of list.
  1935.  */
  1936. size = sizeof(DBC *) * ((objc - adj) + 1);
  1937. ret = __os_malloc(dbp->dbenv, size, &listp);
  1938. if (ret != 0) {
  1939. Tcl_SetResult(interp, db_strerror(ret), TCL_STATIC);
  1940. return (TCL_ERROR);
  1941. }
  1943. memset(listp, 0, size);
  1944. for (j = 0, i = adj; i < objc; i++, j++) {
  1945. arg = Tcl_GetStringFromObj(objv[i], NULL);
  1946. listp[j] = NAME_TO_DBC(arg);
  1947. if (listp[j] == NULL) {
  1948. snprintf(msg, MSG_SIZE,
  1949.     "Join: Invalid cursor: %sn", arg);
  1950. Tcl_SetResult(interp, msg, TCL_VOLATILE);
  1951. result = TCL_ERROR;
  1952. goto out;
  1953. }
  1954. }
  1955. listp[j] = NULL;
  1956. _debug_check();
  1957. ret = dbp->join(dbp, listp, dbcp, flag);
  1958. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db join");
  1960. out:
  1961. __os_free(dbp->dbenv, listp);
  1962. return (result);
  1963. }
  1965. /*
  1966.  * tcl_db_getjoin --
  1967.  */
  1968. static int
  1969. tcl_DbGetjoin(interp, objc, objv, dbp)
  1970. Tcl_Interp *interp; /* Interpreter */
  1971. int objc; /* How many arguments? */
  1972. Tcl_Obj *CONST objv[]; /* The argument objects */
  1973. DB *dbp; /* Database pointer */
  1974. {
  1975. static char *dbgetjopts[] = {
  1976. #if CONFIG_TEST
  1977. "-nosort",
  1978. #endif
  1979. "-txn",
  1980. NULL
  1981. };
  1982. enum dbgetjopts {
  1983. #if CONFIG_TEST
  1984. DBGETJ_NOSORT,
  1985. #endif
  1986. DBGETJ_TXN
  1987. };
  1988. DB_TXN *txn;
  1989. DB *elemdbp;
  1990. DBC **listp;
  1991. DBC *dbc;
  1992. DBT key, data;
  1993. Tcl_Obj **elemv, *retlist;
  1994. void *ktmp;
  1995. u_int32_t flag;
  1996. int adj, elemc, freekey, i, j, optindex, result, ret, size;
  1997. char *arg, msg[MSG_SIZE];
  1999. result = TCL_OK;
  2000. flag = 0;
  2001. freekey = 0;
  2002. if (objc < 3) {
  2003. Tcl_WrongNumArgs(interp, 2, objv, "{db1 key1} {db2 key2} ...");
  2004. return (TCL_ERROR);
  2005. }
  2007. txn = NULL;
  2008. i = 2;
  2009. adj = i;
  2010. while (i < objc) {
  2011. if (Tcl_GetIndexFromObj(interp, objv[i], dbgetjopts, "option",
  2012.     TCL_EXACT, &optindex) != TCL_OK) {
  2013. result = IS_HELP(objv[i]);
  2014. if (result == TCL_OK)
  2015. return (result);
  2016. result = TCL_OK;
  2017. Tcl_ResetResult(interp);
  2018. break;
  2019. }
  2020. i++;
  2021. switch ((enum dbgetjopts)optindex) {
  2022. #if CONFIG_TEST
  2023. case DBGETJ_NOSORT:
  2024. flag |= DB_JOIN_NOSORT;
  2025. adj++;
  2026. break;
  2027. #endif
  2028. case DBGETJ_TXN:
  2029. if (i == objc) {
  2030. Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
  2031. result = TCL_ERROR;
  2032. break;
  2033. }
  2034. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  2035. txn = NAME_TO_TXN(arg);
  2036. adj += 2;
  2037. if (txn == NULL) {
  2038. snprintf(msg, MSG_SIZE,
  2039.     "GetJoin: Invalid txn: %sn", arg);
  2040. Tcl_SetResult(interp, msg, TCL_VOLATILE);
  2041. result = TCL_ERROR;
  2042. }
  2043. break;
  2044. }
  2045. }
  2046. if (result != TCL_OK)
  2047. return (result);
  2048. size = sizeof(DBC *) * ((objc - adj) + 1);
  2049. ret = __os_malloc(NULL, size, &listp);
  2050. if (ret != 0) {
  2051. Tcl_SetResult(interp, db_strerror(ret), TCL_STATIC);
  2052. return (TCL_ERROR);
  2053. }
  2055. memset(listp, 0, size);
  2056. for (j = 0, i = adj; i < objc; i++, j++) {
  2057. /*
  2058.  * Get each sublist as {db key}
  2059.  */
  2060. result = Tcl_ListObjGetElements(interp, objv[i],
  2061.     &elemc, &elemv);
  2062. if (elemc != 2) {
  2063. Tcl_SetResult(interp, "Lists must be {db key}",
  2064.     TCL_STATIC);
  2065. result = TCL_ERROR;
  2066. goto out;
  2067. }
  2068. /*
  2069.  * Get a pointer to that open db.  Then, open a cursor in
  2070.  * that db, and go to the "key" place.
  2071.  */
  2072. elemdbp = NAME_TO_DB(Tcl_GetStringFromObj(elemv[0], NULL));
  2073. if (elemdbp == NULL) {
  2074. snprintf(msg, MSG_SIZE, "Get_join: Invalid db: %sn",
  2075.     Tcl_GetStringFromObj(elemv[0], NULL));
  2076. Tcl_SetResult(interp, msg, TCL_VOLATILE);
  2077. result = TCL_ERROR;
  2078. goto out;
  2079. }
  2080. ret = elemdbp->cursor(elemdbp, txn, &listp[j], 0);
  2081. if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  2082.     "db cursor")) == TCL_ERROR)
  2083. goto out;
  2084. memset(&key, 0, sizeof(key));
  2085. memset(&data, 0, sizeof(data));
  2086. ret = _CopyObjBytes(interp, elemv[elemc-1], &ktmp,
  2087.     &key.size, &freekey);
  2088. if (ret != 0) {
  2089. result = _ReturnSetup(interp, ret,
  2090.     DB_RETOK_STD(ret), "db join");
  2091. goto out;
  2092. }
  2093. key.data = ktmp;
  2094. ret = (listp[j])->c_get(listp[j], &key, &data, DB_SET);
  2095. if ((result = _ReturnSetup(interp, ret, DB_RETOK_DBCGET(ret),
  2096.     "db cget")) == TCL_ERROR)
  2097. goto out;
  2098. }
  2099. listp[j] = NULL;
  2100. _debug_check();
  2101. ret = dbp->join(dbp, listp, &dbc, flag);
  2102. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db join");
  2103. if (result == TCL_ERROR)
  2104. goto out;
  2106. retlist = Tcl_NewListObj(0, NULL);
  2107. while (ret == 0 && result == TCL_OK) {
  2108. memset(&key, 0, sizeof(key));
  2109. memset(&data, 0, sizeof(data));
  2110. key.flags |= DB_DBT_MALLOC;
  2111. data.flags |= DB_DBT_MALLOC;
  2112. ret = dbc->c_get(dbc, &key, &data, 0);
  2113. /*
  2114.  * Build up our {name value} sublist
  2115.  */
  2116. if (ret == 0) {
  2117. result = _SetListElem(interp, retlist,
  2118.     key.data, key.size,
  2119.     data.data, data.size);
  2120. free(key.data);
  2121. free(data.data);
  2122. }
  2123. }
  2124. dbc->c_close(dbc);
  2125. if (result == TCL_OK)
  2126. Tcl_SetObjResult(interp, retlist);
  2127. out:
  2128. if (freekey)
  2129. (void)__os_free(dbp->dbenv, ktmp);
  2130. while (j) {
  2131. if (listp[j])
  2132. (listp[j])->c_close(listp[j]);
  2133. j--;
  2134. }
  2135. __os_free(dbp->dbenv, listp);
  2136. return (result);
  2137. }
  2139. /*
  2140.  * tcl_DbCount --
  2141.  */
  2142. static int
  2143. tcl_DbCount(interp, objc, objv, dbp)
  2144. Tcl_Interp *interp; /* Interpreter */
  2145. int objc; /* How many arguments? */
  2146. Tcl_Obj *CONST objv[]; /* The argument objects */
  2147. DB *dbp; /* Database pointer */
  2148. {
  2149. Tcl_Obj *res;
  2150. DBC *dbc;
  2151. DBT key, data;
  2152. void *ktmp;
  2153. db_recno_t count, recno;
  2154. int freekey, result, ret;
  2156. result = TCL_OK;
  2157. count = 0;
  2158. freekey = 0;
  2159. res = NULL;
  2160. if (objc != 3) {
  2161. Tcl_WrongNumArgs(interp, 2, objv, "key");
  2162. return (TCL_ERROR);
  2163. }
  2165. memset(&key, 0, sizeof(key));
  2167. /*
  2168.  * Get the count for our key.
  2169.  * We do this by getting a cursor for this DB.  Moving the cursor
  2170.  * to the set location, and getting a count on that cursor.
  2171.  */
  2172. ret = 0;
  2173. memset(&key, 0, sizeof(key));
  2174. memset(&data, 0, sizeof(data));
  2175. /*
  2176.  * If it's a queue or recno database, we must make sure to
  2177.  * treat the key as a recno rather than as a byte string.
  2178.  */
  2179. if (dbp->type == DB_RECNO || dbp->type == DB_QUEUE) {
  2180. result = _GetUInt32(interp, objv[2], &recno);
  2181. if (result == TCL_OK) {
  2182. key.data = &recno;
  2183. key.size = sizeof(db_recno_t);
  2184. } else
  2185. return (result);
  2186. } else {
  2187. ret = _CopyObjBytes(interp, objv[2], &ktmp,
  2188.     &key.size, &freekey);
  2189. if (ret != 0) {
  2190. result = _ReturnSetup(interp, ret,
  2191.     DB_RETOK_STD(ret), "db count");
  2192. return (result);
  2193. }
  2194. key.data = ktmp;
  2195. }
  2196. _debug_check();
  2197. ret = dbp->cursor(dbp, NULL, &dbc, 0);
  2198. if (ret != 0) {
  2199. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  2200.     "db cursor");
  2201. goto out;
  2202. }
  2203. /*
  2204.  * Move our cursor to the key.
  2205.  */
  2206. ret = dbc->c_get(dbc, &key, &data, DB_SET);
  2207. if (ret == DB_NOTFOUND)
  2208. count = 0;
  2209. else {
  2210. ret = dbc->c_count(dbc, &count, 0);
  2211. if (ret != 0) {
  2212. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
  2213.     "db c count");
  2214. goto out;
  2215. }
  2216. }
  2217. res = Tcl_NewLongObj((long)count);
  2218. Tcl_SetObjResult(interp, res);
  2219. out:
  2220. if (freekey)
  2221. (void)__os_free(dbp->dbenv, ktmp);
  2222. (void)dbc->c_close(dbc);
  2223. return (result);
  2224. }
  2226. #if CONFIG_TEST
  2227. /*
  2228.  * tcl_DbKeyRange --
  2229.  */
  2230. static int
  2231. tcl_DbKeyRange(interp, objc, objv, dbp)
  2232. Tcl_Interp *interp; /* Interpreter */
  2233. int objc; /* How many arguments? */
  2234. Tcl_Obj *CONST objv[]; /* The argument objects */
  2235. DB *dbp; /* Database pointer */
  2236. {
  2237. static char *dbkeyropts[] = {
  2238. "-txn",
  2239. NULL
  2240. };
  2241. enum dbkeyropts {
  2242. DBKEYR_TXN
  2243. };
  2244. DB_TXN *txn;
  2245. DB_KEY_RANGE range;
  2246. DBT key;
  2247. DBTYPE type;
  2248. Tcl_Obj *myobjv[3], *retlist;
  2249. void *ktmp;
  2250. db_recno_t recno;
  2251. u_int32_t flag;
  2252. int freekey, i, myobjc, optindex, result, ret;
  2253. char *arg, msg[MSG_SIZE];
  2255. result = TCL_OK;
  2256. flag = 0;
  2257. freekey = 0;
  2258. if (objc < 3) {
  2259. Tcl_WrongNumArgs(interp, 2, objv, "?-txn id? key");
  2260. return (TCL_ERROR);
  2261. }
  2263. txn = NULL;
  2264. i = 2;
  2265. while (i < objc) {
  2266. if (Tcl_GetIndexFromObj(interp, objv[i], dbkeyropts, "option",
  2267.     TCL_EXACT, &optindex) != TCL_OK) {
  2268. result = IS_HELP(objv[i]);
  2269. if (result == TCL_OK)
  2270. return (result);
  2271. result = TCL_OK;
  2272. Tcl_ResetResult(interp);
  2273. break;
  2274. }
  2275. i++;
  2276. switch ((enum dbkeyropts)optindex) {
  2277. case DBKEYR_TXN:
  2278. if (i == objc) {
  2279. Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
  2280. result = TCL_ERROR;
  2281. break;
  2282. }
  2283. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  2284. txn = NAME_TO_TXN(arg);
  2285. if (txn == NULL) {
  2286. snprintf(msg, MSG_SIZE,
  2287.     "KeyRange: Invalid txn: %sn", arg);
  2288. Tcl_SetResult(interp, msg, TCL_VOLATILE);
  2289. result = TCL_ERROR;
  2290. }
  2291. break;
  2292. }
  2293. }
  2294. if (result != TCL_OK)
  2295. return (result);
  2296. (void)dbp->get_type(dbp, &type);
  2297. ret = 0;
  2298. /*
  2299.  * Make sure we have a key.
  2300.  */
  2301. if (i != (objc - 1)) {
  2302. Tcl_WrongNumArgs(interp, 2, objv, "?args? key");
  2303. result = TCL_ERROR;
  2304. goto out;
  2305. }
  2306. memset(&key, 0, sizeof(key));
  2307. if (type == DB_RECNO || type == DB_QUEUE) {
  2308. result = _GetUInt32(interp, objv[i], &recno);
  2309. if (result == TCL_OK) {
  2310. key.data = &recno;
  2311. key.size = sizeof(db_recno_t);
  2312. } else
  2313. return (result);
  2314. } else {
  2315. ret = _CopyObjBytes(interp, objv[i++], &ktmp,
  2316.     &key.size, &freekey);
  2317. if (ret != 0) {
  2318. result = _ReturnSetup(interp, ret,
  2319.     DB_RETOK_STD(ret), "db keyrange");
  2320. return (result);
  2321. }
  2322. key.data = ktmp;
  2323. }
  2324. _debug_check();
  2325. ret = dbp->key_range(dbp, txn, &key, &range, flag);
  2326. result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db keyrange");
  2327. if (result == TCL_ERROR)
  2328. goto out;
  2330. /*
  2331.  * If we succeeded, set up return list.
  2332.  */
  2333. myobjc = 3;
  2334. myobjv[0] = Tcl_NewDoubleObj(range.less);
  2335. myobjv[1] = Tcl_NewDoubleObj(range.equal);
  2336. myobjv[2] = Tcl_NewDoubleObj(range.greater);
  2337. retlist = Tcl_NewListObj(myobjc, myobjv);
  2338. if (result == TCL_OK)
  2339. Tcl_SetObjResult(interp, retlist);
  2340. out:
  2341. if (freekey)
  2342. (void)__os_free(dbp->dbenv, ktmp);
  2343. return (result);
  2344. }
  2345. #endif
  2347. /*
  2348.  * tcl_DbTruncate --
  2349.  */
  2350. static int
  2351. tcl_DbTruncate(interp, objc, objv, dbp)
  2352. Tcl_Interp *interp; /* Interpreter */
  2353. int objc; /* How many arguments? */
  2354. Tcl_Obj *CONST objv[]; /* The argument objects */
  2355. DB *dbp; /* Database pointer */
  2356. {
  2357. static char *dbcuropts[] = {
  2358. "-auto_commit",
  2359. "-txn",
  2360. NULL
  2361. };
  2362. enum dbcuropts {
  2363. DBTRUNC_AUTO_COMMIT,
  2364. DBTRUNC_TXN
  2365. };
  2366. DB_TXN *txn;
  2367. Tcl_Obj *res;
  2368. u_int32_t count, flag;
  2369. int i, optindex, result, ret;
  2370. char *arg, msg[MSG_SIZE];
  2372. txn = NULL;
  2373. flag = 0;
  2374. result = TCL_OK;
  2376. i = 2;
  2377. while (i < objc) {
  2378. if (Tcl_GetIndexFromObj(interp, objv[i], dbcuropts, "option",
  2379.     TCL_EXACT, &optindex) != TCL_OK) {
  2380. result = IS_HELP(objv[i]);
  2381. goto out;
  2382. }
  2383. i++;
  2384. switch ((enum dbcuropts)optindex) {
  2385. case DBTRUNC_AUTO_COMMIT:
  2386. flag |= DB_AUTO_COMMIT;
  2387. break;
  2388. case DBTRUNC_TXN:
  2389. if (i == objc) {
  2390. Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
  2391. result = TCL_ERROR;
  2392. break;
  2393. }
  2394. arg = Tcl_GetStringFromObj(objv[i++], NULL);
  2395. txn = NAME_TO_TXN(arg);
  2396. if (txn == NULL) {
  2397. snprintf(msg, MSG_SIZE,
  2398.     "Truncate: Invalid txn: %sn", arg);
  2399. Tcl_SetResult(interp, msg, TCL_VOLATILE);
  2400. result = TCL_ERROR;
  2401. }
  2402. break;
  2403. }
  2404. if (result != TCL_OK)
  2405. break;
  2406. }
  2407. if (result != TCL_OK)
  2408. goto out;
  2410. _debug_check();
  2411. ret = dbp->truncate(dbp, txn, &count, flag);
  2412. if (ret != 0)
  2413. result = _ErrorSetup(interp, ret, "db truncate");
  2415. else {
  2416. res = Tcl_NewLongObj((long)count);
  2417. Tcl_SetObjResult(interp, res);
  2418. }
  2419. out:
  2420. return (result);
  2421. }