/*
 * neoXdb.c
 *
 * dbopen interface for Tcl
 * 
 * based on work by
 * Poul-Henning Kamp, phk@data.fls.dk
 * 921027 0.00
 * 921222 0.10	New syntax based on descriptors
 *
 * $Id: neoXdb.c,v 1.3 1999/07/09 21:32:15 gporter Exp $
 */

/* This file will not be compiled unless TCLXDB_O=tclXdb.c in Makefile */

#ifdef NEO_DB

#include "neo.h"
#include <sys/stat.h>

#define NEO_DBOPEN

#ifdef NEO_DBOPEN

#include <stdio.h>
#include <stdlib.h>
#include <fcntl.h>
#include <memory.h>
#include <string.h>

#ifdef DB_185_COMPAT
#include <db_185.h>
#else
#include <db.h>
#endif

/* Randy Kunkee Wed Oct 11 11:30:12 CDT 1995 */
/* O_SHLOCK and O_EXLOCK are bsd4.4 specific and may not be in all O/S */
/* below code ripped out of compat.h, which is included by db.h, but */
/* does not define below constants unless __DBINTERFACE_PRIVATE is defined */
#ifndef O_SHLOCK
# define O_SHLOCK 0
#endif
#ifndef O_EXLOCK
# define O_EXLOCK 0
#endif

#define CURSOR_HARD_MAX 100
#define LOCK_DIR_SIZE 1024
#define ERR_N_ARG(syntax) { Tcl_AppendResult(interp, "bad # arg: ", \
	"\nSyntax is: ", syntax, 0) ; return TCL_ERROR; }
#define CHKNARG(min, max, syntax) if (argc < min || argc > max) ERR_N_ARG(syntax)

/*
 * t_cldat
 * -------
 */

typedef struct {
    void_pt		handles;
    DB_ENV		*dbenv;
    DB_TXN		*tid;
} t_cldat;

/*
 * t_desc
 * ------
 */

typedef struct {
    DB			*db;
    DB_LOCK		*lockp;
    Neo_CursorPool 	*cursors;
    Tcl_HashTable	*cache;
    DB_LOCK		 lock;
    DB_LOCKTAB		*lockr;
} t_desc;

/*
 * DbProc(cd, interp, argc, argv)
 * ============================
 *
 * Do the actual work.
 *
 */

static int
DbProc (cd, interp, argc, argv)
    t_cldat	*cd;
    Tcl_Interp	*interp;
    int		argc;
    char	**argv;
{
    int             i, j, k, id, length, length2, errno;
    int             mode = 0644, result = 0;
    u_int32_t       flags = NULL, locker;
    u_int           dbflags;
    ino_t	   *ino;
    int		    cur_pid;
    struct stat	    lock_stat;
    t_desc         *td = NULL;
    char           *p, *mark;
    char            buf[64], buf2[64], lockdir[LOCK_DIR_SIZE];
    Tcl_DString     dbPathBuf;
    Tcl_HashEntry  *hash;
    DB             *d;
    DBT             key, content, lock_dbt;
    DBC		   *cursorp;
    DBTYPE          dbtype;
    DB_INFO         dbi;
    DB_LOCKTAB	   *lockr;
    DB_LOCK	    lock;
    db_lockmode_t   lock_type;
    Tcl_Obj *objScript;

    static char *badDbSeqArgs = "db seq <sess> <flag> [<key>] [<var>]";
    static char *badDbCmdArgs = "db {open|close|del|cursor|get|put|seq|forall|searchall|sync}";
    int varNameIndex;
    int keyIndex;

    /* DB 2.0 requires DBT structs to be zeroed out */
    memset(&key, 0, sizeof(key));
    memset(&content, 0, sizeof(content));

    argv++; argc--;

    if(!argc)
	ERR_N_ARG(badDbCmdArgs);

/*
 *
 * db appinit <dir>
 *
 * The db library will use this directory as the HOME directory,
 * (ie- all log files, etc will go here for that db session
 *
*/
    if (STREQU (*argv, "appinit")) {
	CHKNARG (2, 2, "db appinit <dir>");

	if (!cd->dbenv) {
		cd->dbenv = (DB_ENV *)ckalloc(sizeof(DB_ENV));
		memset(cd->dbenv, 0, sizeof(DB_ENV));
		if (errno = db_appinit(argv[1], NULL, cd->dbenv, DB_CREATE | DB_INIT_LOCK | DB_INIT_LOG | DB_INIT_MPOOL | DB_INIT_TXN)) {
			Tcl_AppendResult(interp,
				"Unable to initialize environment: ",
				strerror(errno), (char *) NULL);
			return TCL_ERROR; 
		}
	}
	return TCL_OK;
    }

/*
 *
 * db appexit
 *
 * Closes down the environment
 *
*/
    if (STREQU (*argv, "appexit")) {
	CHKNARG (1, 1, "db appexit");

	if (cd->dbenv) {
		if (errno = db_appexit(cd->dbenv)) {
			Tcl_AppendResult(interp,
				"Unable to close the environment: ",
				strerror(errno), (char *) NULL);
			return TCL_ERROR;
		}

		ckfree(cd->dbenv);
		cd->dbenv = NULL;
	}
	return TCL_OK;
    }

/*
 *
 * db open <file> <type> [<flags> [<mode>]]	# return <sess>
 *
 *     Opens the specified <file> using <mode>.
 *
 *     <flags> is a subset of these chars: (default: r)
 *         c  -- create
 *         r -- read mode
 *         w -- read-write mode     
 *	   t -- truncate
 *         l -- shared lock
 *	   L -- exclusive lock
 *	   ? -- non-blocking
 *	   + -- duplicates OK
 *          
 *      <mode> is a octal integer used for creating files. (default 644)
*/
    if (STREQU (*argv, "open")) {
	CHKNARG (2, 5, "db open <file> <type> [<flags> [<mode>]]");

    	memset(&dbi, 0, sizeof(dbi));

	if (argc == 2) {
	    dbtype = DB_UNKNOWN;
	} else if (STREQU (argv[2], "hash")) {
	    dbtype = DB_HASH;
	} else if (STREQU (argv[2], "unknown")) {
	    dbtype = DB_UNKNOWN;
	} else if (STREQU (argv[2], "btree")) {
	    dbtype = DB_BTREE;
    	    dbi.flags |= DB_RECNUM;
	} else {
	    Tcl_AppendResult(interp,
		argv[0],
		": type must be 'hash' or 'btree'",
		(char *)NULL);

	    return TCL_ERROR;
	}

	lock_type = DB_LOCK_READ;
	if (argc > 3) {
	    for (p = argv[3]; *p; p++) {
		switch(*p) {
		    case 'c': flags |= DB_CREATE;
			      if (dbtype == DB_UNKNOWN) {
				Tcl_AppendResult(interp,
				  "Cannot create a file of type unknown",
				  (char *) NULL);
				return TCL_ERROR;
			      }
			      break;
		    case 'r': flags |= DB_RDONLY;
		    	      lock_type = DB_LOCK_READ; break;
		    case 'w': flags |= DB_CREATE;
		    	      lock_type = DB_LOCK_WRITE; break;
		    case 't': flags |= DB_TRUNCATE; break;
		    case 'l': break;
		    case 'L': break;
		    case '?': break;
		    case '+': dbi.flags = DB_DUP; break;
          
		    default:
			Tcl_AppendResult(interp, "what ??: ",
			    "\n<flags> must be a subset of 'rwctlL?+'", 0);
			return TCL_ERROR;
		}
	    }
	} else {
		flags |= DB_RDONLY;
		lock_type = DB_LOCK_READ;
	}

	if (argc > 4) {
	    if (sscanf (argv[4], "%o", &mode) != 1) {
		Tcl_AppendResult (interp, 
		    argv[0],
		    ": mode must be an octal integer",
		    (char *)NULL);
		return TCL_ERROR;
	    }
	}
	mode &= 0777;

	td = TclX_HandleAlloc(cd->handles, buf);
	TclX_HandleTblUseCount(cd->handles, 1);
	memset (td, 0, sizeof *td);

	/* implement file locking */
        Tcl_DStringInit (&dbPathBuf);
	Tcl_TildeSubst(interp, argv[1], &dbPathBuf);

/*
	find_lock_dir(lockdir);
	if (errno = lock_open(lockdir, DB_CREATE, 0644, cd->dbenv, &lockr)) {
		Tcl_AppendResult (interp, "couldn't lock: ",
			strerror(errno), NULL);
		return TCL_ERROR;
	}
*/

	errno = db_open (Tcl_DStringValue(&dbPathBuf),
	    dbtype,
	    flags,
	    mode,
	    cd->dbenv,
	    &dbi,
	    &d);

	if (errno) {
	    Tcl_AppendResult (interp, "couldn't open \"", argv[1],
		"\": ", strerror(errno), (char *)NULL);
	    TclX_HandleTblUseCount(cd->handles, -1);
	    TclX_HandleFree(cd->handles, td);
	    return TCL_ERROR;
	}

	td->db = d;

/*
	stat(Tcl_DStringValue(&dbPathBuf), &lock_stat);
	ino = malloc(sizeof(ino_t));
	*ino = lock_stat.st_ino;
	lock_dbt.data = ino;
	lock_dbt.size = sizeof(lock_stat.st_ino);
	locker = (u_int32_t) getpid();

	if (errno = lock_get(lockr, locker, NULL, &lock_dbt, lock_type, &lock)) {
		Tcl_AppendResult(interp, "unable to get lock: ",
			strerror(errno), NULL);
		return TCL_ERROR;
	}

	td->lock = lock;
	td->lockr = lockr;

	free(ino);
 */
	Tcl_DStringFree (&dbPathBuf);

	Tcl_AppendResult (interp, buf, (char *)NULL);
	return TCL_OK;
    }

/*
 *
 * db transaction <flag> [<code>]
 * db transaction begin <dir>
 *
*/
    if (STREQU (*argv, "transaction")) {
	CHKNARG (2, 3, "db transaction <flag> [<code>]");

	if (!cd->dbenv) {
		Tcl_AppendResult(interp,
		    "you must use \"db appinit\" to access transactions",
		    (char *) NULL);
		return TCL_ERROR;
	}

	if (STREQU (argv[1], "begin")) {
		CHKNARG (2, 2, "db transaction begin <dir>");

		errno = txn_begin(cd->dbenv->tx_info, NULL, &(cd->tid));

		if (errno) {
			Tcl_AppendResult(interp,
				"Unable to begin transaction: ",
				strerror(errno),
				(char *) NULL);
			return TCL_ERROR;
		}
			
	} else if (STREQU (argv[1], "commit")) {
		if (errno = txn_commit(cd->tid)) {
			Tcl_AppendResult(interp,
				"Unable to commit transaction: ",
				strerror(errno),
				(char *) NULL);
			return TCL_ERROR;
		}

	} else if (STREQU (argv[1], "abort")) {
		if (errno = txn_abort(cd->tid)) {
			Tcl_AppendResult(interp,
				"Unable to abort transaction: ",
				strerror(errno),
				(char *) NULL);
			return TCL_ERROR;
		}

	} else if (STREQU (argv[1], "eval")) {
		if (argc != 3) {
			Tcl_AppendResult (interp,
				"no tcl body specified",
				(char *) NULL);
			return TCL_ERROR;
		}

		/* Begin the transaction */
		if (errno = txn_begin(cd->dbenv->tx_info, NULL, &(cd->tid))) {
			Tcl_AppendResult(interp,
				"Unable to begin transaction: ",
				strerror(errno),
				(char *) NULL);
			return TCL_ERROR;
		}

		if (Tcl_Eval(interp, argv[2]) != TCL_OK) {
			if (errno = txn_abort(cd->tid)) {
				Tcl_AppendResult(interp,
					"Unable to abort transaction: ",
					strerror(errno),
					(char *) NULL);
				return TCL_ERROR;
			}
		} else {
			if (errno = txn_commit(cd->tid)) {
				Tcl_AppendResult(interp,
					"Unable to commit transaction: ",
					strerror(errno),
					(char *) NULL);
				return TCL_ERROR;
			}
		}

		cd->tid = NULL;

	} else {
		Tcl_AppendResult (interp,
			"must be {commit|abort|close|eval}",
			(char *) NULL);
		return TCL_ERROR;
	}

	return TCL_OK;
    }

/*
 *
 * db cursor <flag> <sess> [<key>/<varName>] [<varName>]
 *	db cursor get db0		= returns "db0.0"
 *	db cursor close db0.0		= returns ""
 *	db cursor first db0.0		= returns data, or ""
 *	db cursor first db0.0 varName	= sets varName to data, return 1
 *					= or set varName to "", return 0
 *	db cursor set db0.0 key		= move cursor to key, returning
 *					= "" if no key
 *	db cursor set db0.0 key varName = move cursor to key, setting
 *					= varName, and returning 1/0
 *	
 *	db cursor returns cursors that can be used to read data sequentially
 *	from the db database
 *
 *	- We need a session handle, but not as argv[1].  It makes
 *	  more sense as argv[2], hence we are before the HandleXlate call below
*/

    if (STREQU (*argv, "cursor")) {
	CHKNARG (3, 5, "db cursor <flag> <sess> [<key>/<varName>] [<varName>]");

	if (STREQU (argv[1], "get")) {
		if (argc > 1 && !(td = TclX_HandleXlate (interp, cd->handles, argv[2])))
			return TCL_ERROR;

		if (!td->cursors) {
			/* initialize the cursor Hash Table */
			td->cursors = (Neo_CursorPool *)ckalloc(sizeof *(td->cursors));
			Neo_initCursorBuf(td->cursors, 10, CURSOR_HARD_MAX);
			/* kludge:  reserve dbx.0 for forall, etc */
			Neo_SetCursor(interp, td->cursors, NULL, argv[2]);
			Tcl_ResetResult(interp);
		}

		/* get a cursor */
		td->db->cursor(td->db, cd->tid, &cursorp, 0);

		if (Neo_SetCursor(interp, td->cursors, cursorp, argv[2]) == -1) {
			return TCL_ERROR;
		} else {
			return TCL_OK;
		}

	}

	/* The following all need a cursorp */
	/* determine our db0 name */
	if (!(mark = strchr(argv[2], '.'))) {
		Tcl_AppendResult(interp,
			"invalid cursor handle: ", argv[2],
			(char *) NULL);
		return TCL_ERROR;
	}

	length = strlen(argv[2]);
	*mark = NULL;

	if (!(td = TclX_HandleXlate (interp, cd->handles, argv[2])))
		return TCL_ERROR;
	length2 = strlen(argv[2]);
	*mark = '.';

	if ((length2 + 2) > length) {
		Tcl_AppendResult(interp,
			"invalid cursor handle: ", argv[2],
			(char *) NULL);
		return TCL_ERROR;
	}

	/* incr the mark */
	mark++;

	if (Tcl_GetInt(interp, mark, &id) != TCL_OK) {
		return TCL_ERROR;
	}

	if (id == 0) {
		Tcl_AppendResult(interp,
			"invalid cursor handle: ", argv[2],
			(char *) NULL);
		return TCL_ERROR;
	}

	cursorp = (DBC *) Neo_GetCursor(td->cursors, id);

	/* close the cursor */
	if (STREQU (argv[1], "close")) {
		cursorp->c_close(cursorp);

		/* delete the entry */
		Neo_DelCursor(td->cursors, id);

	} else if (STREQU (argv[1], "first")) {
		errno = cursorp->c_get(cursorp, &key, &content, DB_FIRST);

		if (argc == 4) {
			
			if (errno == DB_NOTFOUND) {
				Tcl_SetVar (interp, argv[3], "", 0);
				Tcl_SetResult (interp, "0", TCL_VOLATILE);
			} else {
				Tcl_SetVar (interp, argv[3], key.data, 0);
				Tcl_SetResult (interp, "1", TCL_VOLATILE);
			}

		} else {

			if (errno == DB_NOTFOUND) {
				Tcl_AppendResult(interp, "", 
					(char *)NULL);
				return TCL_OK;
			}
			Tcl_SetResult (interp, key.data, TCL_VOLATILE);
		}
		
	} else if (STREQU (argv[1], "last")) {
		errno = cursorp->c_get(cursorp, &key, &content, DB_LAST);

		if (argc == 4) {

			if (errno == DB_NOTFOUND) {
				Tcl_SetVar (interp, argv[3], "", 0);
				Tcl_SetResult (interp, "0", TCL_VOLATILE);
			} else {
				Tcl_SetVar (interp, argv[3], key.data, 0);
				Tcl_SetResult (interp, "1", TCL_VOLATILE);
			}

		} else {

			if (errno == DB_NOTFOUND) {
				Tcl_AppendResult(interp, "",
					(char *) NULL);
				return TCL_OK;
			}
			Tcl_SetResult (interp, key.data, TCL_VOLATILE);
		}

	} else if (STREQU (argv[1], "next")) {
		errno = cursorp->c_get(cursorp, &key, &content, DB_NEXT);

		if (argc == 4) {

			if (errno == DB_NOTFOUND) {
				Tcl_SetVar (interp, argv[3], "", 0);
				Tcl_SetResult (interp, "0", TCL_VOLATILE);
			} else {
				Tcl_SetVar (interp, argv[3], key.data, 0);
				Tcl_SetResult (interp, "1", TCL_VOLATILE);
			}

		} else {
			if (errno == DB_NOTFOUND) {
				Tcl_AppendResult(interp, "",
				(char *) NULL);
				return TCL_OK;
			}
			Tcl_SetResult (interp, key.data, TCL_VOLATILE);
		}

	} else if (STREQU (argv[1], "prev")) {
		errno = cursorp->c_get(cursorp, &key, &content, DB_PREV);

		if (argc == 4) {

			if (errno == DB_NOTFOUND) {
				Tcl_SetVar (interp, argv[3], "", 0);
				Tcl_SetResult (interp, "0", TCL_VOLATILE);
			} else {
				Tcl_SetVar (interp, argv[3], key.data, 0);
				Tcl_SetResult (interp, "1", TCL_VOLATILE);
			}

		} else {
			if (errno == DB_NOTFOUND) {
				Tcl_AppendResult(interp, "",
					(char *) NULL);
				return TCL_OK;
			}
			Tcl_SetResult (interp, key.data, TCL_VOLATILE);
		}

	} else if (STREQU (argv[1], "set")) {
		if (argc < 4) {
			Tcl_AppendResult (interp, "no key specified",
				(char *) NULL);
			return TCL_ERROR;
		}

		key.data = argv[3];
		key.size = strlen (key.data) + 1;

		errno = cursorp->c_get(cursorp, &key, &content, DB_SET);

		if (argc == 5) {
			if (errno == DB_NOTFOUND) {
				Tcl_SetVar (interp, argv[4], "", 0);
				Tcl_SetResult (interp, "0", TCL_VOLATILE);
			} else {
				Tcl_SetVar (interp, argv[4], key.data, 0);
				Tcl_SetResult (interp, "1", TCL_VOLATILE);
			}
		} else {
			if (errno == DB_NOTFOUND) {
				Tcl_AppendResult(interp, "",
					(char *) NULL);
				return TCL_OK;
			}
			Tcl_SetResult (interp, key.data, TCL_VOLATILE);
		}

	} else {
		Tcl_AppendResult(interp,
			"invalid cursor flag: must be one of: {get|close|first|last|next|prev|set}",
			(char *)NULL);
		return TCL_ERROR;
	}

	return TCL_OK;
    }

    /* everything from here needs a handle, but we want #args messages to come
     * from each one in turn to get the syntax presented
     */
    if (argc > 1 && !(td = TclX_HandleXlate (interp, cd->handles, argv[1]))) {
	Tcl_ResetResult(interp);
    	Tcl_AppendResult(interp, "db handle ", argv[1], " not open", NULL);
	return TCL_ERROR;
    }
/*
 
  db close <sess>
      closes the specified db file.
*/
    if (STREQU (*argv, "close")) {
	CHKNARG (2, 2, "db close <sess>");
	td->db->close (td->db, NULL);

/*
	if (errno = lock_put(td->lockr, td->lock)) {
		Tcl_AppendResult (interp, "couldn't release lock: ",
			strerror(errno), NULL);
		return TCL_ERROR;
	}

	if (errno = lock_close(td->lockr)) {
		Tcl_AppendResult (interp, "couldn't release lock: ",
			strerror(errno), NULL);
		return TCL_ERROR;
	}
 */

	TclX_HandleFree (cd->handles, td);
	i = TclX_HandleTblUseCount(cd->handles, -1);

	return TCL_OK;
    }

/*
 
  db cache <sess> 
      cache the specified db file.
*/
    if (STREQU (*argv, "cache")) {
	CHKNARG (2, 2, "db cache <sess>");
	if (td->cache) return TCL_OK;
	td->cache = (Tcl_HashTable *)ckalloc(sizeof *(td->cache));
	Tcl_InitHashTable (td->cache, TCL_STRING_KEYS);
	return TCL_OK;
    }
/*
 * db get <sess> <key> [<var>]	
 *    will try to get the value addressed by <key>
 *    if <var> is present it will contain the result, and the return
 *        value will be a boolean: 1 on success, 0 on failure.
 *    else the found value will be returned and failures will give an
 *        error return;
 */
    if (STREQU (*argv, "get")) {
	CHKNARG (3, 4, "db get <sess> <key> [<var>]");
	if (td->cache) {
	    hash = Tcl_FindHashEntry (td->cache, argv[2]);
	    if (hash) {
		content.data = hash->clientData;
		goto gotit;
	    }
	}

	key.data = argv[2];
	key.size = strlen (key.data) + 1;

	result = td->db->get (td->db, cd->tid, &key, &content, 0);

	if (result && result != DB_KEYEMPTY && result != DB_NOTFOUND) {
	    Tcl_AppendResult (
		interp,
		"Couldn't get: ",
		strerror(errno),
		(char *)NULL);
	    return TCL_ERROR;
	}

	if (td->cache) {
	    hash = Tcl_CreateHashEntry (td->cache, argv[2], &i);
	    if (result == 0) {
		hash->clientData = ckalloc (strlen(content.data) + 1);
		strcpy (hash->clientData, content.data);
	    } else {
		hash->clientData = 0;
	    }
	}

      gotit:

	if (argc > 3) {
	    if (result == DB_NOTFOUND) {
		Tcl_SetResult (interp, "0", TCL_VOLATILE);
		Tcl_SetVar (interp, argv[3], "", 0);
	    } else {
		Tcl_SetResult (interp, "1", TCL_VOLATILE);
		Tcl_SetVar (interp, argv[3], content.data, 0);
	    }
	} else {
	    if (result == DB_NOTFOUND) {
		Tcl_AppendResult(interp, "no match on key \"",argv[2],"\"",0);
		return TCL_ERROR;
	    }
	    Tcl_SetResult (interp, content.data, TCL_VOLATILE);
	}
	return TCL_OK;
    }
/*
 * db put <sess> <key> <cont> [insert|replace]
 *     puts the <cont> under the <key>. 'replace' is the default mode.
 *     returns an error on failure.
 */
    if (STREQU (*argv, "put")) {
	CHKNARG (4, 5, "db put <sess> <key> <cont> [insert|replace]");
	dbflags = 0;
	if (argc > 4) {
	    if (STREQU(argv[4], "insert"))
		dbflags = DB_NOOVERWRITE;
	    else if (STREQU (argv[4], "replace"))
		dbflags = 0;
	    else {
		Tcl_AppendResult (interp,
		   "what ?? either 'insert' or 'replace'",
		   (char *)NULL);
	 	return TCL_ERROR;
	    }
	}

	key.data = argv[2];
	key.size = strlen (key.data) + 1;

	content.data = argv[3];
	content.size = strlen (content.data) + 1;

	result = td->db->put (td->db, cd->tid, &key, &content, dbflags);
	if (result && result != DB_KEYEXIST) {
	    Tcl_AppendResult (
		interp, "Couldn't put: ", strerror(result), (char *)NULL);
	    return TCL_ERROR;
	}

	if (td->cache) {
	    hash = Tcl_CreateHashEntry (td->cache, argv[2], &i);
	    hash->clientData = ckalloc (strlen (content.data) + 1);
	    strcpy (hash->clientData, content.data);
	}

	if (result == DB_KEYEXIST) {
	    Tcl_AppendResult (
		interp,
		"Duplicate key: \"",
		argv[2],
		"\"",
		(char *)NULL);
	    return TCL_ERROR;
	}
	return TCL_OK;
    }

/*
 *
 * db del <sess> <key>
 *     Deletes the entry with the specified <key> 
 *     If the record is deleted return value is "1" 
 *     else it returns "0" 
 *     probably because <key> wasn't there to begin with 
*/

    if (STREQU (*argv, "del")) {
	CHKNARG (3, 3, "db del <sess> <key>");

	if (td->cache) {
	    hash = Tcl_FindHashEntry (td->cache, argv[2]);

	    if (hash->clientData)
		ckfree (hash->clientData);

	    if (hash)
		Tcl_DeleteHashEntry (hash);
	}

	key.data = argv[2];
	key.size = strlen (key.data) + 1;

	result = td->db->del (td->db, cd->tid, &key, 0);

	if (result && result != DB_NOTFOUND) {
		Tcl_AppendResult (
			interp,
			"Unable to delete key: \"",
			argv[2],
			"\"",
			(char *) NULL);
		return TCL_ERROR;
	}

	if (result == DB_NOTFOUND) {
	    Tcl_SetResult (interp, "0", TCL_VOLATILE);
	} else {
	    Tcl_SetResult (interp, "1", TCL_VOLATILE);
	}
	return TCL_OK;
    }



/*
 * db seq <sess> <flag> [<key>] [<var>]
 *     	Sequential read.
 *
 *       <flag> can be:
 *          cursor - data associated with key is returned,
 *                   partial matches allowed.
 *
 *          first - the first key/data pair is returned.
 *
 *          last - the last key/data pair is returned.
 *
 *          next - retrieve the next key/data pair after the
 *                 cursor, or first if cursor hasn't been set.
 *
 *          prev - retrieve the key/data pair immediately before
 *                 the cursor.
 *
 *     	if <var> is specified:
 *
 *     	    if no match is found:
 *     	        <var> is set to "" and "0" is returned
 *     	    else
 *     	        <var> is set to the key and "1" is returned.
 *     	else  (var wasn't specified)
 *     	    if no keys found:
 *     	        "" is returned
 *     	    else
 *     	        the key is returned
 */

    if (STREQU (*argv, "seq")) {

	CHKNARG (3, 6, badDbSeqArgs);
	Tcl_SetResult(interp, "seq no longer supported.  use \"db cursor\" instead", NULL);
	return TCL_ERROR;

    }

/*
 * db forall <sess> <key_var> <proc>
 *     	executes <proc> for all keys found in <tag>
 *     	The actual key_value is available in $<key_var>
 *     	Example:
 *     		xx forall key {
 *     			puts stdout "$key: [xx get $key]"
 *     		}
 *
 */

    if STREQU (*argv, "forall") {
	CHKNARG (4, 4, "db forall <sess> <key_var> <proc>");
	objScript = Tcl_NewStringObj(argv[3], (int) strlen(argv[3]));
	Tcl_IncrRefCount(objScript);

	if (!td->cursors) {
		/* initialize the cursor Hash Table */
		td->cursors = (Neo_CursorPool *)ckalloc(sizeof *(td->cursors));

		Neo_initCursorBuf(td->cursors, 10, CURSOR_HARD_MAX);
	}

	cursorp = (DBC *) Neo_GetCursor(td->cursors, 0);

	if (cursorp) {
		cursorp->c_close(cursorp);
	}

	td->db->cursor(td->db, cd->tid, &cursorp, 0);
	Neo_SetCursor(interp, td->cursors, cursorp, argv[2]);

	result = cursorp->c_get(cursorp, &key, &content, DB_FIRST);

	if (result && result != DB_NOTFOUND) {
	    Tcl_AppendResult (
		interp,
		"Couldn't forall: ",
		strerror(result),
		(char *)NULL);
	    return TCL_ERROR;
	}

	for (;;) {
	    Tcl_SetVar (interp, argv[2], key.data, 0);
	    result = Tcl_EvalObjEx (interp, objScript, 0);

	    if (result == TCL_BREAK) 
		break;
	    else if (result != TCL_OK && result != TCL_CONTINUE)
		return result;

	    result = cursorp->c_get (cursorp, &key, &content, DB_NEXT);
	    if (result != 0) break;
	}
	Tcl_DecrRefCount(objScript);
	cursorp->c_close(cursorp);
	Neo_DelCursor(td->cursors, 0);
	return TCL_OK;
    }

/*
 * db searchall <sess> <keyvar> [-<searchtype>] <pattern> <proc>
 *     	executes <proc> for all keys found in <tag>
 *     	The actual key_value is available in $<key_var>
 *     	Example:
 *     		db searchall $db key -glob "*foo*" {
 *     			puts stdout "$key: [db get $key]"
 *     		}
 *
 */

    if STREQU (*argv, "searchall") {
	int searchMatch, searchMode;
#define EXACT   0
#define GLOB    1
#define REGEXP  2

	CHKNARG (5, 6, "db searchall <sess> <key_var> [-<searchtype>] <pattern> <proc>");
	objScript = Tcl_NewStringObj(argv[argc - 1], (int) strlen(argv[argc - 1]));
	Tcl_IncrRefCount(objScript);

	if (!td->cursors) {
		/* initialize the cursor Hash Table */
		td->cursors = (Neo_CursorPool *)ckalloc(sizeof *(td->cursors));
		Neo_initCursorBuf(td->cursors, 10, CURSOR_HARD_MAX);

	}

	cursorp = (DBC *) Neo_GetCursor(td->cursors, 0);

	if (cursorp)
		cursorp->c_close(cursorp);

	td->db->cursor(td->db, cd->tid, &cursorp, 0);

	Neo_SetCursor(interp, td->cursors, cursorp, argv[2]);

        result = cursorp->c_get(cursorp, &key, &content, DB_FIRST);

	if (result && result != DB_NOTFOUND) {
	    Tcl_AppendResult (
		interp,
		"Couldn't searchall: ",
		strerror(result),
		(char *)NULL);
	    return TCL_ERROR;
	}

	if (result == DB_NOTFOUND) {
		Tcl_AppendResult(interp, "", (char *) NULL);
		return TCL_OK;
	}

	searchMode = GLOB;
	if (argc == 6) {
	    if (strcmp(argv[3], "-glob") == 0) {
		searchMode = GLOB;
	    } else if (strcmp(argv[3], "-regexp") == 0) {
		searchMode = REGEXP;
	    } else {
		Tcl_AppendResult(interp, "bad search mode \"", argv[3],
			"\": must be -glob or -regexp", (char *) NULL);
		return TCL_ERROR;
	    }
	}

	for (;;) {
	    searchMatch = 0;
	    switch (searchMode) {
		case GLOB:
		    searchMatch = Tcl_StringMatch(key.data, argv[argc-2]);
		    break;
		case REGEXP:
		    searchMatch = Tcl_RegExpMatch(interp, key.data, argv[argc-2]);
		    if (searchMatch < 0) {
			return TCL_ERROR;
		    }
		    break;
	   }

           if (searchMatch) {
	        Tcl_SetVar (interp, argv[2], key.data, 0);
	        result = Tcl_EvalObjEx(interp, objScript, 0);

	        if (result == TCL_BREAK) 
		    break;
	        else if (result != TCL_OK && result != TCL_CONTINUE)
		    return result;
           }

	    result = cursorp->c_get(cursorp, &key, &content, DB_NEXT);
	    if (result == DB_NOTFOUND || result != 0) break;
	}

	cursorp->c_close(cursorp);
	Neo_DelCursor(td->cursors, 0);
	return TCL_OK;
    }

    if STREQU (*argv, "sync") {
	CHKNARG (2, 2, "db sync <sess>");
        result = td->db->sync (td->db, 0);

	if (result) {
	    Tcl_AppendResult (
		interp,
		"Couldn't sync: ",
		strerror(result),
		(char *)NULL);
	    return TCL_ERROR;
	}
	return TCL_OK;
    }

    Tcl_AppendResult(interp, "what ??: ",
	"\nSyntax is:", 
	badDbCmdArgs,
	0 );
    return TCL_ERROR;
}

/*
 * Try to find a lock directory, or set to NULL if we can't
 */
void find_lock_dir(char *buf) {

    if (!access("/var/tmp/lock", W_OK)) {
    	strcpy(buf, "/var/tmp/lock");
    } else if (!access("/tmp/lock", W_OK)) {
    	strcpy(buf, "/tmp/lock");
    } else if (!access("/usr/tmp/lock", W_OK)) {
    	strcpy(buf, "/usr/tmp/lock");
    } else {
    	buf = NULL;
    }
}

/*
 * Neo_dbInit(interp)
 * ====================
 *
 * Initialize the db interface for the interpreter 'interp'
 *
 */

void
Neo_dbInit (interp)
Tcl_Interp	*interp;
{
    t_cldat *cd;

    cd = (t_cldat *)ckalloc (sizeof *cd);
    memset ((void*)cd, 0, sizeof *cd);
    cd->handles = TclX_HandleTblInit ("db", sizeof(t_desc), 10);

    Tcl_CreateCommand (interp, "db", DbProc, (ClientData)cd, 0);
}


#else

void
Neo_dbInit (interp)
Tcl_Interp	*interp;
{
}

#endif
#endif /* NEO_DB */
