Logo Search packages:      
Sourcecode: db3 version File versions  Download package

tcl_dbcursor.c

/*-
 * See the file LICENSE for redistribution information.
 *
 * Copyright (c) 1999, 2000
 *    Sleepycat Software.  All rights reserved.
 */

#include "db_config.h"

#ifndef lint
static const char revid[] = "$Id: tcl_dbcursor.c,v 11.26 2001/01/11 18:19:55 bostic Exp $";
#endif /* not lint */

#ifndef NO_SYSTEM_INCLUDES
#include <sys/types.h>

#include <stdlib.h>
#include <string.h>
#include <tcl.h>
#endif

#include "db_int.h"
#include "tcl_db.h"

/*
 * Prototypes for procedures defined later in this file:
 */
static int  tcl_DbcDup __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *));
static int  tcl_DbcGet __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *));
static int  tcl_DbcPut __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DBC *));

/*
 * PUBLIC: int dbc_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*));
 *
 * dbc_cmd --
 *    Implements the cursor command.
 */
int
dbc_Cmd(clientData, interp, objc, objv)
      ClientData clientData;          /* Cursor handle */
      Tcl_Interp *interp;             /* Interpreter */
      int objc;                       /* How many arguments? */
      Tcl_Obj *CONST objv[];          /* The argument objects */
{
      static char *dbccmds[] = {
            "close",
            "del",
            "dup",
            "get",
            "put",
            NULL
      };
      enum dbccmds {
            DBCCLOSE,
            DBCDELETE,
            DBCDUP,
            DBCGET,
            DBCPUT
      };
      DBC *dbc;
      DBTCL_INFO *dbip;
      int cmdindex, result, ret;

      Tcl_ResetResult(interp);
      dbc = (DBC *)clientData;
      dbip = _PtrToInfo((void *)dbc);
      result = TCL_OK;

      if (objc <= 1) {
            Tcl_WrongNumArgs(interp, 1, objv, "command cmdargs");
            return (TCL_ERROR);
      }
      if (dbc == NULL) {
            Tcl_SetResult(interp, "NULL dbc pointer", TCL_STATIC);
            return (TCL_ERROR);
      }
      if (dbip == NULL) {
            Tcl_SetResult(interp, "NULL dbc info pointer", TCL_STATIC);
            return (TCL_ERROR);
      }

      /*
       * Get the command name index from the object based on the berkdbcmds
       * defined above.
       */
      if (Tcl_GetIndexFromObj(interp, objv[1], dbccmds, "command",
          TCL_EXACT, &cmdindex) != TCL_OK)
            return (IS_HELP(objv[1]));
      switch ((enum dbccmds)cmdindex) {
      case DBCCLOSE:
            /*
             * No args for this.  Error if there are some.
             */
            if (objc > 2) {
                  Tcl_WrongNumArgs(interp, 2, objv, NULL);
                  return (TCL_ERROR);
            }
            _debug_check();
            ret = dbc->c_close(dbc);
            result = _ReturnSetup(interp, ret, "dbc close");
            if (result == TCL_OK) {
                  (void)Tcl_DeleteCommand(interp, dbip->i_name);
                  _DeleteInfo(dbip);
            }
            break;
      case DBCDELETE:
            /*
             * No args for this.  Error if there are some.
             */
            if (objc > 2) {
                  Tcl_WrongNumArgs(interp, 2, objv, NULL);
                  return (TCL_ERROR);
            }
            _debug_check();
            ret = dbc->c_del(dbc, 0);
            result = _ReturnSetup(interp, ret, "dbc delete");
            break;
      case DBCDUP:
            result = tcl_DbcDup(interp, objc, objv, dbc);
            break;
      case DBCGET:
            result = tcl_DbcGet(interp, objc, objv, dbc);
            break;
      case DBCPUT:
            result = tcl_DbcPut(interp, objc, objv, dbc);
            break;
      }
      return (result);
}

/*
 * tcl_DbcPut --
 */
static int
tcl_DbcPut(interp, objc, objv, dbc)
      Tcl_Interp *interp;           /* Interpreter */
      int objc;               /* How many arguments? */
      Tcl_Obj *CONST objv[];        /* The argument objects */
      DBC *dbc;               /* Cursor pointer */
{
      static char *dbcutopts[] = {
            "-after",   "-before",  "-current",
            "-keyfirst",      "-keylast", "-nodupdata",
            "-partial",
            NULL
      };
      enum dbcutopts {
            DBCPUT_AFTER,     DBCPUT_BEFORE,    DBCPUT_CURRENT,
            DBCPUT_KEYFIRST,DBCPUT_KEYLAST,     DBCPUT_NODUPDATA,
            DBCPUT_PART
      };
      DB *thisdbp;
      DBT key, data;
      DBTCL_INFO *dbcip, *dbip;
      DBTYPE type;
      Tcl_Obj **elemv, *res;
      db_recno_t recno;
      u_int32_t flag;
      int elemc, i, itmp, optindex, result, ret;

      result = TCL_OK;
      flag = 0;

      if (objc < 2) {
            Tcl_WrongNumArgs(interp, 2, objv, "?-args? ?key?");
            return (TCL_ERROR);
      }

      memset(&key, 0, sizeof(key));
      memset(&data, 0, sizeof(data));

      /*
       * Get the command name index from the object based on the options
       * defined above.
       */
      i = 2;
      while (i < (objc - 1)) {
            if (Tcl_GetIndexFromObj(interp, objv[i], dbcutopts, "option",
                TCL_EXACT, &optindex) != TCL_OK) {
                  /*
                   * Reset the result so we don't get
                   * an errant error message if there is another error.
                   */
                  if (IS_HELP(objv[i]) == TCL_OK) {
                        result = TCL_OK;
                        goto out;
                  }
                  Tcl_ResetResult(interp);
                  break;
            }
            i++;
            switch ((enum dbcutopts)optindex) {
            case DBCPUT_AFTER:
                  FLAG_CHECK(flag);
                  flag = DB_AFTER;
                  break;
            case DBCPUT_BEFORE:
                  FLAG_CHECK(flag);
                  flag = DB_BEFORE;
                  break;
            case DBCPUT_CURRENT:
                  FLAG_CHECK(flag);
                  flag = DB_CURRENT;
                  break;
            case DBCPUT_KEYFIRST:
                  FLAG_CHECK(flag);
                  flag = DB_KEYFIRST;
                  break;
            case DBCPUT_KEYLAST:
                  FLAG_CHECK(flag);
                  flag = DB_KEYLAST;
                  break;
            case DBCPUT_NODUPDATA:
                  FLAG_CHECK(flag);
                  flag = DB_NODUPDATA;
                  break;
            case DBCPUT_PART:
                  if (i > (objc - 2)) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "?-partial {offset length}?");
                        result = TCL_ERROR;
                        break;
                  }
                  /*
                   * Get sublist as {offset length}
                   */
                  result = Tcl_ListObjGetElements(interp, objv[i++],
                      &elemc, &elemv);
                  if (elemc != 2) {
                        Tcl_SetResult(interp,
                            "List must be {offset length}", TCL_STATIC);
                        result = TCL_ERROR;
                        break;
                  }
                  data.flags |= DB_DBT_PARTIAL;
                  result = Tcl_GetIntFromObj(interp, elemv[0], &itmp);
                  data.doff = itmp;
                  if (result != TCL_OK)
                        break;
                  result = Tcl_GetIntFromObj(interp, elemv[1], &itmp);
                  data.dlen = itmp;
                  /*
                   * NOTE: We don't check result here because all we'd
                   * do is break anyway, and we are doing that.  If you
                   * add code here, you WILL need to add the check
                   * for result.  (See the check for save.doff, a few
                   * lines above and copy that.)
                   */
            }
            if (result != TCL_OK)
                  break;
      }
      if (result != TCL_OK)
            goto out;

      /*
       * We need to determine if we are a recno database or not.  If we are,
       * then key.data is a recno, not a string.
       */
      dbcip = _PtrToInfo(dbc);
      if (dbcip == NULL)
            type = DB_UNKNOWN;
      else {
            dbip = dbcip->i_parent;
            if (dbip == NULL) {
                  Tcl_SetResult(interp, "Cursor without parent database",
                      TCL_STATIC);
                  result = TCL_ERROR;
                  return (result);
            }
            thisdbp = dbip->i_dbp;
            type = thisdbp->get_type(thisdbp);
      }
      /*
       * When we get here, we better have:
       * 1 arg if -after, -before or -current
       * 2 args in all other cases
       */
      if (flag == DB_AFTER || flag == DB_BEFORE || flag == DB_CURRENT) {
            if (i != (objc - 1)) {
                  Tcl_WrongNumArgs(interp, 2, objv,
                      "?-args? data");
                  result = TCL_ERROR;
                  goto out;
            }
            /*
             * We want to get the key back, so we need to set
             * up the location to get it back in.
             */
            if (type == DB_RECNO || type == DB_QUEUE) {
                  recno = 0;
                  key.data = &recno;
                  key.size = sizeof(db_recno_t);
            }
      } else {
            if (i != (objc - 2)) {
                  Tcl_WrongNumArgs(interp, 2, objv,
                      "?-args? key data");
                  result = TCL_ERROR;
                  goto out;
            }
            if (type == DB_RECNO || type == DB_QUEUE) {
                  result = Tcl_GetIntFromObj(interp, objv[objc-2], &itmp);
                  recno = itmp;
                  if (result == TCL_OK) {
                        key.data = &recno;
                        key.size = sizeof(db_recno_t);
                  } else
                        return (result);
            } else {
                  key.data = Tcl_GetByteArrayFromObj(objv[objc-2], &itmp);
                  key.size = itmp;
            }
      }
      data.data = Tcl_GetByteArrayFromObj(objv[objc-1], &itmp);
      data.size = itmp;
      _debug_check();
      ret = dbc->c_put(dbc, &key, &data, flag);
      result = _ReturnSetup(interp, ret, "dbc put");
      if (ret == 0 && (flag == DB_AFTER || flag == DB_BEFORE)
          && type == DB_RECNO) {
            res = Tcl_NewIntObj(*(db_recno_t *)key.data);
            Tcl_SetObjResult(interp, res);
      }
out:
      return (result);
}

/*
 * tcl_dbc_get --
 */
static int
tcl_DbcGet(interp, objc, objv, dbc)
      Tcl_Interp *interp;           /* Interpreter */
      int objc;               /* How many arguments? */
      Tcl_Obj *CONST objv[];        /* The argument objects */
      DBC *dbc;               /* Cursor pointer */
{
      static char *dbcgetopts[] = {
            "-current",
            "-first",
            "-get_both",
            "-get_recno",
            "-join_item",
            "-last",
            "-next",
            "-nextdup",
            "-nextnodup",
            "-partial",
            "-prev",
            "-prevnodup",
            "-rmw",
            "-set",
            "-set_range",
            "-set_recno",
            NULL
      };
      enum dbcgetopts {
            DBCGET_CURRENT,
            DBCGET_FIRST,
            DBCGET_BOTH,
            DBCGET_RECNO,
            DBCGET_JOIN,
            DBCGET_LAST,
            DBCGET_NEXT,
            DBCGET_NEXTDUP,
            DBCGET_NEXTNODUP,
            DBCGET_PART,
            DBCGET_PREV,
            DBCGET_PREVNODUP,
            DBCGET_RMW,
            DBCGET_SET,
            DBCGET_SETRANGE,
            DBCGET_SETRECNO
      };
      DB *thisdbp;
      DBT key, data;
      DBTCL_INFO *dbcip, *dbip;
      DBTYPE type;
      Tcl_Obj **elemv, *myobj, *retlist;
      db_recno_t recno;
      u_int32_t flag;
      int elemc, i, itmp, optindex, result, ret;

      result = TCL_OK;
      flag = 0;

      if (objc < 2) {
            Tcl_WrongNumArgs(interp, 2, objv, "?-args? ?key?");
            return (TCL_ERROR);
      }

      memset(&key, 0, sizeof(key));
      memset(&data, 0, sizeof(data));
      /*
       * Get the command name index from the object based on the options
       * defined above.
       */
      i = 2;
      while (i < objc) {
            if (Tcl_GetIndexFromObj(interp, objv[i], dbcgetopts,
                "option", TCL_EXACT, &optindex) != TCL_OK) {
                  /*
                   * Reset the result so we don't get
                   * an errant error message if there is another error.
                   */
                  if (IS_HELP(objv[i]) == TCL_OK) {
                        result = TCL_OK;
                        goto out;
                  }
                  Tcl_ResetResult(interp);
                  break;
            }
            i++;
            switch ((enum dbcgetopts)optindex) {
            case DBCGET_RMW:
                  flag |= DB_RMW;
                  break;
            case DBCGET_CURRENT:
                  FLAG_CHECK2(flag, DB_RMW);
                  flag |= DB_CURRENT;
                  break;
            case DBCGET_FIRST:
                  FLAG_CHECK2(flag, DB_RMW);
                  flag |= DB_FIRST;
                  break;
            case DBCGET_LAST:
                  FLAG_CHECK2(flag, DB_RMW);
                  flag |= DB_LAST;
                  break;
            case DBCGET_NEXT:
                  FLAG_CHECK2(flag, DB_RMW);
                  flag |= DB_NEXT;
                  break;
            case DBCGET_PREV:
                  FLAG_CHECK2(flag, DB_RMW);
                  flag |= DB_PREV;
                  break;
            case DBCGET_PREVNODUP:
                  FLAG_CHECK2(flag, DB_RMW);
                  flag |= DB_PREV_NODUP;
                  break;
            case DBCGET_NEXTNODUP:
                  FLAG_CHECK2(flag, DB_RMW);
                  flag |= DB_NEXT_NODUP;
                  break;
            case DBCGET_NEXTDUP:
                  FLAG_CHECK2(flag, DB_RMW);
                  flag |= DB_NEXT_DUP;
                  break;
            case DBCGET_BOTH:
                  FLAG_CHECK2(flag, DB_RMW);
                  flag |= DB_GET_BOTH;
                  break;
            case DBCGET_RECNO:
                  FLAG_CHECK2(flag, DB_RMW);
                  flag |= DB_GET_RECNO;
                  break;
            case DBCGET_JOIN:
                  FLAG_CHECK2(flag, DB_RMW);
                  flag |= DB_JOIN_ITEM;
                  break;
            case DBCGET_SET:
                  FLAG_CHECK2(flag, DB_RMW);
                  flag |= DB_SET;
                  break;
            case DBCGET_SETRANGE:
                  FLAG_CHECK2(flag, DB_RMW);
                  flag |= DB_SET_RANGE;
                  break;
            case DBCGET_SETRECNO:
                  FLAG_CHECK2(flag, DB_RMW);
                  flag |= DB_SET_RECNO;
                  break;
            case DBCGET_PART:
                  if (i == objc) {
                        Tcl_WrongNumArgs(interp, 2, objv,
                            "?-partial {offset length}?");
                        result = TCL_ERROR;
                        break;
                  }
                  /*
                   * Get sublist as {offset length}
                   */
                  result = Tcl_ListObjGetElements(interp, objv[i++],
                      &elemc, &elemv);
                  if (elemc != 2) {
                        Tcl_SetResult(interp,
                            "List must be {offset length}", TCL_STATIC);
                        result = TCL_ERROR;
                        break;
                  }
                  data.flags |= DB_DBT_PARTIAL;
                  result = Tcl_GetIntFromObj(interp, elemv[0], &itmp);
                  data.doff = itmp;
                  if (result != TCL_OK)
                        break;
                  result = Tcl_GetIntFromObj(interp, elemv[1], &itmp);
                  data.dlen = itmp;
                  /*
                   * NOTE: We don't check result here because all we'd
                   * do is break anyway, and we are doing that.  If you
                   * add code here, you WILL need to add the check
                   * for result.  (See the check for save.doff, a few
                   * lines above and copy that.)
                   */
                  break;
            }
            if (result != TCL_OK)
                  break;
      }
      if (result != TCL_OK)
            goto out;

      /*
       * We need to determine if we are a recno database
       * or not.  If we are, then key.data is a recno, not
       * a string.
       */
      dbcip = _PtrToInfo(dbc);
      if (dbcip == NULL)
            type = DB_UNKNOWN;
      else {
            dbip = dbcip->i_parent;
            if (dbip == NULL) {
                  Tcl_SetResult(interp, "Cursor without parent database",
                      TCL_STATIC);
                  result = TCL_ERROR;
                  goto out;
            }
            thisdbp = dbip->i_dbp;
            type = thisdbp->get_type(thisdbp);
      }
      /*
       * When we get here, we better have:
       * 2 args, key and data if GET_BOTH was specified.
       * 1 arg if -set, -set_range or -set_recno
       * 0 in all other cases.
       */
      if ((flag & DB_OPFLAGS_MASK) == DB_GET_BOTH) {
            if (i != (objc - 2)) {
                  Tcl_WrongNumArgs(interp, 2, objv,
                      "?-args? -get_both key data");
                  result = TCL_ERROR;
                  goto out;
            } else {
                  if (type == DB_RECNO || type == DB_QUEUE) {
                        result = Tcl_GetIntFromObj(
                            interp, objv[objc-2], &itmp);
                        recno = itmp;
                        if (result == TCL_OK) {
                              key.data = &recno;
                              key.size = sizeof(db_recno_t);
                        } else
                              goto out;
                  } else {
                        key.data = Tcl_GetByteArrayFromObj(
                            objv[objc - 2], &itmp);
                        key.size = itmp;
                  }
                  data.data =
                      Tcl_GetByteArrayFromObj(objv[objc - 1], &itmp);
                  data.size = itmp;
            }
      } else if ((flag & DB_OPFLAGS_MASK) == DB_SET ||
               (flag & DB_OPFLAGS_MASK) == DB_SET_RANGE ||
               (flag & DB_OPFLAGS_MASK) == DB_SET_RECNO) {
            if (i != (objc - 1)) {
                  Tcl_WrongNumArgs(interp, 2, objv, "?-args? key");
                  result = TCL_ERROR;
                  goto out;
            }
            data.flags |= DB_DBT_MALLOC;
            if ((flag & DB_OPFLAGS_MASK) == DB_SET_RECNO ||
                type == DB_RECNO || type == DB_QUEUE) {
                  result = Tcl_GetIntFromObj(interp,
                      objv[objc - 1], (int *)&recno);
                  key.data = &recno;
                  key.size = sizeof(db_recno_t);
            } else {
                  key.data =
                      Tcl_GetByteArrayFromObj(objv[objc - 1], &itmp);
                  key.size = itmp;
            }
      } else {
            if (i != objc) {
                  Tcl_WrongNumArgs(interp, 2, objv, "?-args?");
                  result = TCL_ERROR;
                  goto out;
            }
            key.flags |= DB_DBT_MALLOC;
            data.flags |= DB_DBT_MALLOC;
      }

      _debug_check();
      ret = dbc->c_get(dbc, &key, &data, flag);
      result = _ReturnSetup(interp, ret, "dbc get");
      if (result == TCL_ERROR)
            goto out;

      retlist = Tcl_NewListObj(0, NULL);
      if (ret == DB_NOTFOUND)
            goto out1;
      if ((flag & DB_OPFLAGS_MASK) == DB_GET_RECNO) {
            recno = *((db_recno_t *)data.data);
            myobj = Tcl_NewIntObj((int)recno);
            result = Tcl_ListObjAppendElement(interp, retlist, myobj);
      } else {
            if ((type == DB_RECNO || type == DB_QUEUE) && key.data != NULL)
                  result = _SetListRecnoElem(interp, retlist,
                      *(db_recno_t *)key.data, data.data, data.size);
            else
                  result = _SetListElem(interp, retlist,
                      key.data, key.size, data.data, data.size);
      }
      if (key.flags & DB_DBT_MALLOC)
            __os_free(key.data, key.size);
      if (data.flags & DB_DBT_MALLOC)
            __os_free(data.data, data.size);
out1:
      if (result == TCL_OK)
            Tcl_SetObjResult(interp, retlist);
out:
      return (result);

}

/*
 * tcl_DbcDup --
 */
static int
tcl_DbcDup(interp, objc, objv, dbc)
      Tcl_Interp *interp;           /* Interpreter */
      int objc;               /* How many arguments? */
      Tcl_Obj *CONST objv[];        /* The argument objects */
      DBC *dbc;               /* Cursor pointer */
{
      static char *dbcdupopts[] = {
            "-position",
            NULL
      };
      enum dbcdupopts {
            DBCDUP_POS
      };
      DB *thisdbp;
      DBC *newdbc;
      DBTCL_INFO *dbcip, *newdbcip, *dbip;
      Tcl_Obj *res;
      u_int32_t flag;
      int i, optindex, result, ret;
      char newname[MSG_SIZE];

      result = TCL_OK;
      flag = 0;
      res = NULL;

      if (objc < 2) {
            Tcl_WrongNumArgs(interp, 2, objv, "?-args?");
            return (TCL_ERROR);
      }

      /*
       * Get the command name index from the object based on the options
       * defined above.
       */
      i = 2;
      while (i < objc) {
            if (Tcl_GetIndexFromObj(interp, objv[i], dbcdupopts,
                "option", TCL_EXACT, &optindex) != TCL_OK) {
                  /*
                   * Reset the result so we don't get
                   * an errant error message if there is another error.
                   */
                  if (IS_HELP(objv[i]) == TCL_OK) {
                        result = TCL_OK;
                        goto out;
                  }
                  Tcl_ResetResult(interp);
                  break;
            }
            i++;
            switch ((enum dbcdupopts)optindex) {
            case DBCDUP_POS:
                  flag = DB_POSITION;
                  break;
            }
            if (result != TCL_OK)
                  break;
      }
      if (result != TCL_OK)
            goto out;

      /*
       * We need to determine if we are a recno database
       * or not.  If we are, then key.data is a recno, not
       * a string.
       */
      dbcip = _PtrToInfo(dbc);
      if (dbcip == NULL) {
            Tcl_SetResult(interp, "Cursor without info structure",
                TCL_STATIC);
            result = TCL_ERROR;
            goto out;
      } else {
            dbip = dbcip->i_parent;
            if (dbip == NULL) {
                  Tcl_SetResult(interp, "Cursor without parent database",
                      TCL_STATIC);
                  result = TCL_ERROR;
                  goto out;
            }
            thisdbp = dbip->i_dbp;
      }
      /*
       * Now duplicate the cursor.  If successful, we need to create
       * a new cursor command.
       */

      snprintf(newname, sizeof(newname),
          "%s.c%d", dbip->i_name, dbip->i_dbdbcid);
      newdbcip = _NewInfo(interp, NULL, newname, I_DBC);
      if (newdbcip != NULL) {
            ret = dbc->c_dup(dbc, &newdbc, flag);
            if (ret == 0) {
                  dbip->i_dbdbcid++;
                  newdbcip->i_parent = dbip;
                  Tcl_CreateObjCommand(interp, newname,
                      (Tcl_ObjCmdProc *)dbc_Cmd,
                      (ClientData)newdbc, NULL);
                  res = Tcl_NewStringObj(newname, strlen(newname));
                  _SetInfoData(newdbcip, newdbc);
                  Tcl_SetObjResult(interp, res);
            } else {
                  result = _ReturnSetup(interp, ret, "db dup");
                  _DeleteInfo(newdbcip);
            }
      } else {
            Tcl_SetResult(interp, "Could not set up info", TCL_STATIC);
            result = TCL_ERROR;
      }
out:
      return (result);

}

Generated by  Doxygen 1.6.0   Back to index