Berkeley DB 4.4.16: /home/huihoo/src/db/db-4.4.16/tcl/tcl

00001 /*-
00002  * See the file LICENSE for redistribution information.
00003  *
00004  * Copyright (c) 1999-2005
00005  *      Sleepycat Software.  All rights reserved.
00006  *
00007  * $Id: tcl_dbcursor.c,v 12.2 2005/06/16 20:23:46 bostic Exp $
00008  */
00009 
00010 #include "db_config.h"
00011 
00012 #ifndef NO_SYSTEM_INCLUDES
00013 #include <sys/types.h>
00014 
00015 #include <stdlib.h>
00016 #include <string.h>
00017 #include <tcl.h>
00018 #endif
00019 
00020 #include "db_int.h"
00021 #include "dbinc/tcl_db.h"
00022 
00023 /*
00024  * Prototypes for procedures defined later in this file:
00025  */
00026 static int tcl_DbcDup __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *));
00027 static int tcl_DbcGet __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *, int));
00028 static int tcl_DbcPut __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *));
00029 
00030 /*
00031  * PUBLIC: int dbc_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*));
00032  *
00033  * dbc_cmd --
00034  *      Implements the cursor command.
00035  */
00036 int
00037 dbc_Cmd(clientData, interp, objc, objv)
00038         ClientData clientData;          /* Cursor handle */
00039         Tcl_Interp *interp;             /* Interpreter */
00040         int objc;                       /* How many arguments? */
00041         Tcl_Obj *CONST objv[];          /* The argument objects */
00042 {
00043         static const char *dbccmds[] = {
00044 #ifdef CONFIG_TEST
00045                 "pget",
00046 #endif
00047                 "close",
00048                 "del",
00049                 "dup",
00050                 "get",
00051                 "put",
00052                 NULL
00053         };
00054         enum dbccmds {
00055 #ifdef CONFIG_TEST
00056                 DBCPGET,
00057 #endif
00058                 DBCCLOSE,
00059                 DBCDELETE,
00060                 DBCDUP,
00061                 DBCGET,
00062                 DBCPUT
00063         };
00064         DBC *dbc;
00065         DBTCL_INFO *dbip;
00066         int cmdindex, result, ret;
00067 
00068         Tcl_ResetResult(interp);
00069         dbc = (DBC *)clientData;
00070         dbip = _PtrToInfo((void *)dbc);
00071         result = TCL_OK;
00072 
00073         if (objc <= 1) {
00074                 Tcl_WrongNumArgs(interp, 1, objv, "command cmdargs");
00075                 return (TCL_ERROR);
00076         }
00077         if (dbc == NULL) {
00078                 Tcl_SetResult(interp, "NULL dbc pointer", TCL_STATIC);
00079                 return (TCL_ERROR);
00080         }
00081         if (dbip == NULL) {
00082                 Tcl_SetResult(interp, "NULL dbc info pointer", TCL_STATIC);
00083                 return (TCL_ERROR);
00084         }
00085 
00086         /*
00087          * Get the command name index from the object based on the berkdbcmds
00088          * defined above.
00089          */
00090         if (Tcl_GetIndexFromObj(interp, objv[1], dbccmds, "command",
00091             TCL_EXACT, &cmdindex) != TCL_OK)
00092                 return (IS_HELP(objv[1]));
00093         switch ((enum dbccmds)cmdindex) {
00094 #ifdef CONFIG_TEST
00095         case DBCPGET:
00096                 result = tcl_DbcGet(interp, objc, objv, dbc, 1);
00097                 break;
00098 #endif
00099         case DBCCLOSE:
00100                 /*
00101                  * No args for this.  Error if there are some.
00102                  */
00103                 if (objc > 2) {
00104                         Tcl_WrongNumArgs(interp, 2, objv, NULL);
00105                         return (TCL_ERROR);
00106                 }
00107                 _debug_check();
00108                 ret = dbc->c_close(dbc);
00109                 result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
00110                     "dbc close");
00111                 if (result == TCL_OK) {
00112                         (void)Tcl_DeleteCommand(interp, dbip->i_name);
00113                         _DeleteInfo(dbip);
00114                 }
00115                 break;
00116         case DBCDELETE:
00117                 /*
00118                  * No args for this.  Error if there are some.
00119                  */
00120                 if (objc > 2) {
00121                         Tcl_WrongNumArgs(interp, 2, objv, NULL);
00122                         return (TCL_ERROR);
00123                 }
00124                 _debug_check();
00125                 ret = dbc->c_del(dbc, 0);
00126                 result = _ReturnSetup(interp, ret, DB_RETOK_DBCDEL(ret),
00127                     "dbc delete");
00128                 break;
00129         case DBCDUP:
00130                 result = tcl_DbcDup(interp, objc, objv, dbc);
00131                 break;
00132         case DBCGET:
00133                 result = tcl_DbcGet(interp, objc, objv, dbc, 0);
00134                 break;
00135         case DBCPUT:
00136                 result = tcl_DbcPut(interp, objc, objv, dbc);
00137                 break;
00138         }
00139         return (result);
00140 }
00141 
00142 /*
00143  * tcl_DbcPut --
00144  */
00145 static int
00146 tcl_DbcPut(interp, objc, objv, dbc)
00147         Tcl_Interp *interp;             /* Interpreter */
00148         int objc;                       /* How many arguments? */
00149         Tcl_Obj *CONST objv[];          /* The argument objects */
00150         DBC *dbc;                       /* Cursor pointer */
00151 {
00152         static const char *dbcutopts[] = {
00153 #ifdef CONFIG_TEST
00154                 "-nodupdata",
00155 #endif
00156                 "-after",
00157                 "-before",
00158                 "-current",
00159                 "-keyfirst",
00160                 "-keylast",
00161                 "-partial",
00162                 NULL
00163         };
00164         enum dbcutopts {
00165 #ifdef CONFIG_TEST
00166                 DBCPUT_NODUPDATA,
00167 #endif
00168                 DBCPUT_AFTER,
00169                 DBCPUT_BEFORE,
00170                 DBCPUT_CURRENT,
00171                 DBCPUT_KEYFIRST,
00172                 DBCPUT_KEYLAST,
00173                 DBCPUT_PART
00174         };
00175         DB *thisdbp;
00176         DBT key, data;
00177         DBTCL_INFO *dbcip, *dbip;
00178         DBTYPE type;
00179         Tcl_Obj **elemv, *res;
00180         void *dtmp, *ktmp;
00181         db_recno_t recno;
00182         u_int32_t flag;
00183         int elemc, freekey, freedata, i, optindex, result, ret;
00184 
00185         COMPQUIET(dtmp, NULL);
00186         COMPQUIET(ktmp, NULL);
00187 
00188         result = TCL_OK;
00189         flag = 0;
00190         freekey = freedata = 0;
00191 
00192         if (objc < 2) {
00193                 Tcl_WrongNumArgs(interp, 2, objv, "?-args? ?key?");
00194                 return (TCL_ERROR);
00195         }
00196 
00197         memset(&key, 0, sizeof(key));
00198         memset(&data, 0, sizeof(data));
00199 
00200         /*
00201          * Get the command name index from the object based on the options
00202          * defined above.
00203          */
00204         i = 2;
00205         while (i < (objc - 1)) {
00206                 if (Tcl_GetIndexFromObj(interp, objv[i], dbcutopts, "option",
00207                     TCL_EXACT, &optindex) != TCL_OK) {
00208                         /*
00209                          * Reset the result so we don't get
00210                          * an errant error message if there is another error.
00211                          */
00212                         if (IS_HELP(objv[i]) == TCL_OK) {
00213                                 result = TCL_OK;
00214                                 goto out;
00215                         }
00216                         Tcl_ResetResult(interp);
00217                         break;
00218                 }
00219                 i++;
00220                 switch ((enum dbcutopts)optindex) {
00221 #ifdef CONFIG_TEST
00222                 case DBCPUT_NODUPDATA:
00223                         FLAG_CHECK(flag);
00224                         flag = DB_NODUPDATA;
00225                         break;
00226 #endif
00227                 case DBCPUT_AFTER:
00228                         FLAG_CHECK(flag);
00229                         flag = DB_AFTER;
00230                         break;
00231                 case DBCPUT_BEFORE:
00232                         FLAG_CHECK(flag);
00233                         flag = DB_BEFORE;
00234                         break;
00235                 case DBCPUT_CURRENT:
00236                         FLAG_CHECK(flag);
00237                         flag = DB_CURRENT;
00238                         break;
00239                 case DBCPUT_KEYFIRST:
00240                         FLAG_CHECK(flag);
00241                         flag = DB_KEYFIRST;
00242                         break;
00243                 case DBCPUT_KEYLAST:
00244                         FLAG_CHECK(flag);
00245                         flag = DB_KEYLAST;
00246                         break;
00247                 case DBCPUT_PART:
00248                         if (i > (objc - 2)) {
00249                                 Tcl_WrongNumArgs(interp, 2, objv,
00250                                     "?-partial {offset length}?");
00251                                 result = TCL_ERROR;
00252                                 break;
00253                         }
00254                         /*
00255                          * Get sublist as {offset length}
00256                          */
00257                         result = Tcl_ListObjGetElements(interp, objv[i++],
00258                             &elemc, &elemv);
00259                         if (elemc != 2) {
00260                                 Tcl_SetResult(interp,
00261                                     "List must be {offset length}", TCL_STATIC);
00262                                 result = TCL_ERROR;
00263                                 break;
00264                         }
00265                         data.flags |= DB_DBT_PARTIAL;
00266                         result = _GetUInt32(interp, elemv[0], &data.doff);
00267                         if (result != TCL_OK)
00268                                 break;
00269                         result = _GetUInt32(interp, elemv[1], &data.dlen);
00270                         /*
00271                          * NOTE: We don't check result here because all we'd
00272                          * do is break anyway, and we are doing that.  If you
00273                          * add code here, you WILL need to add the check
00274                          * for result.  (See the check for save.doff, a few
00275                          * lines above and copy that.)
00276                          */
00277                 }
00278                 if (result != TCL_OK)
00279                         break;
00280         }
00281         if (result != TCL_OK)
00282                 goto out;
00283 
00284         /*
00285          * We need to determine if we are a recno database or not.  If we are,
00286          * then key.data is a recno, not a string.
00287          */
00288         dbcip = _PtrToInfo(dbc);
00289         if (dbcip == NULL)
00290                 type = DB_UNKNOWN;
00291         else {
00292                 dbip = dbcip->i_parent;
00293                 if (dbip == NULL) {
00294                         Tcl_SetResult(interp, "Cursor without parent database",
00295                             TCL_STATIC);
00296                         result = TCL_ERROR;
00297                         return (result);
00298                 }
00299                 thisdbp = dbip->i_dbp;
00300                 (void)thisdbp->get_type(thisdbp, &type);
00301         }
00302         /*
00303          * When we get here, we better have:
00304          * 1 arg if -after, -before or -current
00305          * 2 args in all other cases
00306          */
00307         if (flag == DB_AFTER || flag == DB_BEFORE || flag == DB_CURRENT) {
00308                 if (i != (objc - 1)) {
00309                         Tcl_WrongNumArgs(interp, 2, objv,
00310                             "?-args? data");
00311                         result = TCL_ERROR;
00312                         goto out;
00313                 }
00314                 /*
00315                  * We want to get the key back, so we need to set
00316                  * up the location to get it back in.
00317                  */
00318                 if (type == DB_RECNO || type == DB_QUEUE) {
00319                         recno = 0;
00320                         key.data = &recno;
00321                         key.size = sizeof(db_recno_t);
00322                 }
00323         } else {
00324                 if (i != (objc - 2)) {
00325                         Tcl_WrongNumArgs(interp, 2, objv,
00326                             "?-args? key data");
00327                         result = TCL_ERROR;
00328                         goto out;
00329                 }
00330                 if (type == DB_RECNO || type == DB_QUEUE) {
00331                         result = _GetUInt32(interp, objv[objc-2], &recno);
00332                         if (result == TCL_OK) {
00333                                 key.data = &recno;
00334                                 key.size = sizeof(db_recno_t);
00335                         } else
00336                                 return (result);
00337                 } else {
00338                         ret = _CopyObjBytes(interp, objv[objc-2], &ktmp,
00339                             &key.size, &freekey);
00340                         if (ret != 0) {
00341                                 result = _ReturnSetup(interp, ret,
00342                                     DB_RETOK_DBCPUT(ret), "dbc put");
00343                                 return (result);
00344                         }
00345                         key.data = ktmp;
00346                 }
00347         }
00348         ret = _CopyObjBytes(interp, objv[objc-1], &dtmp,
00349             &data.size, &freedata);
00350         data.data = dtmp;
00351         if (ret != 0) {
00352                 result = _ReturnSetup(interp, ret,
00353                     DB_RETOK_DBCPUT(ret), "dbc put");
00354                 goto out;
00355         }
00356         _debug_check();
00357         ret = dbc->c_put(dbc, &key, &data, flag);
00358         result = _ReturnSetup(interp, ret, DB_RETOK_DBCPUT(ret),
00359             "dbc put");
00360         if (ret == 0 &&
00361             (flag == DB_AFTER || flag == DB_BEFORE) && type == DB_RECNO) {
00362                 res = Tcl_NewWideIntObj((Tcl_WideInt)*(db_recno_t *)key.data);
00363                 Tcl_SetObjResult(interp, res);
00364         }
00365 out:
00366         if (freedata)
00367                 __os_free(NULL, dtmp);
00368         if (freekey)
00369                 __os_free(NULL, ktmp);
00370         return (result);
00371 }
00372 
00373 /*
00374  * tcl_dbc_get --
00375  */
00376 static int
00377 tcl_DbcGet(interp, objc, objv, dbc, ispget)
00378         Tcl_Interp *interp;             /* Interpreter */
00379         int objc;                       /* How many arguments? */
00380         Tcl_Obj *CONST objv[];          /* The argument objects */
00381         DBC *dbc;                       /* Cursor pointer */
00382         int ispget;                     /* 1 for pget, 0 for get */
00383 {
00384         static const char *dbcgetopts[] = {
00385 #ifdef CONFIG_TEST
00386                 "-get_both_range",
00387                 "-multi",
00388                 "-multi_key",
00389                 "-read_committed",
00390                 "-read_uncommitted",
00391 #endif
00392                 "-current",
00393                 "-first",
00394                 "-get_both",
00395                 "-get_recno",
00396                 "-join_item",
00397                 "-last",
00398                 "-next",
00399                 "-nextdup",
00400                 "-nextnodup",
00401                 "-partial",
00402                 "-prev",
00403                 "-prevnodup",
00404                 "-rmw",
00405                 "-set",
00406                 "-set_range",
00407                 "-set_recno",
00408                 NULL
00409         };
00410         enum dbcgetopts {
00411 #ifdef CONFIG_TEST
00412                 DBCGET_BOTH_RANGE,
00413                 DBCGET_MULTI,
00414                 DBCGET_MULTI_KEY,
00415                 DBCGET_READ_COMMITTED,
00416                 DBCGET_READ_UNCOMMITTED,
00417 #endif
00418                 DBCGET_CURRENT,
00419                 DBCGET_FIRST,
00420                 DBCGET_BOTH,
00421                 DBCGET_RECNO,
00422                 DBCGET_JOIN,
00423                 DBCGET_LAST,
00424                 DBCGET_NEXT,
00425                 DBCGET_NEXTDUP,
00426                 DBCGET_NEXTNODUP,
00427                 DBCGET_PART,
00428                 DBCGET_PREV,
00429                 DBCGET_PREVNODUP,
00430                 DBCGET_RMW,
00431                 DBCGET_SET,
00432                 DBCGET_SETRANGE,
00433                 DBCGET_SETRECNO
00434         };
00435         DB *thisdbp;
00436         DBT key, data, pdata;
00437         DBTCL_INFO *dbcip, *dbip;
00438         DBTYPE ptype, type;
00439         Tcl_Obj **elemv, *myobj, *retlist;
00440         void *dtmp, *ktmp;
00441         db_recno_t precno, recno;
00442         u_int32_t flag, op;
00443         int elemc, freekey, freedata, i, optindex, result, ret;
00444 #ifdef CONFIG_TEST
00445         int bufsize;
00446 
00447         bufsize = 0;
00448 #endif
00449         COMPQUIET(dtmp, NULL);
00450         COMPQUIET(ktmp, NULL);
00451 
00452         result = TCL_OK;
00453         flag = 0;
00454         freekey = freedata = 0;
00455 
00456         if (objc < 2) {
00457                 Tcl_WrongNumArgs(interp, 2, objv, "?-args? ?key?");
00458                 return (TCL_ERROR);
00459         }
00460 
00461         memset(&key, 0, sizeof(key));
00462         memset(&data, 0, sizeof(data));
00463         /*
00464          * Get the command name index from the object based on the options
00465          * defined above.
00466          */
00467         i = 2;
00468         while (i < objc) {
00469                 if (Tcl_GetIndexFromObj(interp, objv[i], dbcgetopts,
00470                     "option", TCL_EXACT, &optindex) != TCL_OK) {
00471                         /*
00472                          * Reset the result so we don't get
00473                          * an errant error message if there is another error.
00474                          */
00475                         if (IS_HELP(objv[i]) == TCL_OK) {
00476                                 result = TCL_OK;
00477                                 goto out;
00478                         }
00479                         Tcl_ResetResult(interp);
00480                         break;
00481                 }
00482                 i++;
00483 
00484 #define FLAG_CHECK2_STDARG      \
00485         (DB_RMW | DB_MULTIPLE | DB_MULTIPLE_KEY | DB_READ_UNCOMMITTED)
00486 
00487                 switch ((enum dbcgetopts)optindex) {
00488 #ifdef CONFIG_TEST
00489                 case DBCGET_BOTH_RANGE:
00490                         FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
00491                         flag |= DB_GET_BOTH_RANGE;
00492                         break;
00493                 case DBCGET_MULTI:
00494                         flag |= DB_MULTIPLE;
00495                         result = Tcl_GetIntFromObj(interp, objv[i], &bufsize);
00496                         if (result != TCL_OK)
00497                                 goto out;
00498                         i++;
00499                         break;
00500                 case DBCGET_MULTI_KEY:
00501                         flag |= DB_MULTIPLE_KEY;
00502                         result = Tcl_GetIntFromObj(interp, objv[i], &bufsize);
00503                         if (result != TCL_OK)
00504                                 goto out;
00505                         i++;
00506                         break;
00507                 case DBCGET_READ_COMMITTED:
00508                         flag |= DB_READ_COMMITTED;
00509                         break;
00510                 case DBCGET_READ_UNCOMMITTED:
00511                         flag |= DB_READ_UNCOMMITTED;
00512                         break;
00513 #endif
00514                 case DBCGET_RMW:
00515                         flag |= DB_RMW;
00516                         break;
00517                 case DBCGET_CURRENT:
00518                         FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
00519                         flag |= DB_CURRENT;
00520                         break;
00521                 case DBCGET_FIRST:
00522                         FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
00523                         flag |= DB_FIRST;
00524                         break;
00525                 case DBCGET_LAST:
00526                         FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
00527                         flag |= DB_LAST;
00528                         break;
00529                 case DBCGET_NEXT:
00530                         FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
00531                         flag |= DB_NEXT;
00532                         break;
00533                 case DBCGET_PREV:
00534                         FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
00535                         flag |= DB_PREV;
00536                         break;
00537                 case DBCGET_PREVNODUP:
00538                         FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
00539                         flag |= DB_PREV_NODUP;
00540                         break;
00541                 case DBCGET_NEXTNODUP:
00542                         FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
00543                         flag |= DB_NEXT_NODUP;
00544                         break;
00545                 case DBCGET_NEXTDUP:
00546                         FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
00547                         flag |= DB_NEXT_DUP;
00548                         break;
00549                 case DBCGET_BOTH:
00550                         FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
00551                         flag |= DB_GET_BOTH;
00552                         break;
00553                 case DBCGET_RECNO:
00554                         FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
00555                         flag |= DB_GET_RECNO;
00556                         break;
00557                 case DBCGET_JOIN:
00558                         FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
00559                         flag |= DB_JOIN_ITEM;
00560                         break;
00561                 case DBCGET_SET:
00562                         FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
00563                         flag |= DB_SET;
00564                         break;
00565                 case DBCGET_SETRANGE:
00566                         FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
00567                         flag |= DB_SET_RANGE;
00568                         break;
00569                 case DBCGET_SETRECNO:
00570                         FLAG_CHECK2(flag, FLAG_CHECK2_STDARG);
00571                         flag |= DB_SET_RECNO;
00572                         break;
00573                 case DBCGET_PART:
00574                         if (i == objc) {
00575                                 Tcl_WrongNumArgs(interp, 2, objv,
00576                                     "?-partial {offset length}?");
00577                                 result = TCL_ERROR;
00578                                 break;
00579                         }
00580                         /*
00581                          * Get sublist as {offset length}
00582                          */
00583                         result = Tcl_ListObjGetElements(interp, objv[i++],
00584                             &elemc, &elemv);
00585                         if (elemc != 2) {
00586                                 Tcl_SetResult(interp,
00587                                     "List must be {offset length}", TCL_STATIC);
00588                                 result = TCL_ERROR;
00589                                 break;
00590                         }
00591                         data.flags |= DB_DBT_PARTIAL;
00592                         result = _GetUInt32(interp, elemv[0], &data.doff);
00593                         if (result != TCL_OK)
00594                                 break;
00595                         result = _GetUInt32(interp, elemv[1], &data.dlen);
00596                         /*
00597                          * NOTE: We don't check result here because all we'd
00598                          * do is break anyway, and we are doing that.  If you
00599                          * add code here, you WILL need to add the check
00600                          * for result.  (See the check for save.doff, a few
00601                          * lines above and copy that.)
00602                          */
00603                         break;
00604                 }
00605                 if (result != TCL_OK)
00606                         break;
00607         }
00608         if (result != TCL_OK)
00609                 goto out;
00610 
00611         /*
00612          * We need to determine if we are a recno database
00613          * or not.  If we are, then key.data is a recno, not
00614          * a string.
00615          */
00616         dbcip = _PtrToInfo(dbc);
00617         if (dbcip == NULL) {
00618                 type = DB_UNKNOWN;
00619                 ptype = DB_UNKNOWN;
00620         } else {
00621                 dbip = dbcip->i_parent;
00622                 if (dbip == NULL) {
00623                         Tcl_SetResult(interp, "Cursor without parent database",
00624                             TCL_STATIC);
00625                         result = TCL_ERROR;
00626                         goto out;
00627                 }
00628                 thisdbp = dbip->i_dbp;
00629                 (void)thisdbp->get_type(thisdbp, &type);
00630                 if (ispget && thisdbp->s_primary != NULL)
00631                         (void)thisdbp->
00632                             s_primary->get_type(thisdbp->s_primary, &ptype);
00633                 else
00634                         ptype = DB_UNKNOWN;
00635         }
00636         /*
00637          * When we get here, we better have:
00638          * 2 args, key and data if GET_BOTH/GET_BOTH_RANGE was specified.
00639          * 1 arg if -set, -set_range or -set_recno
00640          * 0 in all other cases.
00641          */
00642         op = flag & DB_OPFLAGS_MASK;
00643         switch (op) {
00644         case DB_GET_BOTH:
00645 #ifdef CONFIG_TEST
00646         case DB_GET_BOTH_RANGE:
00647 #endif
00648                 if (i != (objc - 2)) {
00649                         Tcl_WrongNumArgs(interp, 2, objv,
00650                             "?-args? -get_both key data");
00651                         result = TCL_ERROR;
00652                         goto out;
00653                 } else {
00654                         if (type == DB_RECNO || type == DB_QUEUE) {
00655                                 result = _GetUInt32(
00656                                     interp, objv[objc-2], &recno);
00657                                 if (result == TCL_OK) {
00658                                         key.data = &recno;
00659                                         key.size = sizeof(db_recno_t);
00660                                 } else
00661                                         goto out;
00662                         } else {
00663                                 /*
00664                                  * Some get calls (SET_*) can change the
00665                                  * key pointers.  So, we need to store
00666                                  * the allocated key space in a tmp.
00667                                  */
00668                                 ret = _CopyObjBytes(interp, objv[objc-2],
00669                                     &ktmp, &key.size, &freekey);
00670                                 if (ret != 0) {
00671                                         result = _ReturnSetup(interp, ret,
00672                                             DB_RETOK_DBCGET(ret), "dbc get");
00673                                         return (result);
00674                                 }
00675                                 key.data = ktmp;
00676                         }
00677                         if (ptype == DB_RECNO || ptype == DB_QUEUE) {
00678                                 result = _GetUInt32(
00679                                     interp, objv[objc-1], &precno);
00680                                 if (result == TCL_OK) {
00681                                         data.data = &precno;
00682                                         data.size = sizeof(db_recno_t);
00683                                 } else
00684                                         goto out;
00685                         } else {
00686                                 ret = _CopyObjBytes(interp, objv[objc-1],
00687                                     &dtmp, &data.size, &freedata);
00688                                 if (ret != 0) {
00689                                         result = _ReturnSetup(interp, ret,
00690                                             DB_RETOK_DBCGET(ret), "dbc get");
00691                                         goto out;
00692                                 }
00693                                 data.data = dtmp;
00694                         }
00695                 }
00696                 break;
00697         case DB_SET:
00698         case DB_SET_RANGE:
00699         case DB_SET_RECNO:
00700                 if (i != (objc - 1)) {
00701                         Tcl_WrongNumArgs(interp, 2, objv, "?-args? key");
00702                         result = TCL_ERROR;
00703                         goto out;
00704                 }
00705 #ifdef CONFIG_TEST
00706                 if (flag & (DB_MULTIPLE|DB_MULTIPLE_KEY)) {
00707                         (void)__os_malloc(NULL, (size_t)bufsize, &data.data);
00708                         data.ulen = (u_int32_t)bufsize;
00709                         data.flags |= DB_DBT_USERMEM;
00710                 } else
00711 #endif
00712                         data.flags |= DB_DBT_MALLOC;
00713                 if (op == DB_SET_RECNO ||
00714                     type == DB_RECNO || type == DB_QUEUE) {
00715                         result = _GetUInt32(interp, objv[objc - 1], &recno);
00716                         key.data = &recno;
00717                         key.size = sizeof(db_recno_t);
00718                 } else {
00719                         /*
00720                          * Some get calls (SET_*) can change the
00721                          * key pointers.  So, we need to store
00722                          * the allocated key space in a tmp.
00723                          */
00724                         ret = _CopyObjBytes(interp, objv[objc-1],
00725                             &ktmp, &key.size, &freekey);
00726                         if (ret != 0) {
00727                                 result = _ReturnSetup(interp, ret,
00728                                     DB_RETOK_DBCGET(ret), "dbc get");
00729                                 return (result);
00730                         }
00731                         key.data = ktmp;
00732                 }
00733                 break;
00734         default:
00735                 if (i != objc) {
00736                         Tcl_WrongNumArgs(interp, 2, objv, "?-args?");
00737                         result = TCL_ERROR;
00738                         goto out;
00739                 }
00740                 key.flags |= DB_DBT_MALLOC;
00741 #ifdef CONFIG_TEST
00742                 if (flag & (DB_MULTIPLE|DB_MULTIPLE_KEY)) {
00743                         (void)__os_malloc(NULL, (size_t)bufsize, &data.data);
00744                         data.ulen = (u_int32_t)bufsize;
00745                         data.flags |= DB_DBT_USERMEM;
00746                 } else
00747 #endif
00748                         data.flags |= DB_DBT_MALLOC;
00749         }
00750 
00751         _debug_check();
00752         memset(&pdata, 0, sizeof(DBT));
00753         if (ispget) {
00754                 F_SET(&pdata, DB_DBT_MALLOC);
00755                 ret = dbc->c_pget(dbc, &key, &data, &pdata, flag);
00756         } else
00757                 ret = dbc->c_get(dbc, &key, &data, flag);
00758         result = _ReturnSetup(interp, ret, DB_RETOK_DBCGET(ret), "dbc get");
00759         if (result == TCL_ERROR)
00760                 goto out;
00761 
00762         retlist = Tcl_NewListObj(0, NULL);
00763         if (ret != 0)
00764                 goto out1;
00765         if (op == DB_GET_RECNO) {
00766                 recno = *((db_recno_t *)data.data);
00767                 myobj = Tcl_NewWideIntObj((Tcl_WideInt)recno);
00768                 result = Tcl_ListObjAppendElement(interp, retlist, myobj);
00769         } else {
00770                 if (flag & (DB_MULTIPLE|DB_MULTIPLE_KEY))
00771                         result = _SetMultiList(interp,
00772                             retlist, &key, &data, type, flag);
00773                 else if ((type == DB_RECNO || type == DB_QUEUE) &&
00774                     key.data != NULL) {
00775                         if (ispget)
00776                                 result = _Set3DBTList(interp, retlist, &key, 1,
00777                                     &data,
00778                                     (ptype == DB_RECNO || ptype == DB_QUEUE),
00779                                     &pdata);
00780                         else
00781                                 result = _SetListRecnoElem(interp, retlist,
00782                                     *(db_recno_t *)key.data,
00783                                     data.data, data.size);
00784                 } else {
00785                         if (ispget)
00786                                 result = _Set3DBTList(interp, retlist, &key, 0,
00787                                     &data,
00788                                     (ptype == DB_RECNO || ptype == DB_QUEUE),
00789                                     &pdata);
00790                         else
00791                                 result = _SetListElem(interp, retlist,
00792                                     key.data, key.size, data.data, data.size);
00793                 }
00794         }
00795         if (key.data != NULL && F_ISSET(&key, DB_DBT_MALLOC))
00796                 __os_ufree(dbc->dbp->dbenv, key.data);
00797         if (data.data != NULL && F_ISSET(&data, DB_DBT_MALLOC))
00798                 __os_ufree(dbc->dbp->dbenv, data.data);
00799         if (pdata.data != NULL && F_ISSET(&pdata, DB_DBT_MALLOC))
00800                 __os_ufree(dbc->dbp->dbenv, pdata.data);
00801 out1:
00802         if (result == TCL_OK)
00803                 Tcl_SetObjResult(interp, retlist);
00804 out:
00805         if (data.data != NULL && flag & (DB_MULTIPLE|DB_MULTIPLE_KEY))
00806                 __os_free(dbc->dbp->dbenv, data.data);
00807         if (freedata)
00808                 __os_free(NULL, dtmp);
00809         if (freekey)
00810                 __os_free(NULL, ktmp);
00811         return (result);
00812 
00813 }
00814 
00815 /*
00816  * tcl_DbcDup --
00817  */
00818 static int
00819 tcl_DbcDup(interp, objc, objv, dbc)
00820         Tcl_Interp *interp;             /* Interpreter */
00821         int objc;                       /* How many arguments? */
00822         Tcl_Obj *CONST objv[];          /* The argument objects */
00823         DBC *dbc;                       /* Cursor pointer */
00824 {
00825         static const char *dbcdupopts[] = {
00826                 "-position",
00827                 NULL
00828         };
00829         enum dbcdupopts {
00830                 DBCDUP_POS
00831         };
00832         DBC *newdbc;
00833         DBTCL_INFO *dbcip, *newdbcip, *dbip;
00834         Tcl_Obj *res;
00835         u_int32_t flag;
00836         int i, optindex, result, ret;
00837         char newname[MSG_SIZE];
00838 
00839         result = TCL_OK;
00840         flag = 0;
00841         res = NULL;
00842 
00843         if (objc < 2) {
00844                 Tcl_WrongNumArgs(interp, 2, objv, "?-args?");
00845                 return (TCL_ERROR);
00846         }
00847 
00848         /*
00849          * Get the command name index from the object based on the options
00850          * defined above.
00851          */
00852         i = 2;
00853         while (i < objc) {
00854                 if (Tcl_GetIndexFromObj(interp, objv[i], dbcdupopts,
00855                     "option", TCL_EXACT, &optindex) != TCL_OK) {
00856                         /*
00857                          * Reset the result so we don't get
00858                          * an errant error message if there is another error.
00859                          */
00860                         if (IS_HELP(objv[i]) == TCL_OK) {
00861                                 result = TCL_OK;
00862                                 goto out;
00863                         }
00864                         Tcl_ResetResult(interp);
00865                         break;
00866                 }
00867                 i++;
00868                 switch ((enum dbcdupopts)optindex) {
00869                 case DBCDUP_POS:
00870                         flag = DB_POSITION;
00871                         break;
00872                 }
00873                 if (result != TCL_OK)
00874                         break;
00875         }
00876         if (result != TCL_OK)
00877                 goto out;
00878 
00879         /*
00880          * We need to determine if we are a recno database
00881          * or not.  If we are, then key.data is a recno, not
00882          * a string.
00883          */
00884         dbcip = _PtrToInfo(dbc);
00885         if (dbcip == NULL) {
00886                 Tcl_SetResult(interp, "Cursor without info structure",
00887                     TCL_STATIC);
00888                 result = TCL_ERROR;
00889                 goto out;
00890         } else {
00891                 dbip = dbcip->i_parent;
00892                 if (dbip == NULL) {
00893                         Tcl_SetResult(interp, "Cursor without parent database",
00894                             TCL_STATIC);
00895                         result = TCL_ERROR;
00896                         goto out;
00897                 }
00898         }
00899         /*
00900          * Now duplicate the cursor.  If successful, we need to create
00901          * a new cursor command.
00902          */
00903         snprintf(newname, sizeof(newname),
00904             "%s.c%d", dbip->i_name, dbip->i_dbdbcid);
00905         newdbcip = _NewInfo(interp, NULL, newname, I_DBC);
00906         if (newdbcip != NULL) {
00907                 ret = dbc->c_dup(dbc, &newdbc, flag);
00908                 if (ret == 0) {
00909                         dbip->i_dbdbcid++;
00910                         newdbcip->i_parent = dbip;
00911                         (void)Tcl_CreateObjCommand(interp, newname,
00912                             (Tcl_ObjCmdProc *)dbc_Cmd,
00913                             (ClientData)newdbc, NULL);
00914                         res = NewStringObj(newname, strlen(newname));
00915                         _SetInfoData(newdbcip, newdbc);
00916                         Tcl_SetObjResult(interp, res);
00917                 } else {
00918                         result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
00919                             "db dup");
00920                         _DeleteInfo(newdbcip);
00921                 }
00922         } else {
00923                 Tcl_SetResult(interp, "Could not set up info", TCL_STATIC);
00924                 result = TCL_ERROR;
00925         }
00926 out:
00927         return (result);
00928 
00929 }