in src/generic/modwebsh_ap.c [381:454]
int Web_MainEval_AP(ClientData clientData,
Tcl_Interp * interp, int objc, Tcl_Obj * CONST objv[])
{
int res = 0;
websh_server_conf *conf;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "code");
return TCL_ERROR;
}
if (clientData == NULL) {
LOG_MSG(interp, WRITE_LOG | INTERP_ERRORINFO,
__FILE__, __LINE__,
"web::maineval", WEBLOG_ERROR,
"panic - cannot access main interp", NULL);
return TCL_ERROR;
}
conf = ((WebInterp *) clientData)->interpClass->conf;
if (conf->mainInterp == NULL) {
LOG_MSG(interp, WRITE_LOG | INTERP_ERRORINFO,
__FILE__, __LINE__,
"web::maineval", WEBLOG_ERROR,
"panic - cannot access main interp", NULL);
return TCL_ERROR;
}
Tcl_MutexLock(&(conf->mainInterpLock));
Tcl_IncrRefCount(objv[1]);
res = Tcl_EvalObjEx(conf->mainInterp, objv[1], 0);
Tcl_DecrRefCount(objv[1]);
if (res != TCL_OK) {
LOG_MSG(interp, WRITE_LOG | INTERP_ERRORINFO,
__FILE__, __LINE__,
"web::maineval", WEBLOG_ERROR,
"error evaluating \"", Tcl_GetString(objv[1]), "\"", NULL);
}
/* code from TclTransferResult tclResult.c */
/* since Interp struct is not visible there is no access to flags
-> just do a simple transfer of what errorInfo, errorCode an Result */
{
Tcl_Obj *objPtr;
if (res == TCL_ERROR) {
Tcl_ResetResult(interp);
objPtr = Tcl_GetVar2Ex(conf->mainInterp, "errorInfo", NULL,
TCL_GLOBAL_ONLY);
Tcl_SetVar2Ex(interp, "errorInfo", NULL, objPtr, TCL_GLOBAL_ONLY);
objPtr = Tcl_GetVar2Ex(conf->mainInterp, "errorCode", NULL,
TCL_GLOBAL_ONLY);
Tcl_SetVar2Ex(interp, "errorCode", NULL, objPtr, TCL_GLOBAL_ONLY);
}
Tcl_SetObjResult(interp, Tcl_GetObjResult(conf->mainInterp));
Tcl_ResetResult(conf->mainInterp);
}
Tcl_MutexUnlock(&(conf->mainInterpLock));
return res;
}