1/*-
2 * See the file LICENSE for redistribution information.
3 *
4 * Copyright (c) 1999,2008 Oracle.  All rights reserved.
5 *
6 * $Id: tcl_util.c,v 12.9 2008/01/08 20:58:52 bostic Exp $
7 */
8
9#include "db_config.h"
10
11#include "db_int.h"
12#ifdef HAVE_SYSTEM_INCLUDE_FILES
13#include <tcl.h>
14#endif
15#include "dbinc/tcl_db.h"
16
17/*
18 * bdb_RandCommand --
19 *	Implements rand* functions.
20 *
21 * PUBLIC: int bdb_RandCommand __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
22 */
23int
24bdb_RandCommand(interp, objc, objv)
25	Tcl_Interp *interp;		/* Interpreter */
26	int objc;			/* How many arguments? */
27	Tcl_Obj *CONST objv[];		/* The argument objects */
28{
29	static const char *rcmds[] = {
30		"rand",	"random_int",	"srand",
31		NULL
32	};
33	enum rcmds {
34		RRAND, RRAND_INT, RSRAND
35	};
36	Tcl_Obj *res;
37	int cmdindex, hi, lo, result, ret;
38
39	result = TCL_OK;
40	/*
41	 * Get the command name index from the object based on the cmds
42	 * defined above.  This SHOULD NOT fail because we already checked
43	 * in the 'berkdb' command.
44	 */
45	if (Tcl_GetIndexFromObj(interp,
46	    objv[1], rcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
47		return (IS_HELP(objv[1]));
48
49	res = NULL;
50	switch ((enum rcmds)cmdindex) {
51	case RRAND:
52		/*
53		 * Must be 0 args.  Error if different.
54		 */
55		if (objc != 2) {
56			Tcl_WrongNumArgs(interp, 2, objv, NULL);
57			return (TCL_ERROR);
58		}
59		ret = rand();
60		res = Tcl_NewIntObj(ret);
61		break;
62	case RRAND_INT:
63		/*
64		 * Must be 4 args.  Error if different.
65		 */
66		if (objc != 4) {
67			Tcl_WrongNumArgs(interp, 2, objv, "lo hi");
68			return (TCL_ERROR);
69		}
70		if ((result =
71		    Tcl_GetIntFromObj(interp, objv[2], &lo)) != TCL_OK)
72			return (result);
73		if ((result =
74		    Tcl_GetIntFromObj(interp, objv[3], &hi)) != TCL_OK)
75			return (result);
76		if (lo < 0 || hi < 0) {
77			Tcl_SetResult(interp,
78			    "Range value less than 0", TCL_STATIC);
79			return (TCL_ERROR);
80		}
81
82		_debug_check();
83		ret = lo + rand() % ((hi - lo) + 1);
84		res = Tcl_NewIntObj(ret);
85		break;
86	case RSRAND:
87		/*
88		 * Must be 1 arg.  Error if different.
89		 */
90		if (objc != 3) {
91			Tcl_WrongNumArgs(interp, 2, objv, "seed");
92			return (TCL_ERROR);
93		}
94		if ((result =
95		    Tcl_GetIntFromObj(interp, objv[2], &lo)) == TCL_OK) {
96			srand((u_int)lo);
97			res = Tcl_NewIntObj(0);
98		}
99		break;
100	}
101
102	/*
103	 * Only set result if we have a res.  Otherwise, lower functions have
104	 * already done so.
105	 */
106	if (result == TCL_OK && res)
107		Tcl_SetObjResult(interp, res);
108	return (result);
109}
110