1 /*-
2  * See the file LICENSE for redistribution information.
3  *
4  * Copyright (c) 1999, 2013 Oracle and/or its affiliates.  All rights reserved.
5  *
6  * $Id$
7  */
8 
9 #include "db_config.h"
10 
11 #include "db_int.h"
12 #ifdef HAVE_SYSTEM_INCLUDE_FILES
13 #include <tcl.h>
14 #endif
15 #include "dbinc/tcl_db.h"
16 
17 /*
18  * Prototypes for procedures defined later in this file:
19  */
20 static int tcl_DbcDel __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *));
21 static int tcl_DbcDup __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *));
22 static int tcl_DbcCompare __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *));
23 static int tcl_DbcGet __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *, int));
24 static int tcl_DbcHeapDel __P((Tcl_Interp *, DBC *));
25 static int tcl_DbcPut __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *));
26 
27 /*
28  * PUBLIC: int dbc_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*));
29  *
30  * dbc_cmd --
31  *	Implements the cursor command.
32  */
33 int
dbc_Cmd(clientData,interp,objc,objv)34 dbc_Cmd(clientData, interp, objc, objv)
35 	ClientData clientData;		/* Cursor handle */
36 	Tcl_Interp *interp;		/* Interpreter */
37 	int objc;			/* How many arguments? */
38 	Tcl_Obj *CONST objv[];		/* The argument objects */
39 {
40 	static const char *dbccmds[] = {
41 #ifdef CONFIG_TEST
42 		"pget",
43 #endif
44 		"close",
45 		"cmp",
46 		"del",
47 		"dup",
48 		"get",
49 		"put",
50 		NULL
51 	};
52 	enum dbccmds {
53 #ifdef CONFIG_TEST
54 		DBCPGET,
55 #endif
56 		DBCCLOSE,
57 		DBCCOMPARE,
58 		DBCDELETE,
59 		DBCDUP,
60 		DBCGET,
61 		DBCPUT
62 	};
63 	DBC *dbc;
64 	DBTCL_INFO *dbip;
65 	int cmdindex, result, ret;
66 
67 	Tcl_ResetResult(interp);
68 	dbc = (DBC *)clientData;
69 	dbip = _PtrToInfo((void *)dbc);
70 	result = TCL_OK;
71 
72 	if (objc <= 1) {
73 		Tcl_WrongNumArgs(interp, 1, objv, "command cmdargs");
74 		return (TCL_ERROR);
75 	}
76 	if (dbc == NULL) {
77 		Tcl_SetResult(interp, "NULL dbc pointer", TCL_STATIC);
78 		return (TCL_ERROR);
79 	}
80 	if (dbip == NULL) {
81 		Tcl_SetResult(interp, "NULL dbc info pointer", TCL_STATIC);
82 		return (TCL_ERROR);
83 	}
84 
85 	/*
86 	 * Get the command name index from the object based on the berkdbcmds
87 	 * defined above.
88 	 */
89 	if (Tcl_GetIndexFromObj(interp, objv[1], dbccmds, "command",
90 	    TCL_EXACT, &cmdindex) != TCL_OK)
91 		return (IS_HELP(objv[1]));
92 	switch ((enum dbccmds)cmdindex) {
93 #ifdef CONFIG_TEST
94 	case DBCPGET:
95 		result = tcl_DbcGet(interp, objc, objv, dbc, 1);
96 		break;
97 #endif
98 	case DBCCLOSE:
99 		/*
100 		 * No args for this.  Error if there are some.
101 		 */
102 		if (objc > 2) {
103 			Tcl_WrongNumArgs(interp, 2, objv, NULL);
104 			return (TCL_ERROR);
105 		}
106 		_debug_check();
107 		ret = dbc->close(dbc);
108 		result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
109 		    "dbc close");
110 		if (result == TCL_OK) {
111 			(void)Tcl_DeleteCommand(interp, dbip->i_name);
112 			_DeleteInfo(dbip);
113 		}
114 		break;
115 	case DBCCOMPARE:
116 		if (objc > 3) {
117 			Tcl_WrongNumArgs(interp, 3, objv, NULL);
118 			return (TCL_ERROR);
119 		}
120 		_debug_check();
121 		result = tcl_DbcCompare(interp, objc, objv, dbc);
122 		break;
123 	case DBCDELETE:
124 		result = tcl_DbcDel(interp, objc, objv, dbc);
125 		break;
126 	case DBCDUP:
127 		result = tcl_DbcDup(interp, objc, objv, dbc);
128 		break;
129 	case DBCGET:
130 		result = tcl_DbcGet(interp, objc, objv, dbc, 0);
131 		break;
132 	case DBCPUT:
133 		result = tcl_DbcPut(interp, objc, objv, dbc);
134 		break;
135 	}
136 	return (result);
137 }
138 
139 /*
140  * tcl_DbcHeapDel --
141  */
142 static int
tcl_DbcHeapDel(interp,dbc)143 tcl_DbcHeapDel(interp, dbc)
144 	Tcl_Interp *interp;
145 	DBC *dbc;
146 {
147 	DB *dbp, *hrdbp, *hsdbp;
148 	DBT hkey, key, tmpdata;
149 	DB_HEAP_RID rid;
150 	db_recno_t recno;
151 	int result, ret, t_ret;
152 
153 	dbp = dbc->dbp;
154 	hrdbp = ((DBTCL_INFO *)dbp->api_internal)->hrdbp;
155 	hsdbp = ((DBTCL_INFO *)dbp->api_internal)->hsdbp;
156 
157 	memset(&hkey, 0, sizeof(DBT));
158 	hkey.data = &rid;
159 	hkey.size = hkey.ulen = sizeof(DB_HEAP_RID);
160 	hkey.flags = DB_DBT_USERMEM;
161 	memset(&tmpdata, 0, sizeof(DBT));
162 	tmpdata.flags = DB_DBT_PARTIAL | DB_DBT_USERMEM;
163 	if ((t_ret = dbc->get(dbc, &hkey, &tmpdata, DB_CURRENT)) != 0) {
164 		ret = t_ret;
165 		goto err;
166 	}
167 
168 	memset(&key, 0, sizeof(DBT));
169 	key.data = &recno;
170 	key.size = key.ulen = sizeof(db_recno_t);
171 	key.flags = DB_DBT_USERMEM;
172 	if ((t_ret = hsdbp->pget(
173 	    hsdbp, dbc->txn, &hkey, &key, &tmpdata, 0)) != 0) {
174 		ret = t_ret;
175 		goto err;
176 	}
177 
178 	ret = dbc->del(dbc, 0);
179 	if ((t_ret = hrdbp->del(hrdbp, dbc->txn, &key, 0)) != 0 && ret == 0)
180 		ret = t_ret;
181 
182 err:	result = _ReturnSetup(
183 	    interp, ret, DB_RETOK_DBCDEL(ret), "dbc delete");
184 	return result;
185 }
186 
187 /*
188  * tcl_DbcPut --
189  */
190 static int
tcl_DbcPut(interp,objc,objv,dbc)191 tcl_DbcPut(interp, objc, objv, dbc)
192 	Tcl_Interp *interp;		/* Interpreter */
193 	int objc;			/* How many arguments? */
194 	Tcl_Obj *CONST objv[];		/* The argument objects */
195 	DBC *dbc;			/* Cursor pointer */
196 {
197 	static const char *dbcutopts[] = {
198 #ifdef CONFIG_TEST
199 		"-nodupdata",
200 #endif
201 		"-after",
202 		"-before",
203 		"-current",
204 		"-keyfirst",
205 		"-keylast",
206 		"-overwritedup",
207 		"-partial",
208 		NULL
209 	};
210 	enum dbcutopts {
211 #ifdef CONFIG_TEST
212 		DBCPUT_NODUPDATA,
213 #endif
214 		DBCPUT_AFTER,
215 		DBCPUT_BEFORE,
216 		DBCPUT_CURRENT,
217 		DBCPUT_KEYFIRST,
218 		DBCPUT_KEYLAST,
219 		DBCPUT_OVERWRITE_DUP,
220 		DBCPUT_PART
221 	};
222 	DB *thisdbp, *hrdbp, *hsdbp;
223 	DBT data, hkey, key, tmpdata;
224 	DBTCL_INFO *dbcip, *dbip;
225 	DBTYPE type;
226 	DB_HEAP_RID rid;
227 	Tcl_Obj **elemv, *res;
228 	void *dtmp, *ktmp;
229 	db_recno_t recno;
230 	u_int32_t flag;
231 	int elemc, freekey, freedata, i, optindex, result, ret;
232 
233 	COMPQUIET(dtmp, NULL);
234 	COMPQUIET(ktmp, NULL);
235 
236 	result = TCL_OK;
237 	flag = 0;
238 	freekey = freedata = 0;
239 
240 	if (objc < 2) {
241 		Tcl_WrongNumArgs(interp, 2, objv, "?-args? ?key?");
242 		return (TCL_ERROR);
243 	}
244 
245 	memset(&key, 0, sizeof(key));
246 	memset(&data, 0, sizeof(data));
247 	memset(&hkey, 0, sizeof(hkey));
248 
249 	/*
250 	 * Get the command name index from the object based on the options
251 	 * defined above.
252 	 */
253 	i = 2;
254 	while (i < (objc - 1)) {
255 		if (Tcl_GetIndexFromObj(interp, objv[i], dbcutopts, "option",
256 		    TCL_EXACT, &optindex) != TCL_OK) {
257 			/*
258 			 * Reset the result so we don't get
259 			 * an errant error message if there is another error.
260 			 */
261 			if (IS_HELP(objv[i]) == TCL_OK) {
262 				result = TCL_OK;
263 				goto out;
264 			}
265 			Tcl_ResetResult(interp);
266 			break;
267 		}
268 		i++;
269 		switch ((enum dbcutopts)optindex) {
270 #ifdef CONFIG_TEST
271 		case DBCPUT_NODUPDATA:
272 			FLAG_CHECK(flag);
273 			flag = DB_NODUPDATA;
274 			break;
275 #endif
276 		case DBCPUT_AFTER:
277 			FLAG_CHECK(flag);
278 			flag = DB_AFTER;
279 			break;
280 		case DBCPUT_BEFORE:
281 			FLAG_CHECK(flag);
282 			flag = DB_BEFORE;
283 			break;
284 		case DBCPUT_CURRENT:
285 			FLAG_CHECK(flag);
286 			flag = DB_CURRENT;
287 			break;
288 		case DBCPUT_KEYFIRST:
289 			FLAG_CHECK(flag);
290 			flag = DB_KEYFIRST;
291 			break;
292 		case DBCPUT_KEYLAST:
293 			FLAG_CHECK(flag);
294 			flag = DB_KEYLAST;
295 			break;
296 		case DBCPUT_OVERWRITE_DUP:
297 			FLAG_CHECK(flag);
298 			flag = DB_OVERWRITE_DUP;
299 			break;
300 		case DBCPUT_PART:
301 			if (i > (objc - 2)) {
302 				Tcl_WrongNumArgs(interp, 2, objv,
303 				    "?-partial {offset length}?");
304 				result = TCL_ERROR;
305 				break;
306 			}
307 			/*
308 			 * Get sublist as {offset length}
309 			 */
310 			result = Tcl_ListObjGetElements(interp, objv[i++],
311 			    &elemc, &elemv);
312 			if (elemc != 2) {
313 				Tcl_SetResult(interp,
314 				    "List must be {offset length}", TCL_STATIC);
315 				result = TCL_ERROR;
316 				break;
317 			}
318 			data.flags |= DB_DBT_PARTIAL;
319 			result = _GetUInt32(interp, elemv[0], &data.doff);
320 			if (result != TCL_OK)
321 				break;
322 			result = _GetUInt32(interp, elemv[1], &data.dlen);
323 			/*
324 			 * NOTE: We don't check result here because all we'd
325 			 * do is break anyway, and we are doing that.  If you
326 			 * add code here, you WILL need to add the check
327 			 * for result.  (See the check for save.doff, a few
328 			 * lines above and copy that.)
329 			 */
330 		}
331 		if (result != TCL_OK)
332 			break;
333 	}
334 	if (result != TCL_OK)
335 		goto out;
336 
337 	/*
338 	 * We need to determine if we are a recno database or not.  If we are,
339 	 * then key.data is a recno, not a string.
340 	 */
341 	dbcip = _PtrToInfo(dbc);
342 	if (dbcip == NULL) {
343 		type = DB_UNKNOWN;
344 		thisdbp = NULL;
345 	} else {
346 		dbip = dbcip->i_parent;
347 		if (dbip == NULL) {
348 			Tcl_SetResult(interp, "Cursor without parent database",
349 			    TCL_STATIC);
350 			result = TCL_ERROR;
351 			return (result);
352 		}
353 		thisdbp = dbip->i_dbp;
354 		(void)thisdbp->get_type(thisdbp, &type);
355 	}
356 	/*
357 	 * When we get here, we better have:
358 	 * 1 arg if -after, -before or -current
359 	 * 2 args in all other cases
360 	 */
361 	if (flag == DB_AFTER || flag == DB_BEFORE || flag == DB_CURRENT) {
362 		if (i != (objc - 1)) {
363 			Tcl_WrongNumArgs(interp, 2, objv,
364 			    "?-args? data");
365 			result = TCL_ERROR;
366 			goto out;
367 		}
368 		/*
369 		 * We want to get the key back, so we need to set
370 		 * up the location to get it back in.
371 		 */
372 		if (type == DB_RECNO || type == DB_QUEUE) {
373 			recno = 0;
374 			key.data = &recno;
375 			key.size = sizeof(db_recno_t);
376 		}
377 	} else {
378 		if (i != (objc - 2)) {
379 			Tcl_WrongNumArgs(interp, 2, objv,
380 			    "?-args? key data");
381 			result = TCL_ERROR;
382 			goto out;
383 		}
384 		if (type == DB_HEAP || type == DB_RECNO || type == DB_QUEUE) {
385 			result = _GetUInt32(interp, objv[objc-2], &recno);
386 			if (result == TCL_OK) {
387 				key.data = &recno;
388 				key.size = sizeof(db_recno_t);
389 			} else
390 				return (result);
391 		} else {
392 			ret = _CopyObjBytes(interp, objv[objc-2], &ktmp,
393 			    &key.size, &freekey);
394 			if (ret != 0) {
395 				result = _ReturnSetup(interp, ret,
396 				    DB_RETOK_DBCPUT(ret), "dbc put");
397 				return (result);
398 			}
399 			key.data = ktmp;
400 		}
401 	}
402 	ret = _CopyObjBytes(interp, objv[objc-1], &dtmp,
403 	    &data.size, &freedata);
404 	data.data = dtmp;
405 	if (ret != 0) {
406 		result = _ReturnSetup(interp, ret,
407 		    DB_RETOK_DBCPUT(ret), "dbc put");
408 		goto out;
409 	}
410 	_debug_check();
411 	if (type != DB_HEAP) {
412 		ret = dbc->put(dbc, &key, &data, flag);
413 		result = _ReturnSetup(interp, ret, DB_RETOK_DBCPUT(ret),
414 	    	    "dbc put");
415 	} else {
416 		hkey.data = &rid;
417 		hkey.ulen = hkey.size = sizeof(DB_HEAP_RID);
418 		hkey.flags = DB_DBT_USERMEM;
419 		hrdbp = ((DBTCL_INFO *)thisdbp->api_internal)->hrdbp;
420 		if (flag != DB_CURRENT) {
421 			/* Given a recno, need to find the associated RID. */
422 			ret = hrdbp->get(hrdbp, dbc->txn, &key, &hkey, 0);
423 			result = _ReturnSetup(interp,
424 			    ret, DB_RETOK_DBGET(ret), "db get recno");
425 		} else {
426 			/* We have neither RID nor recno, but need both. */
427 			memset(&tmpdata, 0, sizeof(DBT));
428 			tmpdata.dlen = 0;
429 			tmpdata.flags = DB_DBT_PARTIAL | DB_DBT_USERMEM;
430 			ret = dbc->get(dbc, &hkey, &tmpdata, DB_CURRENT);
431 			result = _ReturnSetup(interp,
432 			    ret, DB_RETOK_DBGET(ret), "dbc get");
433 
434 			hsdbp = ((DBTCL_INFO *)thisdbp->api_internal)->hsdbp;
435 			key.data = &recno;
436 			key.ulen = sizeof(db_recno_t);
437 			key.flags = DB_DBT_USERMEM;
438 			ret = hsdbp->pget(hsdbp,
439 			    dbc->txn, &hkey, &key, &tmpdata, 0);
440 			result = _ReturnSetup(interp,
441 			    ret, DB_RETOK_DBGET(ret), "db pget rid");
442 		}
443 
444 		/* Do the put in the heap db first */
445 		ret = dbc->put(dbc, &hkey, &data, flag);
446 		if (ret) {
447 			result = _ReturnSetup(interp,
448 			    ret, DB_RETOK_DBCPUT(ret), "dbc put");
449 			goto out;
450 		}
451 
452 		hkey.flags = DB_DBT_USERMEM;
453 		ret = hrdbp->put(hrdbp, dbc->txn, &key, &hkey, 0);
454 		result = _ReturnSetup(interp,
455 		    ret, DB_RETOK_DBCPUT(ret), "dbc put recno");
456 
457 		/*
458 		 * To keep the consistency, if the put in recno db fails,
459 		 * the current key and data will be removed from the heap db.
460 		 */
461 		if (dbc->txn == NULL && ret != 0)
462 			(void)thisdbp->del(thisdbp, NULL, &hkey, 0);
463 	}
464 	if (ret == 0 &&
465 	    (flag == DB_AFTER || flag == DB_BEFORE) &&
466 	    (type == DB_RECNO || type == DB_HEAP)) {
467 		res = Tcl_NewWideIntObj((Tcl_WideInt)*(db_recno_t *)key.data);
468 		Tcl_SetObjResult(interp, res);
469 	}
470 out:
471 	if (freedata)
472 		__os_free(NULL, dtmp);
473 	if (freekey)
474 		__os_free(NULL, ktmp);
475 	return (result);
476 }
477 
478 /*
479  * tcl_dbc_get --
480  */
481 static int
tcl_DbcGet(interp,objc,objv,dbc,ispget)482 tcl_DbcGet(interp, objc, objv, dbc, ispget)
483 	Tcl_Interp *interp;		/* Interpreter */
484 	int objc;			/* How many arguments? */
485 	Tcl_Obj *CONST objv[];		/* The argument objects */
486 	DBC *dbc;			/* Cursor pointer */
487 	int ispget;			/* 1 for pget, 0 for get */
488 {
489 	static const char *dbcgetopts[] = {
490 #ifdef CONFIG_TEST
491 		"-data_buf_size",
492 		"-get_both_range",
493 		"-key_buf_size",
494 		"-multi",
495 		"-multi_key",
496 		"-nolease",
497 		"-read_committed",
498 		"-read_uncommitted",
499 #endif
500 		"-current",
501 		"-first",
502 		"-get_both",
503 		"-get_recno",
504 		"-join_item",
505 		"-last",
506 		"-next",
507 		"-nextdup",
508 		"-nextnodup",
509 		"-partial",
510 		"-prev",
511 		"-prevdup",
512 		"-prevnodup",
513 		"-rmw",
514 		"-set",
515 		"-set_range",
516 		"-set_recno",
517 		NULL
518 	};
519 	enum dbcgetopts {
520 #ifdef CONFIG_TEST
521 		DBCGET_DATA_BUF_SIZE,
522 		DBCGET_BOTH_RANGE,
523 		DBCGET_KEY_BUF_SIZE,
524 		DBCGET_MULTI,
525 		DBCGET_MULTI_KEY,
526 		DBCGET_NOLEASE,
527 		DBCGET_READ_COMMITTED,
528 		DBCGET_READ_UNCOMMITTED,
529 #endif
530 		DBCGET_CURRENT,
531 		DBCGET_FIRST,
532 		DBCGET_BOTH,
533 		DBCGET_RECNO,
534 		DBCGET_JOIN,
535 		DBCGET_LAST,
536 		DBCGET_NEXT,
537 		DBCGET_NEXTDUP,
538 		DBCGET_NEXTNODUP,
539 		DBCGET_PART,
540 		DBCGET_PREV,
541 		DBCGET_PREVDUP,
542 		DBCGET_PREVNODUP,
543 		DBCGET_RMW,
544 		DBCGET_SET,
545 		DBCGET_SETRANGE,
546 		DBCGET_SETRECNO
547 	};
548 	DB *hrdbp, *hsdbp, *pdbp, *phrdbp, *phsdbp, *thisdbp;
549 	DB_HEAP_RID rid;
550 	DBT hkey, key, data, pdata, rkey, rdata, tmpdata;
551 	DBTCL_INFO *dbcip, *dbip;
552 	DBTYPE ptype, type;
553 	Tcl_Obj **elemv, *myobj, *retlist;
554 	void *dtmp, *ktmp;
555 	db_recno_t precno, recno;
556 	u_int32_t flag, heapflag, op;
557 	int elemc, freekey, freedata, i, optindex, result, ret;
558 #ifdef CONFIG_TEST
559 	int data_buf_size, key_buf_size;
560 
561 	data_buf_size = key_buf_size = 0;
562 #endif
563 	COMPQUIET(dtmp, NULL);
564 	COMPQUIET(ktmp, NULL);
565 	result = TCL_OK;
566 	flag = heapflag = 0;
567 	freekey = freedata = 0;
568 	hrdbp = hsdbp = pdbp = phrdbp = phsdbp = NULL;
569 	type = ptype = DB_UNKNOWN;
570 	memset(&hkey, 0, sizeof(hkey));
571 	memset(&key, 0, sizeof(key));
572 	memset(&data, 0, sizeof(data));
573 	memset(&pdata, 0, sizeof(DBT));
574 	memset(&rkey, 0, sizeof(DBT));
575 	memset(&rdata, 0, sizeof(DBT));
576 	memset(&tmpdata, 0, sizeof(DBT));
577 	tmpdata.flags = DB_DBT_PARTIAL | DB_DBT_USERMEM;
578 
579 	if (objc < 2) {
580 		Tcl_WrongNumArgs(interp, 2, objv, "?-args? ?key?");
581 		return (TCL_ERROR);
582 	}
583 
584 	/*
585 	 * Get the command name index from the object based on the options
586 	 * defined above.
587 	 */
588 	i = 2;
589 	while (i < objc) {
590 		if (Tcl_GetIndexFromObj(interp, objv[i], dbcgetopts,
591 		    "option", TCL_EXACT, &optindex) != TCL_OK) {
592 			/*
593 			 * Reset the result so we don't get
594 			 * an errant error message if there is another error.
595 			 */
596 			if (IS_HELP(objv[i]) == TCL_OK) {
597 				result = TCL_OK;
598 				goto out;
599 			}
600 			Tcl_ResetResult(interp);
601 			break;
602 		}
603 		i++;
604 
605 #define	FLAG_CHECK2_STDARG	\
606 	(DB_RMW | DB_MULTIPLE | DB_MULTIPLE_KEY | DB_IGNORE_LEASE | \
607 	DB_READ_UNCOMMITTED | DB_READ_COMMITTED)
608 
609 		switch ((enum dbcgetopts)optindex) {
610 #ifdef CONFIG_TEST
611 		case DBCGET_DATA_BUF_SIZE:
612 			result =
613 			    Tcl_GetIntFromObj(interp, objv[i], &data_buf_size);
614 			if (result != TCL_OK)
615 				goto out;
616 			i++;
617 			break;
618 		case DBCGET_BOTH_RANGE:
619 			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
620 			flag |= DB_GET_BOTH_RANGE;
621 			break;
622 		case DBCGET_KEY_BUF_SIZE:
623 			result =
624 			    Tcl_GetIntFromObj(interp, objv[i], &key_buf_size);
625 			if (result != TCL_OK)
626 				goto out;
627 			i++;
628 			break;
629 		case DBCGET_MULTI:
630 			flag |= DB_MULTIPLE;
631 			result =
632 			    Tcl_GetIntFromObj(interp, objv[i], &data_buf_size);
633 			if (result != TCL_OK)
634 				goto out;
635 			i++;
636 			break;
637 		case DBCGET_MULTI_KEY:
638 			flag |= DB_MULTIPLE_KEY;
639 			result =
640 			    Tcl_GetIntFromObj(interp, objv[i], &data_buf_size);
641 			if (result != TCL_OK)
642 				goto out;
643 			i++;
644 			break;
645 		case DBCGET_NOLEASE:
646 			flag |= DB_IGNORE_LEASE;
647 			break;
648 		case DBCGET_READ_COMMITTED:
649 			flag |= DB_READ_COMMITTED;
650 			break;
651 		case DBCGET_READ_UNCOMMITTED:
652 			flag |= DB_READ_UNCOMMITTED;
653 			break;
654 #endif
655 		case DBCGET_RMW:
656 			flag |= DB_RMW;
657 			break;
658 		case DBCGET_CURRENT:
659 			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
660 			flag |= DB_CURRENT;
661 			break;
662 		case DBCGET_FIRST:
663 			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
664 			flag |= DB_FIRST;
665 			break;
666 		case DBCGET_LAST:
667 			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
668 			flag |= DB_LAST;
669 			break;
670 		case DBCGET_NEXT:
671 			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
672 			flag |= DB_NEXT;
673 			break;
674 		case DBCGET_PREV:
675 			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
676 			flag |= DB_PREV;
677 			break;
678 		case DBCGET_PREVDUP:
679 			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
680 			flag |= DB_PREV_DUP;
681 			break;
682 		case DBCGET_PREVNODUP:
683 			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
684 			flag |= DB_PREV_NODUP;
685 			break;
686 		case DBCGET_NEXTNODUP:
687 			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
688 			flag |= DB_NEXT_NODUP;
689 			break;
690 		case DBCGET_NEXTDUP:
691 			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
692 			flag |= DB_NEXT_DUP;
693 			break;
694 		case DBCGET_BOTH:
695 			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
696 			flag |= DB_GET_BOTH;
697 			break;
698 		case DBCGET_RECNO:
699 			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
700 			flag |= DB_GET_RECNO;
701 			break;
702 		case DBCGET_JOIN:
703 			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
704 			flag |= DB_JOIN_ITEM;
705 			break;
706 		case DBCGET_SET:
707 			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
708 			flag |= DB_SET;
709 			break;
710 		case DBCGET_SETRANGE:
711 			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
712 			flag |= DB_SET_RANGE;
713 			break;
714 		case DBCGET_SETRECNO:
715 			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
716 			flag |= DB_SET_RECNO;
717 			break;
718 		case DBCGET_PART:
719 			if (i == objc) {
720 				Tcl_WrongNumArgs(interp, 2, objv,
721 				    "?-partial {offset length}?");
722 				result = TCL_ERROR;
723 				break;
724 			}
725 			/*
726 			 * Get sublist as {offset length}
727 			 */
728 			result = Tcl_ListObjGetElements(interp, objv[i++],
729 			    &elemc, &elemv);
730 			if (elemc != 2) {
731 				Tcl_SetResult(interp,
732 				    "List must be {offset length}", TCL_STATIC);
733 				result = TCL_ERROR;
734 				break;
735 			}
736 			data.flags |= DB_DBT_PARTIAL;
737 			result = _GetUInt32(interp, elemv[0], &data.doff);
738 			if (result != TCL_OK)
739 				break;
740 			result = _GetUInt32(interp, elemv[1], &data.dlen);
741 			/*
742 			 * NOTE: We don't check result here because all we'd
743 			 * do is break anyway, and we are doing that.  If you
744 			 * add code here, you WILL need to add the check
745 			 * for result.  (See the check for save.doff, a few
746 			 * lines above and copy that.)
747 			 */
748 			break;
749 		}
750 		if (result != TCL_OK)
751 			break;
752 	}
753 
754 	if (result != TCL_OK)
755 		goto out;
756 	heapflag = flag & ~DB_OPFLAGS_MASK;
757 	heapflag &= ~DB_MULTIPLE_KEY;
758 	heapflag &= ~DB_MULTIPLE;
759 	if (F_ISSET(dbc, DBC_READ_COMMITTED))
760 	    heapflag |= DB_READ_COMMITTED;
761 	if (F_ISSET(dbc, DBC_READ_UNCOMMITTED))
762 	    heapflag |= DB_READ_UNCOMMITTED;
763 
764 	/*
765 	 * We need to determine if we are a recno database
766 	 * or not.  If we are, then key.data is a recno, not
767 	 * a string.
768 	 */
769 	dbcip = _PtrToInfo(dbc);
770 	if (dbcip != NULL) {
771 		dbip = dbcip->i_parent;
772 		if (dbip == NULL) {
773 			Tcl_SetResult(interp, "Cursor without parent database",
774 			    TCL_STATIC);
775 			result = TCL_ERROR;
776 			goto out;
777 		}
778 		thisdbp = dbip->i_dbp;
779 		(void)thisdbp->get_type(thisdbp, &type);
780 		if (ispget && thisdbp->s_primary != NULL) {
781 			pdbp = thisdbp->s_primary;
782 			(void)pdbp->get_type(pdbp, &ptype);
783 		} else
784 			ptype = DB_UNKNOWN;
785 		if (type == DB_HEAP) {
786 			hrdbp = dbip->hrdbp;
787 			hsdbp = dbip->hsdbp;
788 		}
789 		if (pdbp != NULL && ptype == DB_HEAP) {
790 			phrdbp = ((DBTCL_INFO *)
791 			    pdbp->api_internal)->hrdbp;
792 			phsdbp = ((DBTCL_INFO *)
793 			    pdbp->api_internal)->hsdbp;
794 		}
795 	}
796 	/*
797 	 * When we get here, we better have:
798 	 * 2 args, key and data if GET_BOTH/GET_BOTH_RANGE was specified.
799 	 * 1 arg if -set, -set_range or -set_recno
800 	 * 0 in all other cases.
801 	 */
802 	op = flag & DB_OPFLAGS_MASK;
803 	switch (op) {
804 	case DB_GET_BOTH:
805 #ifdef CONFIG_TEST
806 	case DB_GET_BOTH_RANGE:
807 #endif
808 		if (i != (objc - 2)) {
809 			Tcl_WrongNumArgs(interp, 2, objv,
810 			    "?-args? -get_both key data");
811 			result = TCL_ERROR;
812 			goto out;
813 		} else {
814 			if (type == DB_RECNO ||
815 			    type == DB_QUEUE || type == DB_HEAP) {
816 				result = _GetUInt32(
817 				    interp, objv[objc-2], &recno);
818 				if (result == TCL_OK) {
819 					key.data = &recno;
820 					key.size = sizeof(db_recno_t);
821 				} else
822 					goto out;
823 			} else {
824 				/*
825 				 * Some get calls (SET_*) can change the
826 				 * key pointers.  So, we need to store
827 				 * the allocated key space in a tmp.
828 				 */
829 				ret = _CopyObjBytes(interp, objv[objc-2],
830 				    &ktmp, &key.size, &freekey);
831 				if (ret != 0) {
832 					result = _ReturnSetup(interp, ret,
833 					    DB_RETOK_DBCGET(ret), "dbc get");
834 					return (result);
835 				}
836 				key.data = ktmp;
837 			}
838 			if (ptype == DB_RECNO ||
839 			    ptype == DB_QUEUE || ptype == DB_HEAP) {
840 				result = _GetUInt32(
841 				    interp, objv[objc-1], &precno);
842 				if (result == TCL_OK) {
843 					data.data = &precno;
844 					data.size = sizeof(db_recno_t);
845 				} else
846 					goto out;
847 			} else {
848 				ret = _CopyObjBytes(interp, objv[objc-1],
849 				    &dtmp, &data.size, &freedata);
850 				if (ret != 0) {
851 					result = _ReturnSetup(interp, ret,
852 					    DB_RETOK_DBCGET(ret), "dbc get");
853 					goto out;
854 				}
855 				data.data = dtmp;
856 			}
857 		}
858 		break;
859 	case DB_SET:
860 	case DB_SET_RANGE:
861 	case DB_SET_RECNO:
862 		if (i != (objc - 1)) {
863 			Tcl_WrongNumArgs(interp, 2, objv, "?-args? key");
864 			result = TCL_ERROR;
865 			goto out;
866 		}
867 #ifdef CONFIG_TEST
868 		if (data_buf_size != 0) {
869 			(void)__os_malloc(
870 			    NULL, (size_t)data_buf_size, &data.data);
871 			data.ulen = (u_int32_t)data_buf_size;
872 			data.flags |= DB_DBT_USERMEM;
873 		} else
874 #endif
875 			data.flags |= DB_DBT_MALLOC;
876 		if (op == DB_SET_RECNO ||
877 		    type == DB_HEAP || type == DB_RECNO || type == DB_QUEUE) {
878 			result = _GetUInt32(interp, objv[objc - 1], &recno);
879 			key.data = &recno;
880 			key.size = sizeof(db_recno_t);
881 		} else {
882 			/*
883 			 * Some get calls (SET_*) can change the
884 			 * key pointers.  So, we need to store
885 			 * the allocated key space in a tmp.
886 			 */
887 			ret = _CopyObjBytes(interp, objv[objc-1],
888 			    &ktmp, &key.size, &freekey);
889 			if (ret != 0) {
890 				result = _ReturnSetup(interp, ret,
891 				    DB_RETOK_DBCGET(ret), "dbc get");
892 				return (result);
893 			}
894 			key.data = ktmp;
895 		}
896 		break;
897 	default:
898 		if (i != objc) {
899 			Tcl_WrongNumArgs(interp, 2, objv, "?-args?");
900 			result = TCL_ERROR;
901 			goto out;
902 		}
903 #ifdef CONFIG_TEST
904 		if (key_buf_size != 0) {
905 			(void)__os_malloc(
906 			    NULL, (size_t)key_buf_size, &key.data);
907 			key.ulen = (u_int32_t)key_buf_size;
908 			key.flags |= DB_DBT_USERMEM;
909 		} else
910 #endif
911 			key.flags |= DB_DBT_MALLOC;
912 #ifdef CONFIG_TEST
913 		if (data_buf_size != 0) {
914 			(void)__os_malloc(
915 			    NULL, (size_t)data_buf_size, &data.data);
916 			data.ulen = (u_int32_t)data_buf_size;
917 			data.flags |= DB_DBT_USERMEM;
918 		} else
919 #endif
920 			data.flags |= DB_DBT_MALLOC;
921 	}
922 
923 	_debug_check();
924 
925 	/*
926 	 * Heap cannot be a secondary, so with type == DB_HEAP we know that
927 	 * ispget is false.
928 	 */
929 	if (type == DB_HEAP && (op == DB_GET_BOTH ||
930 	    op == DB_GET_BOTH_RANGE || op == DB_SET || op == DB_SET_RANGE)) {
931 		rkey.data = &recno;
932 		rkey.ulen = rkey.size = sizeof(db_recno_t);
933 		rkey.flags |= DB_DBT_USERMEM;
934 		if (key.data != NULL && F_ISSET(&key, DB_DBT_USERMEM))
935 			__os_free(NULL, key.data);
936 		if (key.data != NULL && F_ISSET(&key, DB_DBT_MALLOC))
937 			__os_ufree(NULL, key.data);
938 		memset(&key, 0, sizeof(DBT));
939 		key.data = &rid;
940 		key.ulen = key.size = sizeof(DB_HEAP_RID);
941 		key.flags |= DB_DBT_USERMEM;
942 
943 		/*
944 		 *  This is a noncursor get on recno db, use heapflag because
945 		 *  the cursor op flags have been removed.
946 		 */
947 		ret = hrdbp->get(hrdbp, dbc->txn, &rkey, &key, heapflag);
948 		if (ret != 0) {
949 			result = _ReturnSetup(
950 			    interp, ret, DB_RETOK_DBGET(ret), "db get");
951 			retlist = Tcl_NewListObj(0, NULL);
952 			goto out1;
953 		}
954 	}
955 
956 	/*
957 	 * If we're doing a pget and DB_GET_BOTH is set, the primary key (stored
958 	 * in data) needs to match, too.  For a HEAP primary, we're called with
959 	 * a recno primary key and we need to translate that to an RID.  (ptype
960 	 * is only set if we're doing a pget.)
961 	 */
962 	if (ptype == DB_HEAP &&
963 	    (op == DB_GET_BOTH || op == DB_GET_BOTH_RANGE)) {
964 		rkey.data = &precno;
965 		rkey.size = rkey.ulen = sizeof(db_recno_t);
966 		rkey.flags = DB_DBT_USERMEM;
967 		if (data.data != NULL && F_ISSET(&data, DB_DBT_USERMEM))
968 			__os_free(NULL, data.data);
969 		if (data.data != NULL && F_ISSET(&data, DB_DBT_MALLOC))
970 			__os_ufree(NULL, data.data);
971 		memset(&data, 0, sizeof(DBT));
972 		data.data = &rid;
973 		data.size = data.ulen = sizeof(DB_HEAP_RID);
974 		data.flags = DB_DBT_USERMEM;
975 		ret = phrdbp->get(phrdbp, dbc->txn, &rkey, &data, heapflag);
976 		if (ret != 0) {
977 			result = _ReturnSetup(
978 			    interp, ret, DB_RETOK_DBGET(ret), "db get");
979 			retlist = Tcl_NewListObj(0, NULL);
980 			goto out1;
981 		}
982 	}
983 
984 	if (ispget) {
985 		F_SET(&pdata, DB_DBT_MALLOC);
986 		ret = dbc->pget(dbc, &key, &data, &pdata, flag);
987 		if (ret == 0 && ptype == DB_HEAP) {
988 			rid.pgno = ((DB_HEAP_RID *)data.data)->pgno;
989 			rid.indx = ((DB_HEAP_RID *)data.data)->indx;
990 			hkey.data = &rid;
991 			hkey.ulen = hkey.size = data.size;
992 			hkey.flags = DB_DBT_USERMEM;
993 			ret = phsdbp->pget(phsdbp,
994 			    dbc->txn, &hkey, &data, &tmpdata, 0);
995 		}
996 
997 	} else
998 		ret = dbc->get(dbc, &key, &data, flag);
999 	result = _ReturnSetup(interp, ret, DB_RETOK_DBCGET(ret), "dbc get");
1000 	if (result == TCL_ERROR)
1001 		goto out;
1002 
1003 	retlist = Tcl_NewListObj(0, NULL);
1004 	if (ret != 0)
1005 		goto out1;
1006 	if (op == DB_GET_RECNO) {
1007 		recno = *((db_recno_t *)data.data);
1008 		myobj = Tcl_NewWideIntObj((Tcl_WideInt)recno);
1009 		result = Tcl_ListObjAppendElement(interp, retlist, myobj);
1010 	} else {
1011 		if (flag & (DB_MULTIPLE|DB_MULTIPLE_KEY))
1012 			result = _SetMultiList(interp,
1013 			    retlist, &key, &data, type, flag, dbc);
1014 		else if ((type == DB_RECNO || type == DB_QUEUE) &&
1015 		    key.data != NULL) {
1016 			if (ispget)
1017 				result = _Set3DBTList(interp, retlist, &key, 1,
1018 				    &data,
1019 				    (ptype == DB_RECNO || ptype == DB_QUEUE),
1020 				    &pdata);
1021 			else
1022 				result = _SetListRecnoElem(interp, retlist,
1023 				    *(db_recno_t *)key.data,
1024 				    data.data, data.size);
1025 		} else if (type == DB_HEAP) {
1026 			/*
1027 			 * If given a record number, we're done.  If we don't
1028 			 * yet have a record number, we need to look it up.
1029 			 */
1030 			if (op != DB_GET_BOTH && op != DB_SET &&
1031 			    op != DB_GET_BOTH_RANGE && op != DB_SET_RANGE) {
1032 				rdata.flags = DB_DBT_PARTIAL | DB_DBT_USERMEM;
1033 				rdata.dlen = 0;
1034 				rkey.data = &recno;
1035 				rkey.size = rkey.ulen = sizeof(db_recno_t);
1036 				rkey.flags = DB_DBT_USERMEM;
1037 
1038 				ret = hsdbp->pget(hsdbp, dbc->txn, &key,
1039 				    &rkey, &rdata, heapflag);
1040 				result = _ReturnSetup(
1041 				    interp, ret, DB_RETOK_DBGET(ret), "db get");
1042 				if (result == TCL_ERROR)
1043 					goto out;
1044 				retlist = Tcl_NewListObj(0, NULL);
1045 				if (ret != 0)
1046 					goto out1;
1047 			}
1048 			result = _SetListRecnoElem(interp, retlist,
1049 			    *(db_recno_t *)rkey.data, data.data, data.size);
1050 		} else {
1051 			if (ispget)
1052 				result = _Set3DBTList(interp, retlist, &key, 0,
1053 				    &data,
1054 				    (ptype == DB_HEAP ||
1055 					ptype == DB_RECNO || ptype == DB_QUEUE),
1056 				    &pdata);
1057 			else
1058 				result = _SetListElem(interp, retlist,
1059 				    key.data, key.size, data.data, data.size);
1060 		}
1061 	}
1062 out1:
1063 	if (result == TCL_OK)
1064 		Tcl_SetObjResult(interp, retlist);
1065 	/*
1066 	 * If DB_DBT_MALLOC is set we need to free if DB allocated anything.
1067 	 * If DB_DBT_USERMEM is set we need to free it because
1068 	 * we allocated it (for data_buf_size/key_buf_size).  That
1069 	 * allocation does not apply to the pdata DBT.  For heap, we do not
1070 	 * malloc anything but move pointers around so nothing to free.
1071 	 */
1072 out:
1073 	if (key.data != NULL && F_ISSET(&key, DB_DBT_MALLOC))
1074 		__os_ufree(dbc->env, key.data);
1075 	if (key.data != NULL && F_ISSET(&key, DB_DBT_USERMEM) &&
1076 	    key.data != &rid)
1077 		__os_free(dbc->env, key.data);
1078 	if (data.data != NULL && F_ISSET(&data, DB_DBT_MALLOC))
1079 		__os_ufree(dbc->env, data.data);
1080 	if (data.data != NULL && F_ISSET(&data, DB_DBT_USERMEM) &&
1081 	    data.data != &rid)
1082 		__os_free(dbc->env, data.data);
1083 	if (pdata.data != NULL && F_ISSET(&pdata, DB_DBT_MALLOC))
1084 		__os_ufree(dbc->env, pdata.data);
1085 	if (freedata)
1086 		__os_free(NULL, dtmp);
1087 	if (freekey)
1088 		__os_free(NULL, ktmp);
1089 	return (result);
1090 
1091 }
1092 
1093 /*
1094  * tcl_DbcCompare --
1095  */
1096 static int
tcl_DbcCompare(interp,objc,objv,dbc)1097 tcl_DbcCompare(interp, objc, objv, dbc)
1098 	Tcl_Interp *interp;		/* Interpreter */
1099 	int objc;			/* How many arguments? */
1100 	Tcl_Obj *CONST objv[];		/* The argument objects */
1101 	DBC *dbc;			/* Cursor pointer */
1102 {
1103 	DBC *odbc;
1104 	DBTCL_INFO *dbcip, *dbip;
1105 	Tcl_Obj *res;
1106 	int cmp_res, result, ret;
1107 	char *arg, msg[MSG_SIZE];
1108 
1109 	result = TCL_OK;
1110 	res = NULL;
1111 
1112 	if (objc != 3) {
1113 		Tcl_WrongNumArgs(interp, 3, objv, "?-args?");
1114 		return (TCL_ERROR);
1115 	}
1116 
1117 	dbcip = _PtrToInfo(dbc);
1118 	if (dbcip == NULL) {
1119 		Tcl_SetResult(interp, "Cursor without info structure",
1120 		    TCL_STATIC);
1121 		result = TCL_ERROR;
1122 		goto out;
1123 	} else {
1124 		dbip = dbcip->i_parent;
1125 		if (dbip == NULL) {
1126 			Tcl_SetResult(interp, "Cursor without parent database",
1127 			    TCL_STATIC);
1128 			result = TCL_ERROR;
1129 			goto out;
1130 		}
1131 	}
1132 	/*
1133 	 * When we get here, we better have:
1134 	 * 2 args one DBC and an int address for the result
1135 	 */
1136 	arg = Tcl_GetStringFromObj(objv[2], NULL);
1137 	odbc = NAME_TO_DBC(arg);
1138 	if (odbc == NULL) {
1139 		snprintf(msg, MSG_SIZE,
1140 		    "Cmp: Invalid cursor: %s\n", arg);
1141 		Tcl_SetResult(interp, msg, TCL_VOLATILE);
1142 		result = TCL_ERROR;
1143 		goto out;
1144 	}
1145 
1146 	ret = dbc->cmp(dbc, odbc, &cmp_res, 0);
1147 	if (ret != 0) {
1148 		result = _ReturnSetup(interp, ret,
1149 		    DB_RETOK_STD(ret), "dbc cmp");
1150 		return (result);
1151 	}
1152 	res = Tcl_NewIntObj(cmp_res);
1153 	Tcl_SetObjResult(interp, res);
1154 out:
1155 	return (result);
1156 
1157 }
1158 
1159 /*
1160  * tcl_DbcDup --
1161  */
1162 static int
tcl_DbcDup(interp,objc,objv,dbc)1163 tcl_DbcDup(interp, objc, objv, dbc)
1164 	Tcl_Interp *interp;		/* Interpreter */
1165 	int objc;			/* How many arguments? */
1166 	Tcl_Obj *CONST objv[];		/* The argument objects */
1167 	DBC *dbc;			/* Cursor pointer */
1168 {
1169 	static const char *dbcdupopts[] = {
1170 		"-position",
1171 		NULL
1172 	};
1173 	enum dbcdupopts {
1174 		DBCDUP_POS
1175 	};
1176 	DBC *newdbc;
1177 	DBTCL_INFO *dbcip, *newdbcip, *dbip;
1178 	Tcl_Obj *res;
1179 	u_int32_t flag;
1180 	int i, optindex, result, ret;
1181 	char newname[MSG_SIZE];
1182 
1183 	result = TCL_OK;
1184 	flag = 0;
1185 	res = NULL;
1186 
1187 	if (objc < 2) {
1188 		Tcl_WrongNumArgs(interp, 2, objv, "?-args?");
1189 		return (TCL_ERROR);
1190 	}
1191 
1192 	/*
1193 	 * Get the command name index from the object based on the options
1194 	 * defined above.
1195 	 */
1196 	i = 2;
1197 	while (i < objc) {
1198 		if (Tcl_GetIndexFromObj(interp, objv[i], dbcdupopts,
1199 		    "option", TCL_EXACT, &optindex) != TCL_OK) {
1200 			/*
1201 			 * Reset the result so we don't get
1202 			 * an errant error message if there is another error.
1203 			 */
1204 			if (IS_HELP(objv[i]) == TCL_OK) {
1205 				result = TCL_OK;
1206 				goto out;
1207 			}
1208 			Tcl_ResetResult(interp);
1209 			break;
1210 		}
1211 		i++;
1212 		switch ((enum dbcdupopts)optindex) {
1213 		case DBCDUP_POS:
1214 			flag = DB_POSITION;
1215 			break;
1216 		}
1217 		if (result != TCL_OK)
1218 			break;
1219 	}
1220 	if (result != TCL_OK)
1221 		goto out;
1222 
1223 	/*
1224 	 * We need to determine if we are a recno database
1225 	 * or not.  If we are, then key.data is a recno, not
1226 	 * a string.
1227 	 */
1228 	dbcip = _PtrToInfo(dbc);
1229 	if (dbcip == NULL) {
1230 		Tcl_SetResult(interp, "Cursor without info structure",
1231 		    TCL_STATIC);
1232 		result = TCL_ERROR;
1233 		goto out;
1234 	} else {
1235 		dbip = dbcip->i_parent;
1236 		if (dbip == NULL) {
1237 			Tcl_SetResult(interp, "Cursor without parent database",
1238 			    TCL_STATIC);
1239 			result = TCL_ERROR;
1240 			goto out;
1241 		}
1242 	}
1243 	/*
1244 	 * Now duplicate the cursor.  If successful, we need to create
1245 	 * a new cursor command.
1246 	 */
1247 	snprintf(newname, sizeof(newname),
1248 	    "%s.c%d", dbip->i_name, dbip->i_dbdbcid);
1249 	newdbcip = _NewInfo(interp, NULL, newname, I_DBC);
1250 	if (newdbcip != NULL) {
1251 		ret = dbc->dup(dbc, &newdbc, flag);
1252 		if (ret == 0) {
1253 			dbip->i_dbdbcid++;
1254 			newdbcip->i_parent = dbip;
1255 			(void)Tcl_CreateObjCommand(interp, newname,
1256 			    (Tcl_ObjCmdProc *)dbc_Cmd,
1257 			    (ClientData)newdbc, NULL);
1258 			res = NewStringObj(newname, strlen(newname));
1259 			_SetInfoData(newdbcip, newdbc);
1260 			Tcl_SetObjResult(interp, res);
1261 		} else {
1262 			result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
1263 			    "db dup");
1264 			_DeleteInfo(newdbcip);
1265 		}
1266 	} else {
1267 		Tcl_SetResult(interp, "Could not set up info", TCL_STATIC);
1268 		result = TCL_ERROR;
1269 	}
1270 out:
1271 	return (result);
1272 
1273 }
1274 
1275 /*
1276  * tcl_DbcDel --
1277  */
1278 static int
tcl_DbcDel(interp,objc,objv,dbc)1279 tcl_DbcDel(interp, objc, objv, dbc)
1280 	Tcl_Interp *interp;		/* Interpreter */
1281 	int objc;			/* How many arguments? */
1282 	Tcl_Obj *CONST objv[];		/* The argument objects */
1283 	DBC *dbc;			/* Cursor pointer */
1284 {
1285 	static const char *dbcdelopts[] = {
1286 		"-consume",
1287 		NULL
1288 	};
1289 	enum dbcdelopts {
1290 		DBCDEL_CONSUME
1291 	};
1292 	u_int32_t flag;
1293 	int i, optindex, result, ret;
1294 
1295 	result = TCL_OK;
1296 	flag = 0;
1297 	if (objc < 2) {
1298 		Tcl_WrongNumArgs(interp, 2, objv, "?-args?");
1299 		return (TCL_ERROR);
1300 	}
1301 
1302 	/*
1303 	 * Get the command name index from the object based on the options
1304 	 * defined above.
1305 	 */
1306 	i = 2;
1307 	while (i < objc) {
1308 		if (Tcl_GetIndexFromObj(interp, objv[i], dbcdelopts,
1309 		    "option", TCL_EXACT, &optindex) != TCL_OK) {
1310 			/*
1311 			 * Reset the result so we don't get
1312 			 * an errant error message if there is another error.
1313 			 */
1314 			if (IS_HELP(objv[i]) == TCL_OK) {
1315 				result = TCL_OK;
1316 				goto out;
1317 			}
1318 			Tcl_ResetResult(interp);
1319 			break;
1320 		}
1321 		i++;
1322 		switch ((enum dbcdelopts)optindex) {
1323 		case DBCDEL_CONSUME:
1324 			flag = DB_CONSUME;
1325 			break;
1326 		}
1327 	}
1328 	if (dbc->dbp->type == DB_HEAP)
1329 		result = tcl_DbcHeapDel(interp, dbc);
1330 	else {
1331 		_debug_check();
1332 		ret = dbc->del(dbc, flag);
1333 		result = _ReturnSetup(
1334 		    interp, ret, DB_RETOK_DBCDEL(ret), "dbc delete");
1335 	}
1336 out:
1337 	return (result);
1338 }
1339