tcl_seq.c

/*-
 * See the file LICENSE for redistribution information.
 *
 * Copyright (c) 2004-2005
 *      Sleepycat Software.  All rights reserved.
 *
 * $Id: tcl_seq.c,v 12.2 2005/06/16 20:23:49 bostic Exp $
 */

#include "db_config.h"

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

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

#include "db_int.h"
#include "dbinc/tcl_db.h"
#include "dbinc_auto/sequence_ext.h"

/*
 * Prototypes for procedures defined later in this file:
 */
static int      tcl_SeqClose __P((Tcl_Interp *,
    int, Tcl_Obj * CONST*, DB_SEQUENCE *, DBTCL_INFO *));
static int      tcl_SeqGet __P((Tcl_Interp *,
    int, Tcl_Obj * CONST*, DB_SEQUENCE *));
static int      tcl_SeqRemove __P((Tcl_Interp *,
    int, Tcl_Obj * CONST*, DB_SEQUENCE *, DBTCL_INFO *));
static int      tcl_SeqStat __P((Tcl_Interp *,
    int, Tcl_Obj * CONST*, DB_SEQUENCE *));
static int      tcl_SeqGetFlags __P((Tcl_Interp *,
    int, Tcl_Obj * CONST*, DB_SEQUENCE *));

/*
 *
 * PUBLIC: int seq_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*));
 *
 * seq_Cmd --
 *      Implements the "seq" widget.
 */
int
seq_Cmd(clientData, interp, objc, objv)
        ClientData clientData;          /* SEQ handle */
        Tcl_Interp *interp;             /* Interpreter */
        int objc;                       /* How many arguments? */
        Tcl_Obj *CONST objv[];          /* The argument objects */
{
        static const char *seqcmds[] = {
                "close",
                "get",
                "get_cachesize",
                "get_db",
                "get_flags",
                "get_key",
                "get_range",
                "remove",
                "stat",
                NULL
        };
        enum seqcmds {
                SEQCLOSE,
                SEQGET,
                SEQGETCACHESIZE,
                SEQGETDB,
                SEQGETFLAGS,
                SEQGETKEY,
                SEQGETRANGE,
                SEQREMOVE,
                SEQSTAT
        };
        DB *dbp;
        DBT key;
        DBTCL_INFO *dbip, *ip;
        DB_SEQUENCE *seq;
        Tcl_Obj *myobjv[2], *res;
        db_seq_t min, max;
        int cmdindex, ncache, result, ret;

        Tcl_ResetResult(interp);
        seq = (DB_SEQUENCE *)clientData;
        result = TCL_OK;
        dbip = NULL;
        if (objc <= 1) {
                Tcl_WrongNumArgs(interp, 1, objv, "command cmdargs");
                return (TCL_ERROR);
        }
        if (seq == NULL) {
                Tcl_SetResult(interp, "NULL sequence pointer", TCL_STATIC);
                return (TCL_ERROR);
        }

        ip = _PtrToInfo((void *)seq);
        if (ip == NULL) {
                Tcl_SetResult(interp, "NULL info pointer", TCL_STATIC);
                return (TCL_ERROR);
        }

        /*
         * Get the command name index from the object based on the dbcmds
         * defined above.
         */
        if (Tcl_GetIndexFromObj(interp,
            objv[1], seqcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
                return (IS_HELP(objv[1]));

        res = NULL;
        switch ((enum seqcmds)cmdindex) {
        case SEQGETRANGE:
                ret = seq->get_range(seq, &min, &max);
                if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
                    "sequence get_range")) == TCL_OK) {
                        myobjv[0] = Tcl_NewWideIntObj(min);
                        myobjv[1] = Tcl_NewWideIntObj(max);
                        res = Tcl_NewListObj(2, myobjv);
                }
                break;
        case SEQCLOSE:
                result = tcl_SeqClose(interp, objc, objv, seq, ip);
                break;
        case SEQREMOVE:
                result = tcl_SeqRemove(interp, objc, objv, seq, ip);
                break;
        case SEQGET:
                result = tcl_SeqGet(interp, objc, objv, seq);
                break;
        case SEQSTAT:
                result = tcl_SeqStat(interp, objc, objv, seq);
                break;
        case SEQGETCACHESIZE:
                if (objc != 2) {
                        Tcl_WrongNumArgs(interp, 1, objv, NULL);
                        return (TCL_ERROR);
                }
                ret = seq->get_cachesize(seq, &ncache);
                if ((result = _ReturnSetup(interp, ret,
                    DB_RETOK_STD(ret), "sequence get_cachesize")) == TCL_OK)
                        res = Tcl_NewIntObj(ncache);
                break;
        case SEQGETDB:
                if (objc != 2) {
                        Tcl_WrongNumArgs(interp, 1, objv, NULL);
                        return (TCL_ERROR);
                }
                ret = seq->get_db(seq, &dbp);
                if (ret == 0 && (dbip = _PtrToInfo((void *)dbp)) == NULL) {
                        Tcl_SetResult(interp,
                             "NULL db info pointer", TCL_STATIC);
                        return (TCL_ERROR);
                }

                if ((result = _ReturnSetup(interp, ret,
                    DB_RETOK_STD(ret), "sequence get_db")) == TCL_OK)
                        res = NewStringObj(dbip->i_name, strlen(dbip->i_name));
                break;
        case SEQGETKEY:
                if (objc != 2) {
                        Tcl_WrongNumArgs(interp, 1, objv, NULL);
                        return (TCL_ERROR);
                }
                ret = seq->get_key(seq, &key);
                if ((result = _ReturnSetup(interp, ret,
                    DB_RETOK_STD(ret), "sequence get_key")) == TCL_OK)
                        res = Tcl_NewByteArrayObj(
                            (u_char *)key.data, (int)key.size);
                break;
        case SEQGETFLAGS:
                result = tcl_SeqGetFlags(interp, objc, objv, seq);
                break;
        }

        /*
         * Only set result if we have a res.  Otherwise, lower functions have
         * already done so.
         */
        if (result == TCL_OK && res)
                Tcl_SetObjResult(interp, res);
        return (result);
}

/*
 * tcl_db_stat --
 */
static int
tcl_SeqStat(interp, objc, objv, seq)
        Tcl_Interp *interp;             /* Interpreter */
        int objc;                       /* How many arguments? */
        Tcl_Obj *CONST objv[];          /* The argument objects */
        DB_SEQUENCE *seq;               /* Database pointer */
{
        DB_SEQUENCE_STAT *sp;
        u_int32_t flag;
        Tcl_Obj *res, *flaglist, *myobjv[2];
        int result, ret;
        char *arg;

        result = TCL_OK;
        flag = 0;

        if (objc > 3) {
                Tcl_WrongNumArgs(interp, 2, objv, "?-clear?");
                return (TCL_ERROR);
        }

        if (objc == 3) {
                arg = Tcl_GetStringFromObj(objv[2], NULL);
                if (strcmp(arg, "-clear") == 0)
                        flag = DB_STAT_CLEAR;
                else {
                        Tcl_SetResult(interp,
                            "db stat: unknown arg", TCL_STATIC);
                        return (TCL_ERROR);
                }
        }

        _debug_check();
        ret = seq->stat(seq, &sp, flag);
        result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db stat");
        if (result == TCL_ERROR)
                return (result);

        res = Tcl_NewObj();
        MAKE_STAT_LIST("Wait", sp->st_wait);
        MAKE_STAT_LIST("No wait", sp->st_nowait);
        MAKE_WSTAT_LIST("Current", sp->st_current);
        MAKE_WSTAT_LIST("Cached", sp->st_value);
        MAKE_WSTAT_LIST("Max Cached", sp->st_last_value);
        MAKE_WSTAT_LIST("Min", sp->st_min);
        MAKE_WSTAT_LIST("Max", sp->st_max);
        MAKE_STAT_LIST("Cache size", sp->st_cache_size);
        /*
         * Construct a {name {flag1 flag2 ... flagN}} list for the
         * seq flags.
         */
        myobjv[0] = NewStringObj("Flags", strlen("Flags"));
        myobjv[1] =
            _GetFlagsList(interp, sp->st_flags, __db_get_seq_flags_fn());
        flaglist = Tcl_NewListObj(2, myobjv);
        if (flaglist == NULL) {
                result = TCL_ERROR;
                goto error;
        }
        if ((result =
            Tcl_ListObjAppendElement(interp, res, flaglist)) != TCL_OK)
                goto error;

        Tcl_SetObjResult(interp, res);

error:  __os_ufree(seq->seq_dbp->dbenv, sp);
        return (result);
}

/*
 * tcl_db_close --
 */
static int
tcl_SeqClose(interp, objc, objv, seq, ip)
        Tcl_Interp *interp;             /* Interpreter */
        int objc;                       /* How many arguments? */
        Tcl_Obj *CONST objv[];          /* The argument objects */
        DB_SEQUENCE *seq;               /* Database pointer */
        DBTCL_INFO *ip;                 /* Info pointer */
{
        int result, ret;

        result = TCL_OK;
        if (objc > 2) {
                Tcl_WrongNumArgs(interp, 2, objv, "");
                return (TCL_ERROR);
        }

        _DeleteInfo(ip);
        _debug_check();

        ret = seq->close(seq, 0);
        result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "sequence close");
        return (result);
}

/*
 * tcl_SeqGet --
 */
static int
tcl_SeqGet(interp, objc, objv, seq)
        Tcl_Interp *interp;             /* Interpreter */
        int objc;                       /* How many arguments? */
        Tcl_Obj *CONST objv[];          /* The argument objects */
        DB_SEQUENCE *seq;               /* Sequence pointer */
{
        static const char *seqgetopts[] = {
                "-nosync",
                "-txn",
                NULL
        };
        enum seqgetopts {
                SEQGET_NOSYNC,
                SEQGET_TXN
        };
        DB_TXN *txn;
        Tcl_Obj *res;
        db_seq_t value;
        u_int32_t aflag, delta;
        int i, end, optindex, result, ret;
        char *arg, msg[MSG_SIZE];

        result = TCL_OK;
        txn = NULL;
        aflag = 0;

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

        /*
         * Get the command name index from the object based on the options
         * defined above.
         */
        i = 2;
        end = objc;
        while (i < end) {
                if (Tcl_GetIndexFromObj(interp, objv[i], seqgetopts, "option",
                    TCL_EXACT, &optindex) != TCL_OK) {
                        arg = Tcl_GetStringFromObj(objv[i], NULL);
                        if (arg[0] == '-') {
                                result = IS_HELP(objv[i]);
                                goto out;
                        } else
                                Tcl_ResetResult(interp);
                        break;
                }
                i++;
                switch ((enum seqgetopts)optindex) {
                case SEQGET_NOSYNC:
                        aflag |= DB_TXN_NOSYNC;
                        break;
                case SEQGET_TXN:
                        if (i >= end) {
                                Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
                                result = TCL_ERROR;
                                break;
                        }
                        arg = Tcl_GetStringFromObj(objv[i++], NULL);
                        txn = NAME_TO_TXN(arg);
                        if (txn == NULL) {
                                snprintf(msg, MSG_SIZE,
                                    "Get: Invalid txn: %s\n", arg);
                                Tcl_SetResult(interp, msg, TCL_VOLATILE);
                                result = TCL_ERROR;
                        }
                        break;
                } /* switch */
                if (result != TCL_OK)
                        break;
        }
        if (result != TCL_OK)
                goto out;

        if (i != objc - 1) {
                Tcl_SetResult(interp,
                    "Wrong number of key/data given\n", TCL_STATIC);
                result = TCL_ERROR;
                goto out;
        }

        if ((result = _GetUInt32(interp, objv[objc - 1], &delta)) != TCL_OK)
                goto out;

        ret = seq->get(seq, txn, (int32_t)delta, &value, aflag);
        result = _ReturnSetup(interp, ret, DB_RETOK_DBGET(ret), "sequence get");
        if (ret == 0) {
                res = Tcl_NewWideIntObj((Tcl_WideInt)value);
                Tcl_SetObjResult(interp, res);
        }
out:
        return (result);
}
/*
 */
static int
tcl_SeqRemove(interp, objc, objv, seq, ip)
        Tcl_Interp *interp;             /* Interpreter */
        int objc;                       /* How many arguments? */
        Tcl_Obj *CONST objv[];          /* The argument objects */
        DB_SEQUENCE *seq;               /* Sequence pointer */
        DBTCL_INFO *ip;                 /* Info pointer */
{
        static const char *seqgetopts[] = {
                "-nosync",
                "-txn",
                NULL
        };
        enum seqgetopts {
                SEQGET_NOSYNC,
                SEQGET_TXN
        };
        DB_TXN *txn;
        u_int32_t aflag;
        int i, end, optindex, result, ret;
        char *arg, msg[MSG_SIZE];

        result = TCL_OK;
        txn = NULL;
        aflag = 0;

        _DeleteInfo(ip);

        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;
        end = objc;
        while (i < end) {
                if (Tcl_GetIndexFromObj(interp, objv[i], seqgetopts, "option",
                    TCL_EXACT, &optindex) != TCL_OK) {
                        arg = Tcl_GetStringFromObj(objv[i], NULL);
                        if (arg[0] == '-') {
                                result = IS_HELP(objv[i]);
                                goto out;
                        } else
                                Tcl_ResetResult(interp);
                        break;
                }
                i++;
                switch ((enum seqgetopts)optindex) {
                case SEQGET_NOSYNC:
                        aflag |= DB_TXN_NOSYNC;
                        break;
                case SEQGET_TXN:
                        if (i >= end) {
                                Tcl_WrongNumArgs(interp, 2, objv, "?-txn id?");
                                result = TCL_ERROR;
                                break;
                        }
                        arg = Tcl_GetStringFromObj(objv[i++], NULL);
                        txn = NAME_TO_TXN(arg);
                        if (txn == NULL) {
                                snprintf(msg, MSG_SIZE,
                                    "Remove: Invalid txn: %s\n", arg);
                                Tcl_SetResult(interp, msg, TCL_VOLATILE);
                                result = TCL_ERROR;
                        }
                        break;
                } /* switch */
                if (result != TCL_OK)
                        break;
        }
        if (result != TCL_OK)
                goto out;

        ret = seq->remove(seq, txn, aflag);
        result = _ReturnSetup(interp,
            ret, DB_RETOK_DBGET(ret), "sequence remove");
out:
        return (result);
}

/*
 * tcl_SeqGetFlags --
 */
static int
tcl_SeqGetFlags(interp, objc, objv, seq)
        Tcl_Interp *interp;             /* Interpreter */
        int objc;                       /* How many arguments? */
        Tcl_Obj *CONST objv[];          /* The argument objects */
        DB_SEQUENCE *seq;               /* Sequence pointer */
{
        int i, ret, result;
        u_int32_t flags;
        char buf[512];
        Tcl_Obj *res;

        static const struct {
                u_int32_t flag;
                char *arg;
        } seq_flags[] = {
                { DB_SEQ_INC, "-inc" },
                { DB_SEQ_DEC, "-dec" },
                { DB_SEQ_WRAP, "-wrap" },
                { 0, NULL }
        };

        if (objc != 2) {
                Tcl_WrongNumArgs(interp, 1, objv, NULL);
                return (TCL_ERROR);
        }

        ret = seq->get_flags(seq, &flags);
        if ((result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
            "db get_flags")) == TCL_OK) {
                buf[0] = '\0';

                for (i = 0; seq_flags[i].flag != 0; i++)
                        if (LF_ISSET(seq_flags[i].flag)) {
                                if (strlen(buf) > 0)
                                        (void)strncat(buf, " ", sizeof(buf));
                                (void)strncat(
                                    buf, seq_flags[i].arg, sizeof(buf));
                        }

                res = NewStringObj(buf, strlen(buf));
                Tcl_SetObjResult(interp, res);
        }

        return (result);
}
#endif /* HAVE_SEQUENCE */

---