C++ Tcl_DStringInit函数代码示例

/*
** This routine is called when a database file is locked while trying
** to execute SQL.
*/
static int DbBusyHandler(void *cd, const char *zTable, int nTries){
  SqliteDb *pDb = (SqliteDb*)cd;
  int rc;
  char zVal[30];
  char *zCmd;
  Tcl_DString cmd;

  Tcl_DStringInit(&cmd);
  Tcl_DStringAppend(&cmd, pDb->zBusy, -1);
  Tcl_DStringAppendElement(&cmd, zTable);
  sprintf(zVal, " %d", nTries);
  Tcl_DStringAppend(&cmd, zVal, -1);
  zCmd = Tcl_DStringValue(&cmd);
  rc = Tcl_Eval(pDb->interp, zCmd);
  Tcl_DStringFree(&cmd);
  if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
    return 0;
  }
  return 1;
}

void
Tcl_SourceRCFile(
    Tcl_Interp *interp)		/* Interpreter to source rc file into. */
{
    Tcl_DString temp;
    const char *fileName;
    Tcl_Channel chan;

    fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
    if (fileName != NULL) {
	Tcl_Channel c;
	const char *fullName;

	Tcl_DStringInit(&temp);
	fullName = Tcl_TranslateFileName(interp, fileName, &temp);
	if (fullName == NULL) {
	    /*
	     * Couldn't translate the file name (e.g. it referred to a bogus
	     * user or there was no HOME environment variable). Just do
	     * nothing.
	     */
	} else {
	    /*
	     * Test for the existence of the rc file before trying to read it.
	     */

	    c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
	    if (c != NULL) {
		Tcl_Close(NULL, c);
		if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
		    chan = Tcl_GetStdChannel(TCL_STDERR);
		    if (chan) {
			Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
			Tcl_WriteChars(chan, "\n", 1);
		    }
		}
	    }
	}
	Tcl_DStringFree(&temp);
    }
}

/*-----------------------------------------------------------------------------
 * ChmodFileNameObj --
 *   Change the mode of a file by name.
 *
 * Parameters:
 *   o interp - Pointer to the current interpreter, error messages will be
 *     returned in the result.
 *   o modeInfo - Infomation with the mode to set the file to.
 *   o fileName - Name of the file to change.
 * Returns:
 *   TCL_OK or TCL_ERROR.
 *-----------------------------------------------------------------------------
 */
static int
ChmodFileNameObj (Tcl_Interp *interp, modeInfo_t modeInfo, Tcl_Obj *fileNameObj)
{
    char         *filePath;
    struct stat   fileStat;
    Tcl_DString   pathBuf;
    int           newMode;
    char         *fileName;

    Tcl_DStringInit (&pathBuf);

    fileName = Tcl_GetStringFromObj (fileNameObj, NULL);
    filePath = Tcl_TranslateFileName (interp, fileName, &pathBuf);
    if (filePath == NULL) {
        Tcl_DStringFree (&pathBuf);
        return TCL_ERROR;
    }

    if (modeInfo.symMode != NULL) {
        if (stat (filePath, &fileStat) != 0)
            goto fileError;
        newMode = ConvSymMode (interp, modeInfo.symMode,
                               fileStat.st_mode & 07777);
        if (newMode < 0)
            goto errorExit;
    } else {
        newMode = modeInfo.absMode;
    }
    if (TclXOSchmod (interp, filePath, (unsigned short) newMode) < 0)
        return TCL_ERROR;

    Tcl_DStringFree (&pathBuf);
    return TCL_OK;

  fileError:
    TclX_AppendObjResult (interp, filePath, ": ",
                          Tcl_PosixError (interp), (char *) NULL);
  errorExit:
    Tcl_DStringFree (&pathBuf);
    return TCL_ERROR;
}

char*
Tnm_SnmpMergeVBList(int varBindSize, SNMP_VarBind *varBindPtr)
{
    static Tcl_DString list;
    int i;

    Tcl_DStringInit(&list);

    for (i = 0; i < varBindSize; i++) {
        Tcl_DStringStartSublist(&list);
	Tcl_DStringAppendElement(&list, 
			     varBindPtr[i].soid ? varBindPtr[i].soid : "");
	Tcl_DStringAppendElement(&list, 
			     varBindPtr[i].syntax ? varBindPtr[i].syntax : "");
	Tcl_DStringAppendElement(&list, 
			     varBindPtr[i].value ? varBindPtr[i].value : "");
	Tcl_DStringEndSublist(&list);
    }

    return ckstrdup(Tcl_DStringValue(&list));
}

/*
** Usage:  sqlite_get_table_printf  DB  FORMAT  STRING
**
** Invoke the sqlite_get_table_printf() interface using the open database
** DB.  The SQL is the string FORMAT.  The format string should contain
** one %s or %q.  STRING is the value inserted into %s or %q.
*/
static int test_get_table_printf(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  char **argv            /* Text of each argument */
){
  sqlite *db;
  Tcl_DString str;
  int rc;
  char *zErr = 0;
  int nRow, nCol;
  char **aResult;
  int i;
  char zBuf[30];
  if( argc!=4 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], 
       " DB FORMAT STRING", 0);
    return TCL_ERROR;
  }
  if( getDbPointer(interp, argv[1], &db) ) return TCL_ERROR;
  Tcl_DStringInit(&str);
  rc = sqlite_get_table_printf(db, argv[2], &aResult, &nRow, &nCol, 
               &zErr, argv[3]);
  sprintf(zBuf, "%d", rc);
  Tcl_AppendElement(interp, zBuf);
  if( rc==SQLITE_OK ){
    sprintf(zBuf, "%d", nRow);
    Tcl_AppendElement(interp, zBuf);
    sprintf(zBuf, "%d", nCol);
    Tcl_AppendElement(interp, zBuf);
    for(i=0; i<(nRow+1)*nCol; i++){
      Tcl_AppendElement(interp, aResult[i] ? aResult[i] : "NULL");
    }
  }else{
    Tcl_AppendElement(interp, zErr);
  }
  sqlite_free_table(aResult);
  if( zErr ) free(zErr);
  return TCL_OK;
}

SEXP dotTclcallback(SEXP args)
{
    SEXP ans, callback = CADR(args), env;
    char buff[BUFFLEN];
    char *s;
    Tcl_DString s_ds;

    if (isFunction(callback))
        callback_closure(buff, BUFFLEN, callback);
    else if (isLanguage(callback)) {
        env = CADDR(args);
        callback_lang(buff, BUFFLEN, callback, env);
    }
    else
    	error(_("argument is not of correct type"));

    Tcl_DStringInit(&s_ds);
    s = Tcl_UtfToExternalDString(NULL, buff, -1, &s_ds);
    ans = mkString(s);
    Tcl_DStringFree(&s_ds);
    return ans;
}

int ScriptTcl::Tcl_replicaEval(ClientData, Tcl_Interp *interp, int argc, char **argv) {
  if ( argc != 3 ) {
    Tcl_SetResult(interp,"args: dest script",TCL_VOLATILE);
    return TCL_ERROR;
  }
  int dest = atoi(argv[1]);
  CHECK_REPLICA(dest);
#if CMK_HAS_PARTITION
  Tcl_DString recvstr;
  Tcl_DStringInit(&recvstr);
  DataMessage *recvMsg = NULL;
  replica_eval(argv[2], dest, CkMyPe(), &recvMsg);
  CmiAssert(recvMsg != NULL);
  int code = recvMsg->code;
  Tcl_DStringAppend(&recvstr, recvMsg->data, recvMsg->size);
  Tcl_DStringResult(interp, &recvstr);
  Tcl_DStringFree(&recvstr);
  CmiFree(recvMsg);
  return code;
#else
  return Tcl_EvalEx(interp,argv[2],-1,TCL_EVAL_GLOBAL);
#endif
}

/* Provide mechanism for simulator to report which instruction
   is being executed */
void report_pc(unsigned pc)
{
    int status;
    char addr[10];
    char code[12];
    Tcl_DString cmd;
    Tcl_DStringInit(&cmd);
    Tcl_DStringAppend(&cmd, "simLabel ", -1);
    Tcl_DStringStartSublist(&cmd);
    sprintf(addr, "%u", pc);
    Tcl_DStringAppendElement(&cmd, addr);

    Tcl_DStringEndSublist(&cmd);
    Tcl_DStringStartSublist(&cmd);
    sprintf(code, "%s","*");
    Tcl_DStringAppend(&cmd, code, -1);
    Tcl_DStringEndSublist(&cmd);
    status = Tcl_Eval(sim_interp, Tcl_DStringValue(&cmd));
    if (status != TCL_OK) {
	fprintf(stderr, "Failed to report code '%s'\n", code);
	fprintf(stderr, "Error Message was '%s'\n", sim_interp->result);
    }
}

static Tcl_HashEntry *get_new_handle(Tcl_Interp *interp,
				     char *type)
{
     static unsigned long int id_counter = 0;
     Tcl_DString *handle;
     char int_buf[ID_BUF_SIZE];
     
     if (! (handle = malloc(sizeof(*handle)))) {
	  Tcl_SetResult(interp, memory_error, TCL_STATIC);
	  return 0;
     }
     Tcl_DStringInit(handle);

     assert(id_counter <= MAX_ID);

     sprintf(int_buf, "%d", id_counter++);

     Tcl_DStringAppend(handle, type, -1);
     Tcl_DStringAppend(handle, SEP_STR, -1);
     Tcl_DStringAppend(handle, int_buf, -1);

     return handle;
}

static int
SourceInitFiles(Tcl_Interp *interp)
{
    char *fileName;
    const char *library;
    Tcl_DString dst;

    library = Tcl_GetVar2(interp, "tnm", "library", TCL_GLOBAL_ONLY);
    if (! library) {
	Tcl_Panic("Tnm Tcl variable tnm(library) undefined.");
    }
    Tcl_DStringInit(&dst);
    Tcl_DStringAppend(&dst, library, -1);
    Tcl_DStringAppend(&dst, "/library/init.tcl", -1);
    if (Tcl_EvalFile(interp, Tcl_DStringValue(&dst)) != TCL_OK) {
	Tcl_DStringFree(&dst);
	return TCL_ERROR;
    }
    Tcl_DStringFree(&dst);

    /*
     * Load the user specific startup file. Check whether we
     * have a readable startup file so that we only complain
     * about errors when we are expected to complain.
     */

    fileName = getenv("TNM_RCFILE");
    if (fileName) {
	SourceRcFile(interp, fileName);
    } else {
	if (! SourceRcFile(interp, "~/.tnmrc")) {
	    SourceRcFile(interp, "~/.scottyrc");
	}
    }

    return TCL_OK;
}

/********************************************************************************************
 * test_File
 * purpose : This function replaces the "file" command of the TCL, to ensure that
 *           when checking if a file exists, we also look inside our buffers.
 * input   : clientData - used for creating new command in tcl
 *           interp - interpreter for tcl commands
 *           argc - number of parameters entered to the new command
 *           argv - the parameters entered to the tcl command
 * output  : none
 * return  : TCL_OK
 ********************************************************************************************/
int test_File(ClientData clientData, Tcl_Interp *interp,int argc, char *argv[])
{
    int i, retCode;
    Tcl_DString str;

    if ((argc == 3) && (strncmp(argv[1], "exis", 4)) == 0)
    {
        /* "file exist" command - overloaded... */
        if (tclGetFile(argv[2]) != NULL)
        {
            Tcl_SetResult(interp, (char *)"1", TCL_STATIC);
            return TCL_OK;
        }
    }

    /* Continue executing the real "file" command */
    Tcl_DStringInit(&str);
    Tcl_DStringAppendElement(&str, "fileOverloaded");
    for(i = 1; i < argc; i++)
        Tcl_DStringAppendElement(&str, argv[i]);
    retCode = Tcl_Eval(interp, Tcl_DStringValue(&str));
    Tcl_DStringFree(&str);
    return retCode;
}

static void dns_tcl_iporhostres(sockname_t *ip, char *hostn, int ok, void *other)
{
  devent_tclinfo_t *tclinfo = (devent_tclinfo_t *) other;
  Tcl_DString list;

  Tcl_DStringInit(&list);
  Tcl_DStringAppendElement(&list, tclinfo->proc);
  Tcl_DStringAppendElement(&list, iptostr(&ip->addr.sa));
  Tcl_DStringAppendElement(&list, hostn);
  Tcl_DStringAppendElement(&list, ok ? "1" : "0");

  if (tclinfo->paras) {
    EGG_CONST char *argv[2];
    char *output;

    argv[0] = Tcl_DStringValue(&list);
    argv[1] = tclinfo->paras;
    output = Tcl_Concat(2, argv);

    if (Tcl_Eval(interp, output) == TCL_ERROR) {
      putlog(LOG_MISC, "*", DCC_TCLERROR, tclinfo->proc, tcl_resultstring());
      Tcl_BackgroundError(interp);
    }
    Tcl_Free(output);
  } else if (Tcl_Eval(interp, Tcl_DStringValue(&list)) == TCL_ERROR) {
    putlog(LOG_MISC, "*", DCC_TCLERROR, tclinfo->proc, tcl_resultstring());
    Tcl_BackgroundError(interp);
  }

  Tcl_DStringFree(&list);

  nfree(tclinfo->proc);
  if (tclinfo->paras)
    nfree(tclinfo->paras);
  nfree(tclinfo);
}

/*
** This is a second alternative callback for database queries.  A the
** first column of the first row of the result is made the TCL result.
*/
static int DbEvalCallback3(
  void *clientData,      /* An instance of CallbackData */
  int nCol,              /* Number of columns in the result */
  char ** azCol,         /* Data for each column */
  char ** azN            /* Name for each column */
){
  Tcl_Interp *interp = (Tcl_Interp*)clientData;
  Tcl_Obj *pElem;
  if( azCol==0 ) return 1;
  if( nCol==0 ) return 1;
#ifdef UTF_TRANSLATION_NEEDED
  {
    Tcl_DString dCol;
    Tcl_DStringInit(&dCol);
    Tcl_ExternalToUtfDString(NULL, azCol[0], -1, &dCol);
    pElem = Tcl_NewStringObj(Tcl_DStringValue(&dCol), -1);
    Tcl_DStringFree(&dCol);
  }
#else
  pElem = Tcl_NewStringObj(azCol[0], -1);
#endif
  Tcl_SetObjResult(interp, pElem);
  return 1;
}

/*int GetRenzInfo(ClientData clientData, Tcl_Interp *interp, int argc, char **argv) {

    int num_entry;
    int i;
    char buf[1024];

    if (argc != 2) {
        Tcl_AppendResult(interp, "wrong # args: should be \"",
            argv[0], " filename\"", (char*)NULL);
        return TCL_ERROR;
    }

    if (!renzymes) {
        free_renzymes (renzymes);
    }

    renzymes = get_enzyme(argv[1]);
    printf("num_entry=%d\n", renzymes->used);

    if (!renzymes)
        return TCL_OK;

    num_entry = renzymes->used;
    Tcl_ResetResult(interp);
    for (i = 0; i < num_entry; i++) {
        sprintf(buf, "%s {%s} %s %s %.0f",renzymes->renzyme[i]->name,
                renzymes->renzyme[i]->rec_seq_text,
                renzymes->renzyme[i]->prototype,
                renzymes->renzyme[i]->supplier_codes,
                renzymes->renzyme[i]->av_frag_size);
        Tcl_AppendElement(interp, buf);
    }
    return TCL_OK;
}
*/
int GetRenzInfo(ClientData clientData, Tcl_Interp *interp, int argc, char **argv) {

    int num_entry;
    int i;

    if (argc != 2) {
        Tcl_AppendResult(interp, "wrong # args: should be \"",
            argv[0], " filename\"", (char*)NULL);
        return TCL_ERROR;
    }

    if (!renzymes) {
        free_renzymes (renzymes);
    }

    renzymes = get_enzyme(argv[1]);
    /* printf("num_entry=%d\n", renzymes->used); */
    if (!renzymes)
        return TCL_OK;

    num_entry = renzymes->used;
    Tcl_ResetResult(interp);
    for (i = 0; i < num_entry; i++) {
        Tcl_DString dstr;
        Tcl_DStringInit(&dstr);
        vTcl_DStringAppendElement(&dstr, "%s", renzymes->renzyme[i]->name);
        vTcl_DStringAppendElement(&dstr, "%s", renzymes->renzyme[i]->rec_seq_text);
        vTcl_DStringAppendElement(&dstr, "%s", renzymes->renzyme[i]->prototype);
        vTcl_DStringAppendElement(&dstr, "%s", renzymes->renzyme[i]->supplier_codes);
        vTcl_DStringAppendElement(&dstr, "%.f", renzymes->renzyme[i]->av_frag_size);
        Tcl_AppendElement(interp, Tcl_DStringValue(&dstr));

        Tcl_DStringFree(&dstr);
    }
    return TCL_OK;
}

static void overloadedGlobFunction(
  sqlite3_context *pContext,
  int nArg,
  sqlite3_value **apArg
){
  Tcl_Interp *interp = sqlite3_user_data(pContext);
  Tcl_DString str;
  int i;
  int rc;
  Tcl_DStringInit(&str);
  Tcl_DStringAppendElement(&str, "::echo_glob_overload");
  for(i=0; i<nArg; i++){
    Tcl_DStringAppendElement(&str, (char*)sqlite3_value_text(apArg[i]));
  }
  rc = Tcl_Eval(interp, Tcl_DStringValue(&str));
  Tcl_DStringFree(&str);
  if( rc ){
    sqlite3_result_error(pContext, Tcl_GetStringResult(interp), -1);
  }else{
    sqlite3_result_text(pContext, Tcl_GetStringResult(interp),
                        -1, SQLITE_TRANSIENT);
  }
  Tcl_ResetResult(interp);
}