tcl_db.c

这是linux下运行的mysql软件包,可用于linux 下安装 php + mysql + apach 的网络配置

	if (userecno) {
		result = _GetUInt32(interp, objv[(objc - 1)], &recno);
		if (result == TCL_OK) {
			key.data = &recno;
			key.size = sizeof(db_recno_t);
		} else
			goto out;
	} else {
		/*
		 * Some get calls (SET_*) can change the
		 * key pointers.  So, we need to store
		 * the allocated key space in a tmp.
		 */
		ret = _CopyObjBytes(interp, objv[objc-1], &ktmp,
		    &key.size, &freekey);
		if (ret != 0) {
			result = _ReturnSetup(interp, ret,
			    DB_RETOK_DBGET(ret), "db get");
			return (result);
		}
		key.data = ktmp;
	}
	ret = dbp->cursor(dbp, txn, &dbc, 0);
	result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db cursor");
	if (result == TCL_ERROR)
		goto out;

	/*
	 * At this point, we have a cursor, if we have a pattern,
	 * we go to the nearest one and step forward until we don't
	 * have any more that match the pattern prefix.  If we have
	 * an exact key, we go to that key position, and step through
	 * all the duplicates.  In either case we build up a list of
	 * the form {{key data} {key data}...} along the way.
	 */
	memset(&data, 0, sizeof(data));
	/*
	 * Restore any "partial" info we have saved.
	 */
	data = save;
	if (pattern) {
		/*
		 * Note, prefix is returned in new space.  Must free it.
		 */
		ret = _GetGlobPrefix(pattern, &prefix);
		if (ret) {
			result = TCL_ERROR;
			Tcl_SetResult(interp,
			    "Unable to allocate pattern space", TCL_STATIC);
			goto out1;
		}
		key.data = prefix;
		key.size = strlen(prefix);
		/*
		 * If they give us an empty pattern string
		 * (i.e. -glob *), go through entire DB.
		 */
		if (strlen(prefix) == 0)
			cflag = DB_FIRST;
		else
			cflag = DB_SET_RANGE;
	} else
		cflag = DB_SET;
	if (ispget) {
		_debug_check();
		F_SET(&pkey, DB_DBT_MALLOC);
		ret = dbc->c_pget(dbc, &key, &pkey, &data, cflag | rmw);
	} else {
		_debug_check();
		ret = dbc->c_get(dbc, &key, &data, cflag | rmw);
	}
	result = _ReturnSetup(interp, ret, DB_RETOK_DBCGET(ret),
	    "db get (cursor)");
	if (result == TCL_ERROR)
		goto out1;
	if (ret == 0 && pattern &&
	    memcmp(key.data, prefix, strlen(prefix)) != 0) {
		/*
		 * Free space from DB_DBT_MALLOC
		 */
		free(data.data);
		goto out1;
	}
	if (pattern)
		cflag = DB_NEXT;
	 else
		cflag = DB_NEXT_DUP;

	while (ret == 0 && result == TCL_OK) {
		/*
		 * Build up our {name value} sublist
		 */
		if (ispget)
			result = _Set3DBTList(interp, retlist, &key, 0,
			    &pkey, useprecno, &data);
		else
			result = _SetListElem(interp, retlist,
			    key.data, key.size, data.data, data.size);
		/*
		 * Free space from DB_DBT_MALLOC
		 */
		if (ispget)
			free(pkey.data);
		free(data.data);
		if (result != TCL_OK)
			break;
		/*
		 * Append {name value} to return list
		 */
		memset(&key, 0, sizeof(key));
		memset(&pkey, 0, sizeof(pkey));
		memset(&data, 0, sizeof(data));
		/*
		 * Restore any "partial" info we have saved.
		 */
		data = save;
		if (ispget) {
			F_SET(&pkey, DB_DBT_MALLOC);
			ret = dbc->c_pget(dbc, &key, &pkey, &data, cflag | rmw);
		} else
			ret = dbc->c_get(dbc, &key, &data, cflag | rmw);
		if (ret == 0 && pattern &&
		    memcmp(key.data, prefix, strlen(prefix)) != 0) {
			/*
			 * Free space from DB_DBT_MALLOC
			 */
			free(data.data);
			break;
		}
	}
out1:
	dbc->c_close(dbc);
	if (result == TCL_OK)
		Tcl_SetObjResult(interp, retlist);
out:
	/*
	 * _GetGlobPrefix(), the function which allocates prefix, works
	 * by copying and condensing another string.  Thus prefix may
	 * have multiple nuls at the end, so we free using __os_free().
	 */
	if (prefix != NULL)
		__os_free(dbp->dbenv, prefix);
	if (freedata)
		(void)__os_free(dbp->dbenv, dtmp);
	if (freekey)
		(void)__os_free(dbp->dbenv, ktmp);
	return (result);
}

/*
 * tcl_db_delete --
 */
static int
tcl_DbDelete(interp, objc, objv, dbp)
	Tcl_Interp *interp;		/* Interpreter */
	int objc;			/* How many arguments? */
	Tcl_Obj *CONST objv[];		/* The argument objects */
	DB *dbp;			/* Database pointer */
{
	static char *dbdelopts[] = {
		"-auto_commit",
		"-glob",
		"-txn",
		NULL
	};
	enum dbdelopts {
		DBDEL_AUTO_COMMIT,
		DBDEL_GLOB,
		DBDEL_TXN
	};
	DBC *dbc;
	DBT key, data;
	DBTYPE type;
	DB_TXN *txn;
	void *ktmp;
	db_recno_t recno;
	int freekey, i, optindex, result, ret;
	u_int32_t flag;
	char *arg, *pattern, *prefix, msg[MSG_SIZE];

	result = TCL_OK;
	freekey = 0;
	flag = 0;
	pattern = prefix = NULL;
	txn = NULL;
	if (objc < 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "?-args? key");
		return (TCL_ERROR);
	}

	memset(&key, 0, sizeof(key));
	/*
	 * The first arg must be -auto_commit, -glob, -txn or a list of keys.
	 */
	i = 2;
	while (i < objc) {
		if (Tcl_GetIndexFromObj(interp, objv[i], dbdelopts, "option",
		    TCL_EXACT, &optindex) != TCL_OK) {
			/*
			 * If we don't have a -auto_commit, -glob or -txn,
			 * then the remaining args must be exact keys.
			 * Reset the result so we don't get an errant error
			 * message if there is another error.
			 */
			if (IS_HELP(objv[i]) == TCL_OK)
				return (TCL_OK);
			Tcl_ResetResult(interp);
			break;
		}
		i++;
		switch ((enum dbdelopts)optindex) {
		case DBDEL_TXN:
			if (i == objc) {
				/*
				 * Someone could conceivably have a key of
				 * the same name.  So just break and use it.
				 */
				i--;
				break;
			}
			arg = Tcl_GetStringFromObj(objv[i++], NULL);
			txn = NAME_TO_TXN(arg);
			if (txn == NULL) {
				snprintf(msg, MSG_SIZE,
				    "Delete: Invalid txn: %s\n", arg);
				Tcl_SetResult(interp, msg, TCL_VOLATILE);
				result = TCL_ERROR;
			}
			break;
		case DBDEL_AUTO_COMMIT:
			flag |= DB_AUTO_COMMIT;
			break;
		case DBDEL_GLOB:
			/*
			 * Get the pattern.  Get the prefix and use cursors to
			 * get all the data items.
			 */
			if (i == objc) {
				/*
				 * Someone could conceivably have a key of
				 * the same name.  So just break and use it.
				 */
				i--;
				break;
			}
			pattern = Tcl_GetStringFromObj(objv[i++], NULL);
			break;
		}
		if (result != TCL_OK)
			break;
	}

	if (result != TCL_OK)
		goto out;
	/*
	 * XXX
	 * For consistency with get, we have decided for the moment, to
	 * allow -glob, or one key, not many.  The code was originally
	 * written to take many keys and we'll leave it that way, because
	 * tcl_DbGet may one day accept many disjoint keys to get, rather
	 * than one, and at that time we'd make delete be consistent.  In
	 * any case, the code is already here and there is no need to remove,
	 * just check that we only have one arg left.
	 *
	 * If we have a pattern AND more keys to process, there is an error.
	 * Either we have some number of exact keys, or we have a pattern.
	 *
	 * If we have a pattern and an auto commit flag, there is an error.
	 */
	if (pattern == NULL) {
		if (i != (objc - 1)) {
			Tcl_WrongNumArgs(
			    interp, 2, objv, "?args? -glob pattern | key");
			result = TCL_ERROR;
			goto out;
		}
	} else {
		if (i != objc) {
			Tcl_WrongNumArgs(
			    interp, 2, objv, "?args? -glob pattern | key");
			result = TCL_ERROR;
			goto out;
		}
		if (flag & DB_AUTO_COMMIT) {
			Tcl_SetResult(interp,
			    "Cannot use -auto_commit and patterns.\n",
			    TCL_STATIC);
			result = TCL_ERROR;
			goto out;
		}
	}

	/*
	 * If we have remaining args, they are all exact keys.  Call
	 * DB->del on each of those keys.
	 *
	 * If it is a RECNO database, the key is a record number and must be
	 * setup up to contain a db_recno_t.  Otherwise the key is a "string".
	 */
	(void)dbp->get_type(dbp, &type);
	ret = 0;
	while (i < objc && ret == 0) {
		memset(&key, 0, sizeof(key));
		if (type == DB_RECNO || type == DB_QUEUE) {
			result = _GetUInt32(interp, objv[i++], &recno);
			if (result == TCL_OK) {
				key.data = &recno;
				key.size = sizeof(db_recno_t);
			} else
				return (result);
		} else {
			ret = _CopyObjBytes(interp, objv[i++], &ktmp,
			    &key.size, &freekey);
			if (ret != 0) {
				result = _ReturnSetup(interp, ret,
				    DB_RETOK_DBDEL(ret), "db del");
				return (result);
			}
			key.data = ktmp;
		}
		_debug_check();
		ret = dbp->del(dbp, txn, &key, flag);
		/*
		 * If we have any error, set up return result and stop
		 * processing keys.
		 */
		if (freekey)
			(void)__os_free(dbp->dbenv, ktmp);
		if (ret != 0)
			break;
	}
	result = _ReturnSetup(interp, ret, DB_RETOK_DBDEL(ret), "db del");

	/*
	 * At this point we've either finished or, if we have a pattern,
	 * we go to the nearest one and step forward until we don't
	 * have any more that match the pattern prefix.
	 */
	if (pattern) {
		ret = dbp->cursor(dbp, txn, &dbc, 0);
		if (ret != 0) {
			result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret),
			    "db cursor");
			goto out;
		}
		/*
		 * Note, prefix is returned in new space.  Must free it.
		 */
		memset(&key, 0, sizeof(key));
		memset(&data, 0, sizeof(data));
		ret = _GetGlobPrefix(pattern, &prefix);
		if (ret) {
			result = TCL_ERROR;
			Tcl_SetResult(interp,
			    "Unable to allocate pattern space", TCL_STATIC);
			goto out;
		}
		key.data = prefix;
		key.size = strlen(prefix);
		if (strlen(prefix) == 0)
			flag = DB_FIRST;
		else
			flag = DB_SET_RANGE;
		ret = dbc->c_get(dbc, &key, &data, flag);
		while (ret == 0 &&
		    memcmp(key.data, prefix, strlen(prefix)) == 0) {
			/*
			 * Each time through here the cursor is pointing
			 * at the current valid item.  Delete it and
			 * move ahead.
			 */
			_debug_check();
			ret = dbc->c_del(dbc, 0);
			if (ret != 0) {
				result = _ReturnSetup(interp, ret,
				    DB_RETOK_DBCDEL(ret), "db c_del");
				break;
			}
			/*
			 * Deleted the current, now move to the next item
			 * in the list, check if it matches the prefix pattern.
			 */
			memset(&key, 0, sizeof(key));
			memset(&data, 0, sizeof(data));
			ret = dbc->c_get(dbc, &key, &data, DB_NEXT);
		}
		if (ret == DB_NOTFOUND)
			ret = 0;
		/*
		 * _GetGlobPrefix(), the function which allocates prefix, works
		 * by copying and condensing another string.  Thus prefix may
		 * have multiple nuls at the end, so we free using __os_free().
		 */
		__os_free(dbp->dbenv, prefix);
		dbc->c_close(dbc);
		result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "db del");
	}
out:
	return (result);
}

/*
 * tcl_db_cursor --
 */
static int
tcl_DbCursor(interp, objc, objv, dbp, dbcp)
	Tcl_Interp *interp;		/* Interpreter */
	int objc;			/* How many arguments? */
	Tcl_Obj *CONST objv[];		/* The argument objects */
	DB *dbp;			/* Database pointer */
	DBC **dbcp;			/* Return cursor pointer */
{
	static char *dbcuropts[] = {
#if CONFIG_TEST
		"-dirty",
		"-update",
#endif
		"-txn",
		NULL
	};
	enum dbcuropts {
#if CONFIG_TEST
		DBCUR_DIRTY,
		DBCUR_UPDATE,
#endif
		DBCUR_TXN
	};
	DB_TXN *txn;
	u_int32_t flag;
	int i, optindex, result, ret;
	char *arg, msg[MSG_SIZE];

	result = TCL_OK;
	flag = 0;
	txn = NULL;
	i = 2;
	while (i < objc) {
		if (Tcl_GetIndexFromObj(interp, objv[i], dbcuropts, "option",
		    TCL_EXACT, &optindex) != TCL_OK) {
			result = IS_HELP(objv[i]);
			goto out;
		}
		i++;
		switch ((enum dbcuropts)optindex) {
#if CONFIG_TEST
		case DBCUR_DIRTY:
			flag |= DB_DIRTY_READ;
			break;
		case DBCUR_UPDATE:
			flag |= DB_WRITECURSOR;
			break;
#endif
		case DBCUR_TXN:
			if (i == objc) {
				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,
				    "Cursor: Invalid txn: %s\n", arg);
				Tcl_SetResult(interp, msg, TCL_VOLATILE);
				result = TCL_ERROR;
			}
			break;
		}
		if (result != TCL_OK)
			break;
	}
	if (result != TCL_OK)
		goto out;

	_debug_check();
	ret = dbp->cursor(dbp, txn, dbcp, flag);
	if (ret != 0)
		result = _ErrorSetup(interp, ret, "db cursor");
out:
	return (result);
}

/*
 * tcl_DbAssociate --
 *	Call DB->associate().
 */
static int
tcl_DbAssociate(interp, objc, objv, dbp)
	Tcl_Interp *interp;
	int objc;
	Tcl_Obj *CONST objv[];
	DB *dbp;
{
	static char *dbaopts[] = {
		"-auto_commit",
		"-create",
		"-txn",
		NULL
	};
	enum dbaopts {
		DBA_AUTO_COMMIT,
		DBA_CREATE,
		DBA_TXN
	};
	DB *sdbp;
	DB_TXN *txn;
	DBTCL_INFO *sdbip;
	int i, optindex, result, ret;
	char *arg, msg[MSG_SIZE];
	u_int32_t flag;

	txn = NULL;
	result = TCL_OK;
	flag = 0;
	if (objc < 2) {
		Tcl_WrongNumArgs(interp, 2, objv, "[callback] secondary");
		return (TCL_ERROR);
	}

	i = 2;
	while (i < objc) {
		if (Tcl_GetIndexFromObj(interp, objv[i], dbaopts, "option",
		    TCL_EXACT, &optindex) != TCL_OK) {
			result = IS_HELP(objv[i]);
			if (result == TCL_OK)
				return (result);
			result = TCL_OK;
			Tcl_ResetResult(interp);
			break;
		}
		i++;
		switch ((enum dbaopts)optindex) {
		case DBA_AUTO_COMMIT:
			flag |= DB_AUTO_COMMIT;
			break;
		case DBA_CREATE:
			flag |= DB_CREATE;
			break;
		case DBA_TXN:
			if (i > (objc - 1)) {
				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,
				    "Associate: Invalid txn: %s\n", arg);
				Tcl_SetResult(interp, msg, TCL_VOLATILE);
				result = TCL_ERROR;
			}
			break;
		}
	}
	if (result != TCL_OK)
		return (result);

	/*
	 * Better be 1 or 2 args left.  The last arg must be the sdb
	 * handle.  If 2 args then objc-2 is the callback proc, else
	 * we have a NULL callback.
	 */
	/* Get the secondary DB handle. */
	arg = Tcl_GetStringFromObj(objv[objc - 1], NULL);
	sdbp = NAME_TO_DB(arg);
	if (sdbp == NULL) {
		snprintf(msg, MSG_SIZE,
		    "Associate: Invalid database handle: %s\n", arg);
		Tcl_SetResult(interp, msg, TCL_VOLATILE);
		return (TCL_ERROR);
	}

	/*
	 * The callback is simply a Tcl object containing the name
	 * of the callback proc, which is the second-to-last argument.
	 *
	 * Note that the callback needs to go in the *secondary* DB handle's
	 * info struct;  we may have multiple secondaries with different
	 * callbacks.
	 */
	sdbip = (DBTCL_INFO *)sdbp->api_internal;
	if (i != objc - 1) {
		/*
		 * We have 2 args, get the callback.
		 */
		sdbip->i_second_call = objv[objc - 2];
		Tcl_IncrRefCount(sdbip->i_second_call);

		/* Now call associate. */
		_debug_check();
		ret = dbp->associate(dbp, txn, sdbp, tcl_second_call, flag);
	} else {
		/*
		 * We have a NULL callback.
		 */
		sdbip->i_second_call = NULL;
		ret = dbp->associate(dbp, txn, sdbp, NULL, flag);
	}
	result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "associate");

	return (result);
}

/*
 * tcl_second_call --