int Web_MainEval_AP()

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;
}