2
* See the file LICENSE for redistribution information.
4
* Copyright (c) 1999-2001
5
* Sleepycat Software. All rights reserved.
11
static const char revid[] = "$Id$";
14
#ifndef NO_SYSTEM_INCLUDES
15
#include <sys/types.h>
23
#include "dbinc/tcl_db.h"
26
* Prototypes for procedures defined later in this file:
28
static int tcl_DbcDup __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *));
29
static int tcl_DbcGet __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *, int));
30
static int tcl_DbcPut __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *));
33
* PUBLIC: int dbc_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*));
36
* Implements the cursor command.
39
dbc_Cmd(clientData, interp, objc, objv)
40
ClientData clientData; /* Cursor handle */
41
Tcl_Interp *interp; /* Interpreter */
42
int objc; /* How many arguments? */
43
Tcl_Obj *CONST objv[]; /* The argument objects */
45
static char *dbccmds[] = {
68
int cmdindex, result, ret;
70
Tcl_ResetResult(interp);
71
dbc = (DBC *)clientData;
72
dbip = _PtrToInfo((void *)dbc);
76
Tcl_WrongNumArgs(interp, 1, objv, "command cmdargs");
80
Tcl_SetResult(interp, "NULL dbc pointer", TCL_STATIC);
84
Tcl_SetResult(interp, "NULL dbc info pointer", TCL_STATIC);
89
* Get the command name index from the object based on the berkdbcmds
92
if (Tcl_GetIndexFromObj(interp, objv[1], dbccmds, "command",
93
TCL_EXACT, &cmdindex) != TCL_OK)
94
return (IS_HELP(objv[1]));
95
switch ((enum dbccmds)cmdindex) {
98
result = tcl_DbcGet(interp, objc, objv, dbc, 1);
103
* No args for this. Error if there are some.
106
Tcl_WrongNumArgs(interp, 2, objv, NULL);
110
ret = dbc->c_close(dbc);
111
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
113
if (result == TCL_OK) {
114
(void)Tcl_DeleteCommand(interp, dbip->i_name);
120
* No args for this. Error if there are some.
123
Tcl_WrongNumArgs(interp, 2, objv, NULL);
127
ret = dbc->c_del(dbc, 0);
128
result = _ReturnSetup(interp, ret, DB_RETOK_DBCDEL(ret),
132
result = tcl_DbcDup(interp, objc, objv, dbc);
135
result = tcl_DbcGet(interp, objc, objv, dbc, 0);
138
result = tcl_DbcPut(interp, objc, objv, dbc);
148
tcl_DbcPut(interp, objc, objv, dbc)
149
Tcl_Interp *interp; /* Interpreter */
150
int objc; /* How many arguments? */
151
Tcl_Obj *CONST objv[]; /* The argument objects */
152
DBC *dbc; /* Cursor pointer */
154
static char *dbcutopts[] = {
179
DBTCL_INFO *dbcip, *dbip;
181
Tcl_Obj **elemv, *res;
185
int elemc, freekey, freedata, i, optindex, result, ret;
189
freekey = freedata = 0;
192
Tcl_WrongNumArgs(interp, 2, objv, "?-args? ?key?");
196
memset(&key, 0, sizeof(key));
197
memset(&data, 0, sizeof(data));
200
* Get the command name index from the object based on the options
204
while (i < (objc - 1)) {
205
if (Tcl_GetIndexFromObj(interp, objv[i], dbcutopts, "option",
206
TCL_EXACT, &optindex) != TCL_OK) {
208
* Reset the result so we don't get
209
* an errant error message if there is another error.
211
if (IS_HELP(objv[i]) == TCL_OK) {
215
Tcl_ResetResult(interp);
219
switch ((enum dbcutopts)optindex) {
221
case DBCPUT_NODUPDATA:
238
case DBCPUT_KEYFIRST:
247
if (i > (objc - 2)) {
248
Tcl_WrongNumArgs(interp, 2, objv,
249
"?-partial {offset length}?");
254
* Get sublist as {offset length}
256
result = Tcl_ListObjGetElements(interp, objv[i++],
259
Tcl_SetResult(interp,
260
"List must be {offset length}", TCL_STATIC);
264
data.flags |= DB_DBT_PARTIAL;
265
result = _GetUInt32(interp, elemv[0], &data.doff);
266
if (result != TCL_OK)
268
result = _GetUInt32(interp, elemv[1], &data.dlen);
270
* NOTE: We don't check result here because all we'd
271
* do is break anyway, and we are doing that. If you
272
* add code here, you WILL need to add the check
273
* for result. (See the check for save.doff, a few
274
* lines above and copy that.)
277
if (result != TCL_OK)
280
if (result != TCL_OK)
284
* We need to determine if we are a recno database or not. If we are,
285
* then key.data is a recno, not a string.
287
dbcip = _PtrToInfo(dbc);
291
dbip = dbcip->i_parent;
293
Tcl_SetResult(interp, "Cursor without parent database",
298
thisdbp = dbip->i_dbp;
299
(void)thisdbp->get_type(thisdbp, &type);
302
* When we get here, we better have:
303
* 1 arg if -after, -before or -current
304
* 2 args in all other cases
306
if (flag == DB_AFTER || flag == DB_BEFORE || flag == DB_CURRENT) {
307
if (i != (objc - 1)) {
308
Tcl_WrongNumArgs(interp, 2, objv,
314
* We want to get the key back, so we need to set
315
* up the location to get it back in.
317
if (type == DB_RECNO || type == DB_QUEUE) {
320
key.size = sizeof(db_recno_t);
323
if (i != (objc - 2)) {
324
Tcl_WrongNumArgs(interp, 2, objv,
329
if (type == DB_RECNO || type == DB_QUEUE) {
330
result = _GetUInt32(interp, objv[objc-2], &recno);
331
if (result == TCL_OK) {
333
key.size = sizeof(db_recno_t);
337
ret = _CopyObjBytes(interp, objv[objc-2], &ktmp,
338
&key.size, &freekey);
340
result = _ReturnSetup(interp, ret,
341
DB_RETOK_DBCPUT(ret), "dbc put");
347
ret = _CopyObjBytes(interp, objv[objc-1], &dtmp,
348
&data.size, &freedata);
351
result = _ReturnSetup(interp, ret,
352
DB_RETOK_DBCPUT(ret), "dbc put");
356
ret = dbc->c_put(dbc, &key, &data, flag);
357
result = _ReturnSetup(interp, ret, DB_RETOK_DBCPUT(ret),
360
(flag == DB_AFTER || flag == DB_BEFORE) && type == DB_RECNO) {
361
res = Tcl_NewLongObj((long)*(db_recno_t *)key.data);
362
Tcl_SetObjResult(interp, res);
366
(void)__os_free(NULL, dtmp);
368
(void)__os_free(NULL, ktmp);
376
tcl_DbcGet(interp, objc, objv, dbc, ispget)
377
Tcl_Interp *interp; /* Interpreter */
378
int objc; /* How many arguments? */
379
Tcl_Obj *CONST objv[]; /* The argument objects */
380
DBC *dbc; /* Cursor pointer */
381
int ispget; /* 1 for pget, 0 for get */
383
static char *dbcgetopts[] = {
433
DBT key, data, pdata;
434
DBTCL_INFO *dbcip, *dbip;
436
Tcl_Obj **elemv, *myobj, *retlist;
438
db_recno_t precno, recno;
440
int bufsize, elemc, freekey, freedata, i, optindex, result, ret;
444
freekey = freedata = 0;
447
Tcl_WrongNumArgs(interp, 2, objv, "?-args? ?key?");
451
memset(&key, 0, sizeof(key));
452
memset(&data, 0, sizeof(data));
454
* Get the command name index from the object based on the options
459
if (Tcl_GetIndexFromObj(interp, objv[i], dbcgetopts,
460
"option", TCL_EXACT, &optindex) != TCL_OK) {
462
* Reset the result so we don't get
463
* an errant error message if there is another error.
465
if (IS_HELP(objv[i]) == TCL_OK) {
469
Tcl_ResetResult(interp);
473
switch ((enum dbcgetopts)optindex) {
476
flag |= DB_DIRTY_READ;
478
case DBCGET_BOTH_RANGE:
480
DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ);
481
flag |= DB_GET_BOTH_RANGE;
485
result = Tcl_GetIntFromObj(interp, objv[i], &bufsize);
486
if (result != TCL_OK)
490
case DBCGET_MULTI_KEY:
491
flag |= DB_MULTIPLE_KEY;
492
result = Tcl_GetIntFromObj(interp, objv[i], &bufsize);
493
if (result != TCL_OK)
503
DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ);
508
DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ);
513
DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ);
518
DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ);
523
DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ);
526
case DBCGET_PREVNODUP:
528
DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ);
529
flag |= DB_PREV_NODUP;
531
case DBCGET_NEXTNODUP:
533
DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ);
534
flag |= DB_NEXT_NODUP;
538
DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ);
543
DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ);
548
DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ);
549
flag |= DB_GET_RECNO;
553
DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ);
554
flag |= DB_JOIN_ITEM;
558
DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ);
561
case DBCGET_SETRANGE:
563
DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ);
564
flag |= DB_SET_RANGE;
566
case DBCGET_SETRECNO:
568
DB_RMW|DB_MULTIPLE|DB_MULTIPLE_KEY|DB_DIRTY_READ);
569
flag |= DB_SET_RECNO;
573
Tcl_WrongNumArgs(interp, 2, objv,
574
"?-partial {offset length}?");
579
* Get sublist as {offset length}
581
result = Tcl_ListObjGetElements(interp, objv[i++],
584
Tcl_SetResult(interp,
585
"List must be {offset length}", TCL_STATIC);
589
data.flags |= DB_DBT_PARTIAL;
590
result = _GetUInt32(interp, elemv[0], &data.doff);
591
if (result != TCL_OK)
593
result = _GetUInt32(interp, elemv[1], &data.dlen);
595
* NOTE: We don't check result here because all we'd
596
* do is break anyway, and we are doing that. If you
597
* add code here, you WILL need to add the check
598
* for result. (See the check for save.doff, a few
599
* lines above and copy that.)
603
if (result != TCL_OK)
606
if (result != TCL_OK)
610
* We need to determine if we are a recno database
611
* or not. If we are, then key.data is a recno, not
614
dbcip = _PtrToInfo(dbc);
619
dbip = dbcip->i_parent;
621
Tcl_SetResult(interp, "Cursor without parent database",
626
thisdbp = dbip->i_dbp;
627
(void)thisdbp->get_type(thisdbp, &type);
628
if (ispget && thisdbp->s_primary != NULL)
630
s_primary->get_type(thisdbp->s_primary, &ptype);
635
* When we get here, we better have:
636
* 2 args, key and data if GET_BOTH/GET_BOTH_RANGE was specified.
637
* 1 arg if -set, -set_range or -set_recno
638
* 0 in all other cases.
640
op = flag & DB_OPFLAGS_MASK;
644
case DB_GET_BOTH_RANGE:
646
if (i != (objc - 2)) {
647
Tcl_WrongNumArgs(interp, 2, objv,
648
"?-args? -get_both key data");
652
if (type == DB_RECNO || type == DB_QUEUE) {
654
interp, objv[objc-2], &recno);
655
if (result == TCL_OK) {
657
key.size = sizeof(db_recno_t);
662
* Some get calls (SET_*) can change the
663
* key pointers. So, we need to store
664
* the allocated key space in a tmp.
666
ret = _CopyObjBytes(interp, objv[objc-2],
667
&ktmp, &key.size, &freekey);
669
result = _ReturnSetup(interp, ret,
670
DB_RETOK_DBCGET(ret), "dbc get");
675
if (ptype == DB_RECNO || ptype == DB_QUEUE) {
677
interp, objv[objc-1], &precno);
678
if (result == TCL_OK) {
680
data.size = sizeof(db_recno_t);
684
ret = _CopyObjBytes(interp, objv[objc-1],
685
&dtmp, &data.size, &freedata);
687
result = _ReturnSetup(interp, ret,
688
DB_RETOK_DBCGET(ret), "dbc get");
698
if (i != (objc - 1)) {
699
Tcl_WrongNumArgs(interp, 2, objv, "?-args? key");
703
if (flag & (DB_MULTIPLE|DB_MULTIPLE_KEY)) {
704
(void)__os_malloc(NULL, bufsize, &data.data);
706
data.flags |= DB_DBT_USERMEM;
708
data.flags |= DB_DBT_MALLOC;
709
if (op == DB_SET_RECNO ||
710
type == DB_RECNO || type == DB_QUEUE) {
711
result = _GetUInt32(interp, objv[objc - 1], &recno);
713
key.size = sizeof(db_recno_t);
716
* Some get calls (SET_*) can change the
717
* key pointers. So, we need to store
718
* the allocated key space in a tmp.
720
ret = _CopyObjBytes(interp, objv[objc-1],
721
&ktmp, &key.size, &freekey);
723
result = _ReturnSetup(interp, ret,
724
DB_RETOK_DBCGET(ret), "dbc get");
732
Tcl_WrongNumArgs(interp, 2, objv, "?-args?");
736
key.flags |= DB_DBT_MALLOC;
737
if (flag & (DB_MULTIPLE|DB_MULTIPLE_KEY)) {
738
(void)__os_malloc(NULL, bufsize, &data.data);
740
data.flags |= DB_DBT_USERMEM;
742
data.flags |= DB_DBT_MALLOC;
746
memset(&pdata, 0, sizeof(DBT));
748
F_SET(&pdata, DB_DBT_MALLOC);
749
ret = dbc->c_pget(dbc, &key, &data, &pdata, flag);
751
ret = dbc->c_get(dbc, &key, &data, flag);
752
result = _ReturnSetup(interp, ret, DB_RETOK_DBCGET(ret), "dbc get");
753
if (result == TCL_ERROR)
756
retlist = Tcl_NewListObj(0, NULL);
757
if (ret == DB_NOTFOUND)
759
if (op == DB_GET_RECNO) {
760
recno = *((db_recno_t *)data.data);
761
myobj = Tcl_NewLongObj((long)recno);
762
result = Tcl_ListObjAppendElement(interp, retlist, myobj);
764
if (flag & (DB_MULTIPLE|DB_MULTIPLE_KEY))
765
result = _SetMultiList(interp,
766
retlist, &key, &data, type, flag);
767
else if ((type == DB_RECNO || type == DB_QUEUE) &&
770
result = _Set3DBTList(interp, retlist, &key, 1,
772
(ptype == DB_RECNO || ptype == DB_QUEUE),
775
result = _SetListRecnoElem(interp, retlist,
776
*(db_recno_t *)key.data,
777
data.data, data.size);
780
result = _Set3DBTList(interp, retlist, &key, 0,
782
(ptype == DB_RECNO || ptype == DB_QUEUE),
785
result = _SetListElem(interp, retlist,
786
key.data, key.size, data.data, data.size);
789
if (key.data != NULL && F_ISSET(&key, DB_DBT_MALLOC))
790
__os_ufree(dbc->dbp->dbenv, key.data);
791
if (data.data != NULL && F_ISSET(&data, DB_DBT_MALLOC))
792
__os_ufree(dbc->dbp->dbenv, data.data);
793
if (pdata.data != NULL && F_ISSET(&pdata, DB_DBT_MALLOC))
794
__os_ufree(dbc->dbp->dbenv, pdata.data);
796
if (result == TCL_OK)
797
Tcl_SetObjResult(interp, retlist);
799
if (data.data != NULL && flag & (DB_MULTIPLE|DB_MULTIPLE_KEY))
800
__os_free(dbc->dbp->dbenv, data.data);
802
(void)__os_free(NULL, dtmp);
804
(void)__os_free(NULL, ktmp);
813
tcl_DbcDup(interp, objc, objv, dbc)
814
Tcl_Interp *interp; /* Interpreter */
815
int objc; /* How many arguments? */
816
Tcl_Obj *CONST objv[]; /* The argument objects */
817
DBC *dbc; /* Cursor pointer */
819
static char *dbcdupopts[] = {
827
DBTCL_INFO *dbcip, *newdbcip, *dbip;
830
int i, optindex, result, ret;
831
char newname[MSG_SIZE];
838
Tcl_WrongNumArgs(interp, 2, objv, "?-args?");
843
* Get the command name index from the object based on the options
848
if (Tcl_GetIndexFromObj(interp, objv[i], dbcdupopts,
849
"option", TCL_EXACT, &optindex) != TCL_OK) {
851
* Reset the result so we don't get
852
* an errant error message if there is another error.
854
if (IS_HELP(objv[i]) == TCL_OK) {
858
Tcl_ResetResult(interp);
862
switch ((enum dbcdupopts)optindex) {
867
if (result != TCL_OK)
870
if (result != TCL_OK)
874
* We need to determine if we are a recno database
875
* or not. If we are, then key.data is a recno, not
878
dbcip = _PtrToInfo(dbc);
880
Tcl_SetResult(interp, "Cursor without info structure",
885
dbip = dbcip->i_parent;
887
Tcl_SetResult(interp, "Cursor without parent database",
894
* Now duplicate the cursor. If successful, we need to create
895
* a new cursor command.
898
snprintf(newname, sizeof(newname),
899
"%s.c%d", dbip->i_name, dbip->i_dbdbcid);
900
newdbcip = _NewInfo(interp, NULL, newname, I_DBC);
901
if (newdbcip != NULL) {
902
ret = dbc->c_dup(dbc, &newdbc, flag);
905
newdbcip->i_parent = dbip;
906
Tcl_CreateObjCommand(interp, newname,
907
(Tcl_ObjCmdProc *)dbc_Cmd,
908
(ClientData)newdbc, NULL);
909
res = Tcl_NewStringObj(newname, strlen(newname));
910
_SetInfoData(newdbcip, newdbc);
911
Tcl_SetObjResult(interp, res);
913
result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
915
_DeleteInfo(newdbcip);
918
Tcl_SetResult(interp, "Could not set up info", TCL_STATIC);
added
removed
libdb/tcl/tcl_dbcursor.c
