HRESULT
ComObject::hresultFromErrorCode () const
{
#if TCL_MINOR_VERSION >= 1
Tcl_Obj *pErrorCode =
Tcl_GetVar2Ex(m_interp, "::errorCode", 0, TCL_LEAVE_ERR_MSG);
#else
TclObject errorCodeVarName("::errorCode");
Tcl_Obj *pErrorCode =
Tcl_ObjGetVar2(m_interp, errorCodeVarName, 0, TCL_LEAVE_ERR_MSG);
#endif
if (pErrorCode == 0) {
return E_UNEXPECTED;
}
Tcl_Obj *pErrorClass;
if (Tcl_ListObjIndex(m_interp, pErrorCode, 0, &pErrorClass) != TCL_OK) {
return E_UNEXPECTED;
}
if (strcmp(Tcl_GetStringFromObj(pErrorClass, 0), "COM") != 0) {
return E_UNEXPECTED;
}
Tcl_Obj *pHresult;
if (Tcl_ListObjIndex(m_interp, pErrorCode, 1, &pHresult) != TCL_OK) {
return E_UNEXPECTED;
}
HRESULT hr;
if (Tcl_GetLongFromObj(m_interp, pHresult, &hr) != TCL_OK) {
return E_UNEXPECTED;
}
return hr;
}
long
TclObject::getLong () const
{
long value;
Tcl_GetLongFromObj(0, m_pObj, &value);
return value;
}
static int _time_to_frames(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj* const *objv) {
_t *dp = (_t *)clientData;
if (argc != 3) return fw_error_str(interp, "jack-client time-to-frames time");
long time;
if (Tcl_GetLongFromObj(interp, objv[2], &time) != TCL_OK) return TCL_ERROR;
Tcl_SetObjResult(interp, Tcl_NewIntObj(jack_time_to_frames(dp->fw.client, (jack_time_t)time)));
return TCL_OK;
}
long TclUtils::getLong(Tcl_Interp *interp, Tcl_Obj *objPtr) {
long ret;
if (TCL_OK != Tcl_GetLongFromObj(interp, objPtr, &ret))
throw wrong_args_value_exception(error_message::bad_int_argument);
return ret;
}
static int Hello_Cmd(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
long n1;
long n2;
Tcl_Obj *res;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "n1 n2");
return TCL_ERROR;
}
if (Tcl_GetLongFromObj(interp, objv[1], &n1) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_GetLongFromObj(interp, objv[2], &n2) != TCL_OK) {
return TCL_ERROR;
}
res = Tcl_NewLongObj(n1 + n2);
Tcl_SetObjResult(interp, res);
return TCL_OK;
}
static int _get_pointer(Tcl_Interp *interp, Tcl_Obj *value, void **pointer) {
#if __WORDSIZE == 64
return Tcl_GetLongFromObj(interp, value, (long *)pointer);
#elif __WORDSIZE == 32
return Tcl_GetIntFromObj(interp, value, (int *)pointer);
#else
#error "sizeof(void *) isn't obvious"
#endif
}
static int
TestgetwindowinfoObjCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
long hwnd;
Tcl_Obj *dictObj = NULL, *classObj = NULL, *textObj = NULL;
Tcl_Obj *childrenObj = NULL;
TCHAR buf[512];
int cch, cchBuf = 256;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "hwnd");
return TCL_ERROR;
}
if (Tcl_GetLongFromObj(interp, objv[1], &hwnd) != TCL_OK)
return TCL_ERROR;
cch = GetClassName(INT2PTR(hwnd), buf, cchBuf);
if (cch == 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to get class name: ", -1));
AppendSystemError(interp, GetLastError());
return TCL_ERROR;
} else {
Tcl_DString ds;
Tcl_WinTCharToUtf(buf, -1, &ds);
classObj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
Tcl_DStringFree(&ds);
}
dictObj = Tcl_NewDictObj();
Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("class", 5), classObj);
Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("id", 2),
Tcl_NewLongObj(GetWindowLongA(INT2PTR(hwnd), GWL_ID)));
cch = GetWindowText(INT2PTR(hwnd), (LPTSTR)buf, cchBuf);
textObj = Tcl_NewUnicodeObj((LPCWSTR)buf, cch);
Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("text", 4), textObj);
Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("parent", 6),
Tcl_NewLongObj(PTR2INT(GetParent((INT2PTR(hwnd))))));
childrenObj = Tcl_NewListObj(0, NULL);
EnumChildWindows(INT2PTR(hwnd), EnumChildrenProc, (LPARAM)childrenObj);
Tcl_DictObjPut(interp, dictObj, Tcl_NewStringObj("children", -1), childrenObj);
Tcl_SetObjResult(interp, dictObj);
return TCL_OK;
}
unsigned TclUtils::getUInt(Tcl_Interp *interp, Tcl_Obj *objPtr) {
long ret;
if (
TCL_OK != Tcl_GetLongFromObj(interp, objPtr, &ret)
|| ret < std::numeric_limits<unsigned>::min()
|| ret > std::numeric_limits<unsigned>::max()) {
std::string msg("expected unsigned integer but got \"");
msg += Tcl_GetStringFromObj(objPtr, NULL);
msg += "\"";
throw wrong_args_value_exception(msg.c_str());
}
return static_cast<unsigned>(ret);
}
/***f* socket/staticFuncs/configure
* AUTHOR
* PGB
* SOURCE
*/
static int configure ( Tcl_Interp *interp, GtkSocket *socket,
GnoclOption options[] )
{
if ( options[plugIDIdx].status == GNOCL_STATUS_CHANGED )
{
long xid;
if ( Tcl_GetLongFromObj ( interp, options[plugIDIdx].val.obj, &xid )
!= TCL_OK )
return TCL_ERROR;
gtk_socket_add_id ( socket, xid );
}
return TCL_OK;
}
static int setup_atomid_map(NLEnergy *p, Tcl_Interp *interp, int32 natoms) {
char script[64];
Tcl_Obj *obj;
Tcl_Obj **objv;
int32 *atomid, *extatomid;
int32 atomidlen;
int objc, i, s;
INT(natoms);
if (natoms <= 0) return ERROR(ERR_EXPECT);
if ((s=Array_resize(&(p->extatomid),natoms)) != OK) return ERROR(s);
extatomid = Array_data(&(p->extatomid));
snprintf(script, sizeof(script), "%s list", p->aselname);
if (TCL_OK != Tcl_EvalEx(interp, script, -1, 0) ||
NULL==(obj = Tcl_GetObjResult(interp)) ||
TCL_OK != Tcl_ListObjGetElements(interp, obj, &objc, &objv) ||
objc != natoms) {
return ERROR(ERR_EXPECT);
}
for (i = 0; i < objc; i++) {
long n;
if (TCL_OK != Tcl_GetLongFromObj(interp, objv[i], &n)) {
return ERROR(ERR_EXPECT);
}
extatomid[i] = (int32) n;
ASSERT(0==i || extatomid[i-1] < extatomid[i]);
}
ASSERT(i == natoms);
p->firstid = extatomid[0];
p->lastid = extatomid[natoms-1];
INT(p->firstid);
INT(p->lastid);
atomidlen = p->lastid - p->firstid + 1;
ASSERT(atomidlen >= natoms);
if ((s=Array_resize(&(p->atomid),atomidlen)) != OK) return ERROR(s);
atomid = Array_data(&(p->atomid));
for (i = 0; i < atomidlen; i++) { /* initialize */
atomid[i] = FAIL;
}
for (i = 0; i < natoms; i++) {
atomid[ extatomid[i] - p->firstid ] = i;
}
return OK;
}
int
TclGetLong(
Tcl_Interp *interp, /* Interpreter used for error reporting if not
* NULL. */
CONST char *src, /* String containing a (possibly signed) long
* integer in a form acceptable to
* Tcl_GetLongFromObj(). */
long *longPtr) /* Place to store converted long result. */
{
Tcl_Obj obj;
int code;
obj.refCount = 1;
obj.bytes = (char *) src;
obj.length = strlen(src);
obj.typePtr = NULL;
code = Tcl_GetLongFromObj(interp, &obj, longPtr);
if (obj.refCount > 1) {
Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
return code;
}
Skill* Skill::createSkillByScript( const char* skillNsName )
{
char tempBuf[256];
StringCchPrintfA( tempBuf, 256, "%s::name", skillNsName );
const char* skillName = GetScriptManager().readString( tempBuf );
StringCchPrintfA( tempBuf, 256, "%s::description", skillNsName );
const char* skillDescription = GetScriptManager().readString( tempBuf );
StringCchPrintfA( tempBuf, 256, "%s::csEssentials", skillNsName );
int csEssentials = GetScriptManager().readInt( tempBuf );
Skill* ret = new Skill( skillName, skillDescription, csEssentials );
StringCchPrintfA( tempBuf, 256, "%s::registerSkillObjects", skillNsName );
Tcl_Obj* skillObjects = GetScriptManager().execute( tempBuf );
int skillObjectsCount = 0;
Tcl_Interp* interp = GetScriptManager().getInterp();
Tcl_ListObjLength( interp, skillObjects, &skillObjectsCount );
int i;
for ( i = 0; i < skillObjectsCount; ++i )
{
Tcl_Obj* elem;
long soPtrVal = 0;
SkillObject* so = 0;
Tcl_ListObjIndex( interp, skillObjects, i, &elem );
Tcl_GetLongFromObj( interp, elem, &soPtrVal );
so = reinterpret_cast<SkillObject*>( soPtrVal );
if ( so->getType() == UT_SKILLOBJECT )
ret->addSkillObject( so );
else
throw std::runtime_error( "Serious error on script file." );
}
return ret;
}
int
TkpScanWindowId(
Tcl_Interp *interp,
const char * string,
Window *idPtr)
{
int code;
Tcl_Obj obj;
obj.refCount = 1;
obj.bytes = (char *) string; /* DANGER?! */
obj.length = strlen(string);
obj.typePtr = NULL;
code = Tcl_GetLongFromObj(interp, &obj, (long *)idPtr);
if (obj.refCount > 1) {
Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
if (obj.typePtr && obj.typePtr->freeIntRepProc) {
obj.typePtr->freeIntRepProc(&obj);
}
return code;
}
int MkView::SearchCmd() {
Tcl_Obj *obj_ = objv[3];
const c4_Property &prop = AsProperty(objv[2], view);
char type = prop.Type();
double dblVal = 0, dtmp;
long longVal = 0;
#ifdef TCL_WIDE_INT_TYPE
Tcl_WideInt wideVal = 0, wtmp;
#endif
c4_String strVal;
int size = view.GetSize();
int first = 0, last = size;
int row, rc, e;
switch (type) {
case 'S':
{
strVal = Tcl_GetStringFromObj(obj_, 0);
}
break;
case 'F':
case 'D':
{
e = Tcl_GetDoubleFromObj(interp, obj_, &dblVal);
if (e != TCL_OK)
return e;
}
break;
#ifdef TCL_WIDE_INT_TYPE
case 'L':
{
e = Tcl_GetWideIntFromObj(interp, obj_, &wideVal);
if (e != TCL_OK)
return e;
}
break;
#endif
case 'I':
{
e = Tcl_GetLongFromObj(interp, obj_, &longVal);
if (e != TCL_OK)
return e;
}
break;
default:
Tcl_SetResult(interp, const_cast<char *>("unsupported property type"), TCL_STATIC);
return TCL_ERROR;
}
while (first <= last) {
row = (first + last) / 2;
if (row >= size)
break;
switch (type) {
case 'S':
rc = strVal.CompareNoCase(((c4_StringProp &)prop)(view[row]));
break;
case 'F':
dtmp = dblVal - ((c4_FloatProp &)prop)(view[row]);
rc = (dtmp < 0 ? - 1: (dtmp > 0));
break;
case 'D':
dtmp = dblVal - ((c4_DoubleProp &)prop)(view[row]);
rc = (dtmp < 0 ? - 1: (dtmp > 0));
break;
#ifdef TCL_WIDE_INT_TYPE
case 'L':
wtmp = wideVal - ((c4_LongProp &)prop)(view[row]);
rc = (wtmp < 0 ? - 1: (wtmp > 0));
break;
#endif
case 'I':
rc = longVal - ((c4_IntProp &)prop)(view[row]);
break;
default:
rc = 0; // 27-09-2001, to satisfy MSVC6 warn level 4
}
if (rc == 0) {
goto done;
} else if (rc > 0) {
first = row + 1;
} else {
last = row - 1;
}
}
// Not found
row = - 1;
done: return tcl_SetObjResult(Tcl_NewIntObj(row));
}
/* ARGSUSED */
int
Tcl_ThreadObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
int option;
static const char *threadOptions[] = {
"create", "exit", "id", "join", "names",
"send", "wait", "errorproc", NULL
};
enum options {
THREAD_CREATE, THREAD_EXIT, THREAD_ID, THREAD_JOIN, THREAD_NAMES,
THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC
};
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?args?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], threadOptions, "option", 0,
&option) != TCL_OK) {
return TCL_ERROR;
}
/*
* Make sure the initial thread is on the list before doing anything.
*/
if (tsdPtr->interp == NULL) {
Tcl_MutexLock(&threadMutex);
tsdPtr->interp = interp;
ListUpdateInner(tsdPtr);
Tcl_CreateThreadExitHandler(ThreadExitProc, NULL);
Tcl_MutexUnlock(&threadMutex);
}
switch ((enum options)option) {
case THREAD_CREATE: {
char *script;
int joinable, len;
if (objc == 2) {
/*
* Neither joinable nor special script
*/
joinable = 0;
script = "testthread wait"; /* Just enter event loop */
} else if (objc == 3) {
/*
* Possibly -joinable, then no special script, no joinable, then
* its a script.
*/
script = Tcl_GetStringFromObj(objv[2], &len);
if ((len > 1) &&
(script [0] == '-') && (script [1] == 'j') &&
(0 == strncmp (script, "-joinable", (size_t) len))) {
joinable = 1;
script = "testthread wait"; /* Just enter event loop */
} else {
/*
* Remember the script
*/
joinable = 0;
}
} else if (objc == 4) {
/*
* Definitely a script available, but is the flag -joinable?
*/
script = Tcl_GetStringFromObj(objv[2], &len);
joinable = ((len > 1) &&
(script [0] == '-') && (script [1] == 'j') &&
(0 == strncmp(script, "-joinable", (size_t) len)));
script = Tcl_GetString(objv[3]);
} else {
Tcl_WrongNumArgs(interp, 2, objv, "?-joinable? ?script?");
return TCL_ERROR;
}
return TclCreateThread(interp, script, joinable);
}
case THREAD_EXIT:
if (objc > 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
ListRemove(NULL);
Tcl_ExitThread(0);
return TCL_OK;
case THREAD_ID:
if (objc == 2) {
Tcl_Obj *idObj = Tcl_NewLongObj((long) Tcl_GetCurrentThread());
Tcl_SetObjResult(interp, idObj);
return TCL_OK;
} else {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
case THREAD_JOIN: {
long id;
int result, status;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "id");
return TCL_ERROR;
}
if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) {
return TCL_ERROR;
}
result = Tcl_JoinThread ((Tcl_ThreadId) id, &status);
if (result == TCL_OK) {
Tcl_SetIntObj (Tcl_GetObjResult (interp), status);
} else {
char buf [20];
sprintf(buf, "%ld", id);
Tcl_AppendResult(interp, "cannot join thread ", buf, NULL);
}
return result;
}
case THREAD_NAMES:
if (objc > 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
return TclThreadList(interp);
case THREAD_SEND: {
long id;
char *script;
int wait, arg;
if ((objc != 4) && (objc != 5)) {
Tcl_WrongNumArgs(interp, 2, objv, "?-async? id script");
return TCL_ERROR;
}
if (objc == 5) {
if (strcmp("-async", Tcl_GetString(objv[2])) != 0) {
Tcl_WrongNumArgs(interp, 2, objv, "?-async? id script");
return TCL_ERROR;
}
wait = 0;
arg = 3;
} else {
wait = 1;
arg = 2;
}
if (Tcl_GetLongFromObj(interp, objv[arg], &id) != TCL_OK) {
return TCL_ERROR;
}
arg++;
script = Tcl_GetString(objv[arg]);
return TclThreadSend(interp, (Tcl_ThreadId) id, script, wait);
}
case THREAD_ERRORPROC: {
/*
* Arrange for this proc to handle thread death errors.
*/
char *proc;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "proc");
return TCL_ERROR;
}
Tcl_MutexLock(&threadMutex);
errorThreadId = Tcl_GetCurrentThread();
if (errorProcString) {
ckfree(errorProcString);
}
proc = Tcl_GetString(objv[2]);
errorProcString = ckalloc(strlen(proc)+1);
strcpy(errorProcString, proc);
Tcl_MutexUnlock(&threadMutex);
return TCL_OK;
}
case THREAD_WAIT:
while (1) {
(void) Tcl_DoOneEvent(TCL_ALL_EVENTS);
}
}
return TCL_OK;
}
static int
TestintobjCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int intValue, varIndex, i;
long longValue;
const char *index, *subCmd, *string;
if (objc < 3) {
wrongNumArgs:
Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
return TCL_ERROR;
}
index = Tcl_GetString(objv[2]);
if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
return TCL_ERROR;
}
subCmd = Tcl_GetString(objv[1]);
if (strcmp(subCmd, "set") == 0) {
if (objc != 4) {
goto wrongNumArgs;
}
string = Tcl_GetString(objv[3]);
if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
return TCL_ERROR;
}
intValue = i;
/*
* If the object currently bound to the variable with index varIndex
* has ref count 1 (i.e. the object is unshared) we can modify that
* object directly. Otherwise, if RC>1 (i.e. the object is shared), we
* must create a new object to modify/set and decrement the old
* formerly-shared object's ref count. This is "copy on write".
*/
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetIntObj(varPtr[varIndex], intValue);
} else {
SetVarToObj(varIndex, Tcl_NewIntObj(intValue));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "set2") == 0) { /* doesn't set result */
if (objc != 4) {
goto wrongNumArgs;
}
string = Tcl_GetString(objv[3]);
if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
return TCL_ERROR;
}
intValue = i;
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetIntObj(varPtr[varIndex], intValue);
} else {
SetVarToObj(varIndex, Tcl_NewIntObj(intValue));
}
} else if (strcmp(subCmd, "setlong") == 0) {
if (objc != 4) {
goto wrongNumArgs;
}
string = Tcl_GetString(objv[3]);
if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
return TCL_ERROR;
}
intValue = i;
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetLongObj(varPtr[varIndex], intValue);
} else {
SetVarToObj(varIndex, Tcl_NewLongObj(intValue));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "setmaxlong") == 0) {
long maxLong = LONG_MAX;
if (objc != 3) {
goto wrongNumArgs;
}
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetLongObj(varPtr[varIndex], maxLong);
} else {
SetVarToObj(varIndex, Tcl_NewLongObj(maxLong));
}
} else if (strcmp(subCmd, "ismaxlong") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
if (CheckIfVarUnset(interp, varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetLongFromObj(interp, varPtr[varIndex], &longValue) != TCL_OK) {
return TCL_ERROR;
}
Tcl_AppendToObj(Tcl_GetObjResult(interp),
((longValue == LONG_MAX)? "1" : "0"), -1);
} else if (strcmp(subCmd, "get") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
if (CheckIfVarUnset(interp, varIndex)) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "get2") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
if (CheckIfVarUnset(interp, varIndex)) {
return TCL_ERROR;
}
string = Tcl_GetString(varPtr[varIndex]);
Tcl_AppendToObj(Tcl_GetObjResult(interp), string, -1);
} else if (strcmp(subCmd, "inttoobigtest") == 0) {
/*
* If long ints have more bits than ints on this platform, verify that
* Tcl_GetIntFromObj returns an error if the long int held in an
* integer object's internal representation is too large to fit in an
* int.
*/
if (objc != 3) {
goto wrongNumArgs;
}
#if (INT_MAX == LONG_MAX) /* int is same size as long int */
Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1);
#else
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetLongObj(varPtr[varIndex], LONG_MAX);
} else {
SetVarToObj(varIndex, Tcl_NewLongObj(LONG_MAX));
}
if (Tcl_GetIntFromObj(interp, varPtr[varIndex], &i) != TCL_OK) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1);
return TCL_OK;
}
Tcl_AppendToObj(Tcl_GetObjResult(interp), "0", -1);
#endif
} else if (strcmp(subCmd, "mult10") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
if (CheckIfVarUnset(interp, varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, varPtr[varIndex],
&intValue) != TCL_OK) {
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetIntObj(varPtr[varIndex], intValue * 10);
} else {
SetVarToObj(varIndex, Tcl_NewIntObj(intValue * 10));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "div10") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
if (CheckIfVarUnset(interp, varIndex)) {
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, varPtr[varIndex],
&intValue) != TCL_OK) {
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetIntObj(varPtr[varIndex], intValue / 10);
} else {
SetVarToObj(varIndex, Tcl_NewIntObj(intValue / 10));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"bad option \"", Tcl_GetString(objv[1]),
"\": must be set, get, get2, mult10, or div10", NULL);
return TCL_ERROR;
}
return TCL_OK;
}
void
TclObject::toVariant (VARIANT *pDest,
const Type &type,
Tcl_Interp *interp,
bool addRef)
{
VariantClear(pDest);
VARTYPE vt = type.vartype();
Reference *pReference = Extension::referenceHandles.find(interp, m_pObj);
if (pReference != 0) {
// Convert interface pointer handle to interface pointer.
if (addRef) {
// Must increment reference count of interface pointers returned
// from methods.
pReference->unknown()->AddRef();
}
IDispatch *pDispatch = pReference->dispatch();
if (pDispatch != 0) {
V_VT(pDest) = VT_DISPATCH;
V_DISPATCH(pDest) = pDispatch;
} else {
V_VT(pDest) = VT_UNKNOWN;
V_UNKNOWN(pDest) = pReference->unknown();
}
} else if (m_pObj->typePtr == &Extension::unknownPointerType) {
// Convert to interface pointer.
IUnknown *pUnknown = static_cast<IUnknown *>(
m_pObj->internalRep.otherValuePtr);
if (addRef && pUnknown != 0) {
// Must increment reference count of interface pointers returned
// from methods.
pUnknown->AddRef();
}
V_VT(pDest) = VT_UNKNOWN;
V_UNKNOWN(pDest) = pUnknown;
} else if (vt == VT_SAFEARRAY) {
const Type &elementType = type.elementType();
V_VT(pDest) = VT_ARRAY | elementType.vartype();
V_ARRAY(pDest) = getSafeArray(elementType, interp);
} else if (m_pObj->typePtr == TclTypes::listType()) {
// Convert Tcl list to array of VARIANT.
int numElements;
Tcl_Obj **pElements;
if (Tcl_ListObjGetElements(interp, m_pObj, &numElements, &pElements)
!= TCL_OK) {
_com_issue_error(E_INVALIDARG);
}
SAFEARRAYBOUND bounds[2];
bounds[0].cElements = numElements;
bounds[0].lLbound = 0;
unsigned numDimensions;
// Check if the first element of the list is a list.
if (numElements > 0 && pElements[0]->typePtr == TclTypes::listType()) {
int colSize;
Tcl_Obj **pCol;
if (Tcl_ListObjGetElements(interp, pElements[0], &colSize, &pCol)
!= TCL_OK) {
_com_issue_error(E_INVALIDARG);
}
bounds[1].cElements = colSize;
bounds[1].lLbound = 0;
numDimensions = 2;
} else {
numDimensions = 1;
}
SAFEARRAY *psa = SafeArrayCreate(VT_VARIANT, numDimensions, bounds);
std::vector<long> indices(numDimensions);
fillSafeArray(m_pObj, psa, 1, &indices[0], interp, addRef);
V_VT(pDest) = VT_ARRAY | VT_VARIANT;
V_ARRAY(pDest) = psa;
#if TCL_MINOR_VERSION >= 1
} else if (m_pObj->typePtr == TclTypes::byteArrayType()) {
// Convert Tcl byte array to SAFEARRAY of bytes.
V_VT(pDest) = VT_ARRAY | VT_UI1;
V_ARRAY(pDest) = newSafeArray(m_pObj, VT_UI1);
#endif
} else if (m_pObj->typePtr == &Extension::naType) {
// This variant indicates a missing optional argument.
VariantCopy(pDest, &vtMissing);
} else if (m_pObj->typePtr == &Extension::nullType) {
V_VT(pDest) = VT_NULL;
} else if (m_pObj->typePtr == &Extension::variantType) {
VariantCopy(
pDest,
static_cast<_variant_t *>(m_pObj->internalRep.otherValuePtr));
} else if (m_pObj->typePtr == TclTypes::intType()) {
long value;
if (Tcl_GetLongFromObj(interp, m_pObj, &value) != TCL_OK) {
value = 0;
}
V_VT(pDest) = VT_I4;
V_I4(pDest) = value;
if (vt != VT_VARIANT && vt != VT_USERDEFINED) {
VariantChangeType(pDest, pDest, 0, vt);
}
} else if (m_pObj->typePtr == TclTypes::doubleType()) {
double value;
if (Tcl_GetDoubleFromObj(interp, m_pObj, &value) != TCL_OK) {
value = 0.0;
}
V_VT(pDest) = VT_R8;
V_R8(pDest) = value;
if (vt != VT_VARIANT && vt != VT_USERDEFINED) {
VariantChangeType(pDest, pDest, 0, vt);
}
} else if (m_pObj->typePtr == TclTypes::booleanType()) {
int value;
if (Tcl_GetBooleanFromObj(interp, m_pObj, &value) != TCL_OK) {
value = 0;
}
V_VT(pDest) = VT_BOOL;
V_BOOL(pDest) = (value != 0) ? VARIANT_TRUE : VARIANT_FALSE;
if (vt != VT_VARIANT && vt != VT_USERDEFINED) {
VariantChangeType(pDest, pDest, 0, vt);
}
} else if (vt == VT_BOOL) {
V_VT(pDest) = VT_BOOL;
V_BOOL(pDest) = getBool() ? VARIANT_TRUE : VARIANT_FALSE;
} else {
V_VT(pDest) = VT_BSTR;
V_BSTR(pDest) = getBSTR();
// If trying to convert from a string to a date,
// we need to convert to a double (VT_R8) first.
if (vt == VT_DATE) {
VariantChangeType(pDest, pDest, 0, VT_R8);
}
// Try to convert from a string representation.
if (vt != VT_VARIANT && vt != VT_USERDEFINED && vt != VT_LPWSTR) {
VariantChangeType(pDest, pDest, 0, vt);
}
}
}
Tcl_Obj*
TnmSnmpNorm(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
{
int i, code, objc;
Tcl_Obj **objv;
Tcl_Obj *vbListPtr = NULL;
/*
* The following Tcl_Objs are allocated once and reused whenever
* we need to expand a varbind list containing object identifiers
* without any value or type elements.
*/
static Tcl_Obj *nullType = NULL;
static Tcl_Obj *zeroValue = NULL;
static Tcl_Obj *nullValue = NULL;
if (! nullType) {
nullType = Tcl_NewStringObj("NULL", 4);
Tcl_IncrRefCount(nullType);
}
if (! zeroValue) {
zeroValue = Tcl_NewIntObj(0);
Tcl_IncrRefCount(zeroValue);
}
if (! nullValue) {
nullValue = Tcl_NewStringObj(NULL, 0);
Tcl_IncrRefCount(nullValue);
}
/*
* Split the varbind list into a list of varbinds. Create a
* new Tcl list to hold the expanded varbind list.
*/
code = Tcl_ListObjGetElements(interp, objPtr, &objc, &objv);
if (code != TCL_OK) {
goto errorExit;
}
vbListPtr = Tcl_NewListObj(0, NULL);
for (i = 0; i < objc; i++) {
int vbc, type;
Tcl_Obj **vbv, *vbPtr;
TnmOid* oidPtr;
Tcl_Obj *oidObjPtr, *typeObjPtr, *valueObjPtr;
TnmMibNode *nodePtr = NULL;
/*
* Create a new varbind element in the expanded result list
* for each varbind.
*/
vbPtr = Tcl_NewListObj(0, NULL);
Tcl_ListObjAppendElement(interp, vbListPtr, vbPtr);
code = Tcl_ListObjGetElements(interp, objv[i], &vbc, &vbv);
if (code != TCL_OK) {
goto errorExit;
}
/*
* Get the object identifier value from the first list
* element. Check the number of list elements and assign
* them to the oid, type and value variables.
*/
switch (vbc) {
case 1:
oidObjPtr = vbv[0];
typeObjPtr = nullType;
valueObjPtr = nullValue;
break;
case 2:
oidObjPtr = vbv[0];
typeObjPtr = NULL;
valueObjPtr = vbv[1];
break;
case 3:
oidObjPtr = vbv[0];
typeObjPtr = vbv[1];
valueObjPtr = vbv[2];
break;
default: {
char msg[80];
sprintf(msg, "illegal number of elements in varbind %d", i);
Tcl_ResetResult(interp);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
msg, (char *) NULL);
goto errorExit;
}
}
/*
* Check/resolve the object identifier and assign it to the
* result list. Make sure to make a deep copy if the object
* identifier value is shared since the string representation
* must be invalidated to ensure that hexadecimal
* sub-identifier are converted into decimal sub-identifier.
*/
oidPtr = TnmGetOidFromObj(interp, oidObjPtr);
if (! oidPtr) {
goto errorExit;
}
if (Tcl_IsShared(oidObjPtr)) {
oidObjPtr = Tcl_DuplicateObj(oidObjPtr);
}
TnmOidObjSetRep(oidObjPtr, TNM_OID_AS_OID);
Tcl_InvalidateStringRep(oidObjPtr);
Tcl_ListObjAppendElement(interp, vbPtr, oidObjPtr);
/*
* Lookup the type in the MIB if there is no type given in the
* varbind element.
*/
if (! typeObjPtr) {
int syntax;
nodePtr = TnmMibNodeFromOid(oidPtr, NULL);
if (! nodePtr) {
char msg[80];
sprintf(msg, "failed to lookup the type for varbind %d", i);
Tcl_ResetResult(interp);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
msg, (char *) NULL);
goto errorExit;
}
syntax = (nodePtr->typePtr && nodePtr->typePtr->name)
? nodePtr->typePtr->syntax : nodePtr->syntax;
typeObjPtr = Tcl_NewStringObj(
TnmGetTableValue(tnmSnmpTypeTable, (unsigned) syntax), -1);
}
type = TnmGetTableKeyFromObj(NULL, tnmSnmpTypeTable,
typeObjPtr, NULL);
if (type == -1) {
type = TnmGetTableKeyFromObj(NULL, tnmSnmpExceptionTable,
typeObjPtr, NULL);
if (type == -1) {
char msg[80];
invalidType:
sprintf(msg, "illegal type in varbind %d", i);
Tcl_ResetResult(interp);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
msg, (char *) NULL);
goto errorExit;
}
}
Tcl_ListObjAppendElement(interp, vbPtr, typeObjPtr);
/*
* Check the value and perform any conversions needed to
* convert the value into the base type representation.
*/
switch (type) {
case ASN1_INTEGER: {
long longValue;
code = Tcl_GetLongFromObj(interp, valueObjPtr, &longValue);
if (code != TCL_OK) {
if (! nodePtr) {
nodePtr = TnmMibNodeFromOid(oidPtr, NULL);
}
if (nodePtr) {
Tcl_Obj *value;
value = TnmMibScanValue(nodePtr->typePtr, nodePtr->syntax,
valueObjPtr);
if (! value) {
goto errorExit;
}
Tcl_ResetResult(interp);
code = Tcl_GetLongFromObj(interp, value, &longValue);
}
if (code != TCL_OK) {
goto errorExit;
}
valueObjPtr = Tcl_NewLongObj(longValue);
}
if (flags & TNM_SNMP_NORM_INT) {
if (! nodePtr) {
nodePtr = TnmMibNodeFromOid(oidPtr, NULL);
}
if (nodePtr && nodePtr->typePtr) {
Tcl_Obj *newPtr;
newPtr = TnmMibFormatValue(nodePtr->typePtr,
nodePtr->syntax,
valueObjPtr);
if (newPtr) {
valueObjPtr = newPtr;
}
}
}
break;
}
case ASN1_COUNTER32:
case ASN1_GAUGE32:
case ASN1_TIMETICKS: {
TnmUnsigned32 u;
code = TnmGetUnsigned32FromObj(interp, valueObjPtr, &u);
if (code != TCL_OK) {
goto errorExit;
}
break;
}
case ASN1_COUNTER64: {
TnmUnsigned64 u;
code = TnmGetUnsigned64FromObj(interp, valueObjPtr, &u);
if (code != TCL_OK) {
goto errorExit;
}
break;
}
case ASN1_IPADDRESS: {
if (TnmGetIpAddressFromObj(interp, valueObjPtr) == NULL) {
goto errorExit;
}
Tcl_InvalidateStringRep(valueObjPtr);
break;
}
case ASN1_OBJECT_IDENTIFIER:
if (! TnmGetOidFromObj(interp, valueObjPtr)) {
goto errorExit;
}
if (Tcl_IsShared(valueObjPtr)) {
valueObjPtr = Tcl_DuplicateObj(valueObjPtr);
}
if (flags & TNM_SNMP_NORM_OID) {
TnmOidObjSetRep(valueObjPtr, TNM_OID_AS_NAME);
} else {
TnmOidObjSetRep(valueObjPtr, TNM_OID_AS_OID);
}
Tcl_InvalidateStringRep(valueObjPtr);
break;
case ASN1_OCTET_STRING: {
int len;
if (! nodePtr) {
nodePtr = TnmMibNodeFromOid(oidPtr, NULL);
}
if (nodePtr) {
Tcl_Obj *scan;
scan = TnmMibScanValue(nodePtr->typePtr, nodePtr->syntax,
valueObjPtr);
if (scan) {
valueObjPtr = scan;
}
}
if (TnmGetOctetStringFromObj(interp, valueObjPtr, &len) == NULL) {
goto errorExit;
}
Tcl_InvalidateStringRep(valueObjPtr);
break;
}
case ASN1_NULL:
valueObjPtr = nullValue;
break;
default:
goto invalidType;
}
Tcl_ListObjAppendElement(interp, vbPtr, valueObjPtr);
}
return vbListPtr;
errorExit:
if (vbListPtr) {
Tcl_DecrRefCount(vbListPtr);
}
return NULL;
}
