1/*-
2 * See the file LICENSE for redistribution information.
3 *
4 * Copyright (c) 1999,2008 Oracle.  All rights reserved.
5 *
6 * $Id: tcl_dbcursor.c,v 12.19 2008/01/08 20:58:52 bostic Exp $
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 */
20static int tcl_DbcDup __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *));
21static int tcl_DbcGet __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *, int));
22static int tcl_DbcPut __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *));
23
24/*
25 * PUBLIC: int dbc_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*));
26 *
27 * dbc_cmd --
28 *	Implements the cursor command.
29 */
30int
31dbc_Cmd(clientData, interp, objc, objv)
32	ClientData clientData;		/* Cursor handle */
33	Tcl_Interp *interp;		/* Interpreter */
34	int objc;			/* How many arguments? */
35	Tcl_Obj *CONST objv[];		/* The argument objects */
36{
37	static const char *dbccmds[] = {
38#ifdef CONFIG_TEST
39		"pget",
40#endif
41		"close",
42		"del",
43		"dup",
44		"get",
45		"put",
46		NULL
47	};
48	enum dbccmds {
49#ifdef CONFIG_TEST
50		DBCPGET,
51#endif
52		DBCCLOSE,
53		DBCDELETE,
54		DBCDUP,
55		DBCGET,
56		DBCPUT
57	};
58	DBC *dbc;
59	DBTCL_INFO *dbip;
60	int cmdindex, result, ret;
61
62	Tcl_ResetResult(interp);
63	dbc = (DBC *)clientData;
64	dbip = _PtrToInfo((void *)dbc);
65	result = TCL_OK;
66
67	if (objc <= 1) {
68		Tcl_WrongNumArgs(interp, 1, objv, "command cmdargs");
69		return (TCL_ERROR);
70	}
71	if (dbc == NULL) {
72		Tcl_SetResult(interp, "NULL dbc pointer", TCL_STATIC);
73		return (TCL_ERROR);
74	}
75	if (dbip == NULL) {
76		Tcl_SetResult(interp, "NULL dbc info pointer", TCL_STATIC);
77		return (TCL_ERROR);
78	}
79
80	/*
81	 * Get the command name index from the object based on the berkdbcmds
82	 * defined above.
83	 */
84	if (Tcl_GetIndexFromObj(interp, objv[1], dbccmds, "command",
85	    TCL_EXACT, &cmdindex) != TCL_OK)
86		return (IS_HELP(objv[1]));
87	switch ((enum dbccmds)cmdindex) {
88#ifdef CONFIG_TEST
89	case DBCPGET:
90		result = tcl_DbcGet(interp, objc, objv, dbc, 1);
91		break;
92#endif
93	case DBCCLOSE:
94		/*
95		 * No args for this.  Error if there are some.
96		 */
97		if (objc > 2) {
98			Tcl_WrongNumArgs(interp, 2, objv, NULL);
99			return (TCL_ERROR);
100		}
101		_debug_check();
102		ret = dbc->close(dbc);
103		result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
104		    "dbc close");
105		if (result == TCL_OK) {
106			(void)Tcl_DeleteCommand(interp, dbip->i_name);
107			_DeleteInfo(dbip);
108		}
109		break;
110	case DBCDELETE:
111		/*
112		 * No args for this.  Error if there are some.
113		 */
114		if (objc > 2) {
115			Tcl_WrongNumArgs(interp, 2, objv, NULL);
116			return (TCL_ERROR);
117		}
118		_debug_check();
119		ret = dbc->del(dbc, 0);
120		result = _ReturnSetup(interp, ret, DB_RETOK_DBCDEL(ret),
121		    "dbc delete");
122		break;
123	case DBCDUP:
124		result = tcl_DbcDup(interp, objc, objv, dbc);
125		break;
126	case DBCGET:
127		result = tcl_DbcGet(interp, objc, objv, dbc, 0);
128		break;
129	case DBCPUT:
130		result = tcl_DbcPut(interp, objc, objv, dbc);
131		break;
132	}
133	return (result);
134}
135
136/*
137 * tcl_DbcPut --
138 */
139static int
140tcl_DbcPut(interp, objc, objv, dbc)
141	Tcl_Interp *interp;		/* Interpreter */
142	int objc;			/* How many arguments? */
143	Tcl_Obj *CONST objv[];		/* The argument objects */
144	DBC *dbc;			/* Cursor pointer */
145{
146	static const char *dbcutopts[] = {
147#ifdef CONFIG_TEST
148		"-nodupdata",
149#endif
150		"-after",
151		"-before",
152		"-current",
153		"-keyfirst",
154		"-keylast",
155		"-partial",
156		NULL
157	};
158	enum dbcutopts {
159#ifdef CONFIG_TEST
160		DBCPUT_NODUPDATA,
161#endif
162		DBCPUT_AFTER,
163		DBCPUT_BEFORE,
164		DBCPUT_CURRENT,
165		DBCPUT_KEYFIRST,
166		DBCPUT_KEYLAST,
167		DBCPUT_PART
168	};
169	DB *thisdbp;
170	DBT key, data;
171	DBTCL_INFO *dbcip, *dbip;
172	DBTYPE type;
173	Tcl_Obj **elemv, *res;
174	void *dtmp, *ktmp;
175	db_recno_t recno;
176	u_int32_t flag;
177	int elemc, freekey, freedata, i, optindex, result, ret;
178
179	COMPQUIET(dtmp, NULL);
180	COMPQUIET(ktmp, NULL);
181
182	result = TCL_OK;
183	flag = 0;
184	freekey = freedata = 0;
185
186	if (objc < 2) {
187		Tcl_WrongNumArgs(interp, 2, objv, "?-args? ?key?");
188		return (TCL_ERROR);
189	}
190
191	memset(&key, 0, sizeof(key));
192	memset(&data, 0, sizeof(data));
193
194	/*
195	 * Get the command name index from the object based on the options
196	 * defined above.
197	 */
198	i = 2;
199	while (i < (objc - 1)) {
200		if (Tcl_GetIndexFromObj(interp, objv[i], dbcutopts, "option",
201		    TCL_EXACT, &optindex) != TCL_OK) {
202			/*
203			 * Reset the result so we don't get
204			 * an errant error message if there is another error.
205			 */
206			if (IS_HELP(objv[i]) == TCL_OK) {
207				result = TCL_OK;
208				goto out;
209			}
210			Tcl_ResetResult(interp);
211			break;
212		}
213		i++;
214		switch ((enum dbcutopts)optindex) {
215#ifdef CONFIG_TEST
216		case DBCPUT_NODUPDATA:
217			FLAG_CHECK(flag);
218			flag = DB_NODUPDATA;
219			break;
220#endif
221		case DBCPUT_AFTER:
222			FLAG_CHECK(flag);
223			flag = DB_AFTER;
224			break;
225		case DBCPUT_BEFORE:
226			FLAG_CHECK(flag);
227			flag = DB_BEFORE;
228			break;
229		case DBCPUT_CURRENT:
230			FLAG_CHECK(flag);
231			flag = DB_CURRENT;
232			break;
233		case DBCPUT_KEYFIRST:
234			FLAG_CHECK(flag);
235			flag = DB_KEYFIRST;
236			break;
237		case DBCPUT_KEYLAST:
238			FLAG_CHECK(flag);
239			flag = DB_KEYLAST;
240			break;
241		case DBCPUT_PART:
242			if (i > (objc - 2)) {
243				Tcl_WrongNumArgs(interp, 2, objv,
244				    "?-partial {offset length}?");
245				result = TCL_ERROR;
246				break;
247			}
248			/*
249			 * Get sublist as {offset length}
250			 */
251			result = Tcl_ListObjGetElements(interp, objv[i++],
252			    &elemc, &elemv);
253			if (elemc != 2) {
254				Tcl_SetResult(interp,
255				    "List must be {offset length}", TCL_STATIC);
256				result = TCL_ERROR;
257				break;
258			}
259			data.flags |= DB_DBT_PARTIAL;
260			result = _GetUInt32(interp, elemv[0], &data.doff);
261			if (result != TCL_OK)
262				break;
263			result = _GetUInt32(interp, elemv[1], &data.dlen);
264			/*
265			 * NOTE: We don't check result here because all we'd
266			 * do is break anyway, and we are doing that.  If you
267			 * add code here, you WILL need to add the check
268			 * for result.  (See the check for save.doff, a few
269			 * lines above and copy that.)
270			 */
271		}
272		if (result != TCL_OK)
273			break;
274	}
275	if (result != TCL_OK)
276		goto out;
277
278	/*
279	 * We need to determine if we are a recno database or not.  If we are,
280	 * then key.data is a recno, not a string.
281	 */
282	dbcip = _PtrToInfo(dbc);
283	if (dbcip == NULL)
284		type = DB_UNKNOWN;
285	else {
286		dbip = dbcip->i_parent;
287		if (dbip == NULL) {
288			Tcl_SetResult(interp, "Cursor without parent database",
289			    TCL_STATIC);
290			result = TCL_ERROR;
291			return (result);
292		}
293		thisdbp = dbip->i_dbp;
294		(void)thisdbp->get_type(thisdbp, &type);
295	}
296	/*
297	 * When we get here, we better have:
298	 * 1 arg if -after, -before or -current
299	 * 2 args in all other cases
300	 */
301	if (flag == DB_AFTER || flag == DB_BEFORE || flag == DB_CURRENT) {
302		if (i != (objc - 1)) {
303			Tcl_WrongNumArgs(interp, 2, objv,
304			    "?-args? data");
305			result = TCL_ERROR;
306			goto out;
307		}
308		/*
309		 * We want to get the key back, so we need to set
310		 * up the location to get it back in.
311		 */
312		if (type == DB_RECNO || type == DB_QUEUE) {
313			recno = 0;
314			key.data = &recno;
315			key.size = sizeof(db_recno_t);
316		}
317	} else {
318		if (i != (objc - 2)) {
319			Tcl_WrongNumArgs(interp, 2, objv,
320			    "?-args? key data");
321			result = TCL_ERROR;
322			goto out;
323		}
324		if (type == DB_RECNO || type == DB_QUEUE) {
325			result = _GetUInt32(interp, objv[objc-2], &recno);
326			if (result == TCL_OK) {
327				key.data = &recno;
328				key.size = sizeof(db_recno_t);
329			} else
330				return (result);
331		} else {
332			ret = _CopyObjBytes(interp, objv[objc-2], &ktmp,
333			    &key.size, &freekey);
334			if (ret != 0) {
335				result = _ReturnSetup(interp, ret,
336				    DB_RETOK_DBCPUT(ret), "dbc put");
337				return (result);
338			}
339			key.data = ktmp;
340		}
341	}
342	ret = _CopyObjBytes(interp, objv[objc-1], &dtmp,
343	    &data.size, &freedata);
344	data.data = dtmp;
345	if (ret != 0) {
346		result = _ReturnSetup(interp, ret,
347		    DB_RETOK_DBCPUT(ret), "dbc put");
348		goto out;
349	}
350	_debug_check();
351	ret = dbc->put(dbc, &key, &data, flag);
352	result = _ReturnSetup(interp, ret, DB_RETOK_DBCPUT(ret),
353	    "dbc put");
354	if (ret == 0 &&
355	    (flag == DB_AFTER || flag == DB_BEFORE) && type == DB_RECNO) {
356		res = Tcl_NewWideIntObj((Tcl_WideInt)*(db_recno_t *)key.data);
357		Tcl_SetObjResult(interp, res);
358	}
359out:
360	if (freedata)
361		__os_free(NULL, dtmp);
362	if (freekey)
363		__os_free(NULL, ktmp);
364	return (result);
365}
366
367/*
368 * tcl_dbc_get --
369 */
370static int
371tcl_DbcGet(interp, objc, objv, dbc, ispget)
372	Tcl_Interp *interp;		/* Interpreter */
373	int objc;			/* How many arguments? */
374	Tcl_Obj *CONST objv[];		/* The argument objects */
375	DBC *dbc;			/* Cursor pointer */
376	int ispget;			/* 1 for pget, 0 for get */
377{
378	static const char *dbcgetopts[] = {
379#ifdef CONFIG_TEST
380		"-data_buf_size",
381		"-get_both_range",
382		"-key_buf_size",
383		"-multi",
384		"-multi_key",
385		"-nolease",
386		"-read_committed",
387		"-read_uncommitted",
388#endif
389		"-current",
390		"-first",
391		"-get_both",
392		"-get_recno",
393		"-join_item",
394		"-last",
395		"-next",
396		"-nextdup",
397		"-nextnodup",
398		"-partial",
399		"-prev",
400		"-prevdup",
401		"-prevnodup",
402		"-rmw",
403		"-set",
404		"-set_range",
405		"-set_recno",
406		NULL
407	};
408	enum dbcgetopts {
409#ifdef CONFIG_TEST
410		DBCGET_DATA_BUF_SIZE,
411		DBCGET_BOTH_RANGE,
412		DBCGET_KEY_BUF_SIZE,
413		DBCGET_MULTI,
414		DBCGET_MULTI_KEY,
415		DBCGET_NOLEASE,
416		DBCGET_READ_COMMITTED,
417		DBCGET_READ_UNCOMMITTED,
418#endif
419		DBCGET_CURRENT,
420		DBCGET_FIRST,
421		DBCGET_BOTH,
422		DBCGET_RECNO,
423		DBCGET_JOIN,
424		DBCGET_LAST,
425		DBCGET_NEXT,
426		DBCGET_NEXTDUP,
427		DBCGET_NEXTNODUP,
428		DBCGET_PART,
429		DBCGET_PREV,
430		DBCGET_PREVDUP,
431		DBCGET_PREVNODUP,
432		DBCGET_RMW,
433		DBCGET_SET,
434		DBCGET_SETRANGE,
435		DBCGET_SETRECNO
436	};
437	DB *thisdbp;
438	DBT key, data, pdata;
439	DBTCL_INFO *dbcip, *dbip;
440	DBTYPE ptype, type;
441	Tcl_Obj **elemv, *myobj, *retlist;
442	void *dtmp, *ktmp;
443	db_recno_t precno, recno;
444	u_int32_t flag, op;
445	int elemc, freekey, freedata, i, optindex, result, ret;
446#ifdef CONFIG_TEST
447	int data_buf_size, key_buf_size;
448
449	data_buf_size = key_buf_size = 0;
450#endif
451	COMPQUIET(dtmp, NULL);
452	COMPQUIET(ktmp, NULL);
453
454	result = TCL_OK;
455	flag = 0;
456	freekey = freedata = 0;
457	memset(&key, 0, sizeof(key));
458	memset(&data, 0, sizeof(data));
459	memset(&pdata, 0, sizeof(DBT));
460
461	if (objc < 2) {
462		Tcl_WrongNumArgs(interp, 2, objv, "?-args? ?key?");
463		return (TCL_ERROR);
464	}
465
466	/*
467	 * Get the command name index from the object based on the options
468	 * defined above.
469	 */
470	i = 2;
471	while (i < objc) {
472		if (Tcl_GetIndexFromObj(interp, objv[i], dbcgetopts,
473		    "option", TCL_EXACT, &optindex) != TCL_OK) {
474			/*
475			 * Reset the result so we don't get
476			 * an errant error message if there is another error.
477			 */
478			if (IS_HELP(objv[i]) == TCL_OK) {
479				result = TCL_OK;
480				goto out;
481			}
482			Tcl_ResetResult(interp);
483			break;
484		}
485		i++;
486
487#define	FLAG_CHECK2_STDARG	\
488	(DB_RMW | DB_MULTIPLE | DB_MULTIPLE_KEY | DB_IGNORE_LEASE | \
489	DB_READ_UNCOMMITTED)
490
491		switch ((enum dbcgetopts)optindex) {
492#ifdef CONFIG_TEST
493		case DBCGET_DATA_BUF_SIZE:
494			result =
495			    Tcl_GetIntFromObj(interp, objv[i], &data_buf_size);
496			if (result != TCL_OK)
497				goto out;
498			i++;
499			break;
500		case DBCGET_BOTH_RANGE:
501			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
502			flag |= DB_GET_BOTH_RANGE;
503			break;
504		case DBCGET_KEY_BUF_SIZE:
505			result =
506			    Tcl_GetIntFromObj(interp, objv[i], &key_buf_size);
507			if (result != TCL_OK)
508				goto out;
509			i++;
510			break;
511		case DBCGET_MULTI:
512			flag |= DB_MULTIPLE;
513			result =
514			    Tcl_GetIntFromObj(interp, objv[i], &data_buf_size);
515			if (result != TCL_OK)
516				goto out;
517			i++;
518			break;
519		case DBCGET_MULTI_KEY:
520			flag |= DB_MULTIPLE_KEY;
521			result =
522			    Tcl_GetIntFromObj(interp, objv[i], &data_buf_size);
523			if (result != TCL_OK)
524				goto out;
525			i++;
526			break;
527		case DBCGET_NOLEASE:
528			flag |= DB_IGNORE_LEASE;
529			break;
530		case DBCGET_READ_COMMITTED:
531			flag |= DB_READ_COMMITTED;
532			break;
533		case DBCGET_READ_UNCOMMITTED:
534			flag |= DB_READ_UNCOMMITTED;
535			break;
536#endif
537		case DBCGET_RMW:
538			flag |= DB_RMW;
539			break;
540		case DBCGET_CURRENT:
541			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
542			flag |= DB_CURRENT;
543			break;
544		case DBCGET_FIRST:
545			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
546			flag |= DB_FIRST;
547			break;
548		case DBCGET_LAST:
549			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
550			flag |= DB_LAST;
551			break;
552		case DBCGET_NEXT:
553			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
554			flag |= DB_NEXT;
555			break;
556		case DBCGET_PREV:
557			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
558			flag |= DB_PREV;
559			break;
560		case DBCGET_PREVDUP:
561			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
562			flag |= DB_PREV_DUP;
563			break;
564		case DBCGET_PREVNODUP:
565			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
566			flag |= DB_PREV_NODUP;
567			break;
568		case DBCGET_NEXTNODUP:
569			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
570			flag |= DB_NEXT_NODUP;
571			break;
572		case DBCGET_NEXTDUP:
573			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
574			flag |= DB_NEXT_DUP;
575			break;
576		case DBCGET_BOTH:
577			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
578			flag |= DB_GET_BOTH;
579			break;
580		case DBCGET_RECNO:
581			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
582			flag |= DB_GET_RECNO;
583			break;
584		case DBCGET_JOIN:
585			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
586			flag |= DB_JOIN_ITEM;
587			break;
588		case DBCGET_SET:
589			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
590			flag |= DB_SET;
591			break;
592		case DBCGET_SETRANGE:
593			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
594			flag |= DB_SET_RANGE;
595			break;
596		case DBCGET_SETRECNO:
597			FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
598			flag |= DB_SET_RECNO;
599			break;
600		case DBCGET_PART:
601			if (i == objc) {
602				Tcl_WrongNumArgs(interp, 2, objv,
603				    "?-partial {offset length}?");
604				result = TCL_ERROR;
605				break;
606			}
607			/*
608			 * Get sublist as {offset length}
609			 */
610			result = Tcl_ListObjGetElements(interp, objv[i++],
611			    &elemc, &elemv);
612			if (elemc != 2) {
613				Tcl_SetResult(interp,
614				    "List must be {offset length}", TCL_STATIC);
615				result = TCL_ERROR;
616				break;
617			}
618			data.flags |= DB_DBT_PARTIAL;
619			result = _GetUInt32(interp, elemv[0], &data.doff);
620			if (result != TCL_OK)
621				break;
622			result = _GetUInt32(interp, elemv[1], &data.dlen);
623			/*
624			 * NOTE: We don't check result here because all we'd
625			 * do is break anyway, and we are doing that.  If you
626			 * add code here, you WILL need to add the check
627			 * for result.  (See the check for save.doff, a few
628			 * lines above and copy that.)
629			 */
630			break;
631		}
632		if (result != TCL_OK)
633			break;
634	}
635	if (result != TCL_OK)
636		goto out;
637
638	/*
639	 * We need to determine if we are a recno database
640	 * or not.  If we are, then key.data is a recno, not
641	 * a string.
642	 */
643	dbcip = _PtrToInfo(dbc);
644	if (dbcip == NULL) {
645		type = DB_UNKNOWN;
646		ptype = DB_UNKNOWN;
647	} else {
648		dbip = dbcip->i_parent;
649		if (dbip == NULL) {
650			Tcl_SetResult(interp, "Cursor without parent database",
651			    TCL_STATIC);
652			result = TCL_ERROR;
653			goto out;
654		}
655		thisdbp = dbip->i_dbp;
656		(void)thisdbp->get_type(thisdbp, &type);
657		if (ispget && thisdbp->s_primary != NULL)
658			(void)thisdbp->
659			    s_primary->get_type(thisdbp->s_primary, &ptype);
660		else
661			ptype = DB_UNKNOWN;
662	}
663	/*
664	 * When we get here, we better have:
665	 * 2 args, key and data if GET_BOTH/GET_BOTH_RANGE was specified.
666	 * 1 arg if -set, -set_range or -set_recno
667	 * 0 in all other cases.
668	 */
669	op = flag & DB_OPFLAGS_MASK;
670	switch (op) {
671	case DB_GET_BOTH:
672#ifdef CONFIG_TEST
673	case DB_GET_BOTH_RANGE:
674#endif
675		if (i != (objc - 2)) {
676			Tcl_WrongNumArgs(interp, 2, objv,
677			    "?-args? -get_both key data");
678			result = TCL_ERROR;
679			goto out;
680		} else {
681			if (type == DB_RECNO || type == DB_QUEUE) {
682				result = _GetUInt32(
683				    interp, objv[objc-2], &recno);
684				if (result == TCL_OK) {
685					key.data = &recno;
686					key.size = sizeof(db_recno_t);
687				} else
688					goto out;
689			} else {
690				/*
691				 * Some get calls (SET_*) can change the
692				 * key pointers.  So, we need to store
693				 * the allocated key space in a tmp.
694				 */
695				ret = _CopyObjBytes(interp, objv[objc-2],
696				    &ktmp, &key.size, &freekey);
697				if (ret != 0) {
698					result = _ReturnSetup(interp, ret,
699					    DB_RETOK_DBCGET(ret), "dbc get");
700					return (result);
701				}
702				key.data = ktmp;
703			}
704			if (ptype == DB_RECNO || ptype == DB_QUEUE) {
705				result = _GetUInt32(
706				    interp, objv[objc-1], &precno);
707				if (result == TCL_OK) {
708					data.data = &precno;
709					data.size = sizeof(db_recno_t);
710				} else
711					goto out;
712			} else {
713				ret = _CopyObjBytes(interp, objv[objc-1],
714				    &dtmp, &data.size, &freedata);
715				if (ret != 0) {
716					result = _ReturnSetup(interp, ret,
717					    DB_RETOK_DBCGET(ret), "dbc get");
718					goto out;
719				}
720				data.data = dtmp;
721			}
722		}
723		break;
724	case DB_SET:
725	case DB_SET_RANGE:
726	case DB_SET_RECNO:
727		if (i != (objc - 1)) {
728			Tcl_WrongNumArgs(interp, 2, objv, "?-args? key");
729			result = TCL_ERROR;
730			goto out;
731		}
732#ifdef CONFIG_TEST
733		if (data_buf_size != 0) {
734			(void)__os_malloc(
735			    NULL, (size_t)data_buf_size, &data.data);
736			data.ulen = (u_int32_t)data_buf_size;
737			data.flags |= DB_DBT_USERMEM;
738		} else
739#endif
740			data.flags |= DB_DBT_MALLOC;
741		if (op == DB_SET_RECNO ||
742		    type == DB_RECNO || type == DB_QUEUE) {
743			result = _GetUInt32(interp, objv[objc - 1], &recno);
744			key.data = &recno;
745			key.size = sizeof(db_recno_t);
746		} else {
747			/*
748			 * Some get calls (SET_*) can change the
749			 * key pointers.  So, we need to store
750			 * the allocated key space in a tmp.
751			 */
752			ret = _CopyObjBytes(interp, objv[objc-1],
753			    &ktmp, &key.size, &freekey);
754			if (ret != 0) {
755				result = _ReturnSetup(interp, ret,
756				    DB_RETOK_DBCGET(ret), "dbc get");
757				return (result);
758			}
759			key.data = ktmp;
760		}
761		break;
762	default:
763		if (i != objc) {
764			Tcl_WrongNumArgs(interp, 2, objv, "?-args?");
765			result = TCL_ERROR;
766			goto out;
767		}
768#ifdef CONFIG_TEST
769		if (key_buf_size != 0) {
770			(void)__os_malloc(
771			    NULL, (size_t)key_buf_size, &key.data);
772			key.ulen = (u_int32_t)key_buf_size;
773			key.flags |= DB_DBT_USERMEM;
774		} else
775#endif
776			key.flags |= DB_DBT_MALLOC;
777#ifdef CONFIG_TEST
778		if (data_buf_size != 0) {
779			(void)__os_malloc(
780			    NULL, (size_t)data_buf_size, &data.data);
781			data.ulen = (u_int32_t)data_buf_size;
782			data.flags |= DB_DBT_USERMEM;
783		} else
784#endif
785			data.flags |= DB_DBT_MALLOC;
786	}
787
788	_debug_check();
789	if (ispget) {
790		F_SET(&pdata, DB_DBT_MALLOC);
791		ret = dbc->pget(dbc, &key, &data, &pdata, flag);
792	} else
793		ret = dbc->get(dbc, &key, &data, flag);
794	result = _ReturnSetup(interp, ret, DB_RETOK_DBCGET(ret), "dbc get");
795	if (result == TCL_ERROR)
796		goto out;
797
798	retlist = Tcl_NewListObj(0, NULL);
799	if (ret != 0)
800		goto out1;
801	if (op == DB_GET_RECNO) {
802		recno = *((db_recno_t *)data.data);
803		myobj = Tcl_NewWideIntObj((Tcl_WideInt)recno);
804		result = Tcl_ListObjAppendElement(interp, retlist, myobj);
805	} else {
806		if (flag & (DB_MULTIPLE|DB_MULTIPLE_KEY))
807			result = _SetMultiList(interp,
808			    retlist, &key, &data, type, flag);
809		else if ((type == DB_RECNO || type == DB_QUEUE) &&
810		    key.data != NULL) {
811			if (ispget)
812				result = _Set3DBTList(interp, retlist, &key, 1,
813				    &data,
814				    (ptype == DB_RECNO || ptype == DB_QUEUE),
815				    &pdata);
816			else
817				result = _SetListRecnoElem(interp, retlist,
818				    *(db_recno_t *)key.data,
819				    data.data, data.size);
820		} else {
821			if (ispget)
822				result = _Set3DBTList(interp, retlist, &key, 0,
823				    &data,
824				    (ptype == DB_RECNO || ptype == DB_QUEUE),
825				    &pdata);
826			else
827				result = _SetListElem(interp, retlist,
828				    key.data, key.size, data.data, data.size);
829		}
830	}
831out1:
832	if (result == TCL_OK)
833		Tcl_SetObjResult(interp, retlist);
834	/*
835	 * If DB_DBT_MALLOC is set we need to free if DB allocated anything.
836	 * If DB_DBT_USERMEM is set we need to free it because
837	 * we allocated it (for data_buf_size/key_buf_size).  That
838	 * allocation does not apply to the pdata DBT.
839	 */
840out:
841	if (key.data != NULL && F_ISSET(&key, DB_DBT_MALLOC))
842		__os_ufree(dbc->env, key.data);
843	if (key.data != NULL && F_ISSET(&key, DB_DBT_USERMEM))
844		__os_free(dbc->env, key.data);
845	if (data.data != NULL && F_ISSET(&data, DB_DBT_MALLOC))
846		__os_ufree(dbc->env, data.data);
847	if (data.data != NULL && F_ISSET(&data, DB_DBT_USERMEM))
848		__os_free(dbc->env, data.data);
849	if (pdata.data != NULL && F_ISSET(&pdata, DB_DBT_MALLOC))
850		__os_ufree(dbc->env, pdata.data);
851	if (freedata)
852		__os_free(NULL, dtmp);
853	if (freekey)
854		__os_free(NULL, ktmp);
855	return (result);
856
857}
858
859/*
860 * tcl_DbcDup --
861 */
862static int
863tcl_DbcDup(interp, objc, objv, dbc)
864	Tcl_Interp *interp;		/* Interpreter */
865	int objc;			/* How many arguments? */
866	Tcl_Obj *CONST objv[];		/* The argument objects */
867	DBC *dbc;			/* Cursor pointer */
868{
869	static const char *dbcdupopts[] = {
870		"-position",
871		NULL
872	};
873	enum dbcdupopts {
874		DBCDUP_POS
875	};
876	DBC *newdbc;
877	DBTCL_INFO *dbcip, *newdbcip, *dbip;
878	Tcl_Obj *res;
879	u_int32_t flag;
880	int i, optindex, result, ret;
881	char newname[MSG_SIZE];
882
883	result = TCL_OK;
884	flag = 0;
885	res = NULL;
886
887	if (objc < 2) {
888		Tcl_WrongNumArgs(interp, 2, objv, "?-args?");
889		return (TCL_ERROR);
890	}
891
892	/*
893	 * Get the command name index from the object based on the options
894	 * defined above.
895	 */
896	i = 2;
897	while (i < objc) {
898		if (Tcl_GetIndexFromObj(interp, objv[i], dbcdupopts,
899		    "option", TCL_EXACT, &optindex) != TCL_OK) {
900			/*
901			 * Reset the result so we don't get
902			 * an errant error message if there is another error.
903			 */
904			if (IS_HELP(objv[i]) == TCL_OK) {
905				result = TCL_OK;
906				goto out;
907			}
908			Tcl_ResetResult(interp);
909			break;
910		}
911		i++;
912		switch ((enum dbcdupopts)optindex) {
913		case DBCDUP_POS:
914			flag = DB_POSITION;
915			break;
916		}
917		if (result != TCL_OK)
918			break;
919	}
920	if (result != TCL_OK)
921		goto out;
922
923	/*
924	 * We need to determine if we are a recno database
925	 * or not.  If we are, then key.data is a recno, not
926	 * a string.
927	 */
928	dbcip = _PtrToInfo(dbc);
929	if (dbcip == NULL) {
930		Tcl_SetResult(interp, "Cursor without info structure",
931		    TCL_STATIC);
932		result = TCL_ERROR;
933		goto out;
934	} else {
935		dbip = dbcip->i_parent;
936		if (dbip == NULL) {
937			Tcl_SetResult(interp, "Cursor without parent database",
938			    TCL_STATIC);
939			result = TCL_ERROR;
940			goto out;
941		}
942	}
943	/*
944	 * Now duplicate the cursor.  If successful, we need to create
945	 * a new cursor command.
946	 */
947	snprintf(newname, sizeof(newname),
948	    "%s.c%d", dbip->i_name, dbip->i_dbdbcid);
949	newdbcip = _NewInfo(interp, NULL, newname, I_DBC);
950	if (newdbcip != NULL) {
951		ret = dbc->dup(dbc, &newdbc, flag);
952		if (ret == 0) {
953			dbip->i_dbdbcid++;
954			newdbcip->i_parent = dbip;
955			(void)Tcl_CreateObjCommand(interp, newname,
956			    (Tcl_ObjCmdProc *)dbc_Cmd,
957			    (ClientData)newdbc, NULL);
958			res = NewStringObj(newname, strlen(newname));
959			_SetInfoData(newdbcip, newdbc);
960			Tcl_SetObjResult(interp, res);
961		} else {
962			result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
963			    "db dup");
964			_DeleteInfo(newdbcip);
965		}
966	} else {
967		Tcl_SetResult(interp, "Could not set up info", TCL_STATIC);
968		result = TCL_ERROR;
969	}
970out:
971	return (result);
972
973}
974