tclsqlite.c

SQLite 2.8.6 源代码,用来在Linux/Unix/Windows上编译安装.它是一个小型的数据库,但是非常好用,速度也快,一般的数据库查询之类的操作据统计比MySQL,PostgreSQL

    return rc;
  }

  /*
  **     $db function NAME SCRIPT
  **
  ** Create a new SQL function called NAME.  Whenever that function is
  ** called, invoke SCRIPT to evaluate the function.
  */
  case DB_FUNCTION: {
    SqlFunc *pFunc;
    char *zName;
    char *zScript;
    int nScript;
    if( objc!=4 ){
      Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPT");
      return TCL_ERROR;
    }
    zName = Tcl_GetStringFromObj(objv[2], 0);
    zScript = Tcl_GetStringFromObj(objv[3], &nScript);
    pFunc = (SqlFunc*)Tcl_Alloc( sizeof(*pFunc) + nScript + 1 );
    if( pFunc==0 ) return TCL_ERROR;
    pFunc->interp = interp;
    pFunc->pNext = pDb->pFunc;
    pFunc->zScript = (char*)&pFunc[1];
    strcpy(pFunc->zScript, zScript);
    sqlite_create_function(pDb->db, zName, -1, tclSqlFunc, pFunc);
    sqlite_function_type(pDb->db, zName, SQLITE_NUMERIC);
    break;
  }

  /*
  **     $db last_insert_rowid 
  **
  ** Return an integer which is the ROWID for the most recent insert.
  */
  case DB_LAST_INSERT_ROWID: {
    Tcl_Obj *pResult;
    int rowid;
    if( objc!=2 ){
      Tcl_WrongNumArgs(interp, 2, objv, "");
      return TCL_ERROR;
    }
    rowid = sqlite_last_insert_rowid(pDb->db);
    pResult = Tcl_GetObjResult(interp);
    Tcl_SetIntObj(pResult, rowid);
    break;
  }

  /*
  **     $db onecolumn SQL
  **
  ** Return a single column from a single row of the given SQL query.
  */
  case DB_ONECOLUMN: {
    int rc;
    char *zSql;
    char *zErrMsg = 0;
    if( objc!=3 ){
      Tcl_WrongNumArgs(interp, 2, objv, "SQL");
      return TCL_ERROR;
    }
    zSql = Tcl_GetStringFromObj(objv[2], 0);
    rc = sqlite_exec(pDb->db, zSql, DbEvalCallback3, interp, &zErrMsg);
    if( rc==SQLITE_ABORT ){
      /* Do nothing.  This is normal. */
    }else if( zErrMsg ){
      Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
      free(zErrMsg);
      rc = TCL_ERROR;
    }else if( rc!=SQLITE_OK ){
      Tcl_AppendResult(interp, sqlite_error_string(rc), 0);
      rc = TCL_ERROR;
    }
    break;
  }

  /*
  **     $db timeout MILLESECONDS
  **
  ** Delay for the number of milliseconds specified when a file is locked.
  */
  case DB_TIMEOUT: {
    int ms;
    if( objc!=3 ){
      Tcl_WrongNumArgs(interp, 2, objv, "MILLISECONDS");
      return TCL_ERROR;
    }
    if( Tcl_GetIntFromObj(interp, objv[2], &ms) ) return TCL_ERROR;
    sqlite_busy_timeout(pDb->db, ms);
    break;
  }

  /*    $db trace ?CALLBACK?
  **
  ** Make arrangements to invoke the CALLBACK routine for each SQL statement
  ** that is executed.  The text of the SQL is appended to CALLBACK before
  ** it is executed.
  */
  case DB_TRACE: {
    if( objc>3 ){
      Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
    }else if( objc==2 ){
      if( pDb->zTrace ){
        Tcl_AppendResult(interp, pDb->zTrace, 0);
      }
    }else{
      char *zTrace;
      int len;
      if( pDb->zTrace ){
        Tcl_Free(pDb->zTrace);
      }
      zTrace = Tcl_GetStringFromObj(objv[2], &len);
      if( zTrace && len>0 ){
        pDb->zTrace = Tcl_Alloc( len + 1 );
        strcpy(pDb->zTrace, zTrace);
      }else{
        pDb->zTrace = 0;
      }
      if( pDb->zTrace ){
        pDb->interp = interp;
        sqlite_trace(pDb->db, DbTraceHandler, pDb);
      }else{
        sqlite_trace(pDb->db, 0, 0);
      }
    }
    break;
  }

  } /* End of the SWITCH statement */
  return TCL_OK;
}

/*
**   sqlite DBNAME FILENAME ?MODE?
**
** This is the main Tcl command.  When the "sqlite" Tcl command is
** invoked, this routine runs to process that command.
**
** The first argument, DBNAME, is an arbitrary name for a new
** database connection.  This command creates a new command named
** DBNAME that is used to control that connection.  The database
** connection is deleted when the DBNAME command is deleted.
**
** The second argument is the name of the directory that contains
** the sqlite database that is to be accessed.
**
** For testing purposes, we also support the following:
**
**  sqlite -encoding
**
**       Return the encoding used by LIKE and GLOB operators.  Choices
**       are UTF-8 and iso8859.
**
**  sqlite -version
**
**       Return the version number of the SQLite library.
**
**  sqlite -tcl-uses-utf
**
**       Return "1" if compiled with a Tcl uses UTF-8.  Return "0" if
**       not.  Used by tests to make sure the library was compiled 
**       correctly.
*/
static int DbMain(void *cd, Tcl_Interp *interp, int argc, char **argv){
  int mode;
  SqliteDb *p;
  char *zErrMsg;
  char zBuf[80];
  if( argc==2 ){
    if( strcmp(argv[1],"-encoding")==0 ){
      Tcl_AppendResult(interp,sqlite_encoding,0);
      return TCL_OK;
    }
    if( strcmp(argv[1],"-version")==0 ){
      Tcl_AppendResult(interp,sqlite_version,0);
      return TCL_OK;
    }
    if( strcmp(argv[1],"-tcl-uses-utf")==0 ){
#ifdef TCL_UTF_MAX
      Tcl_AppendResult(interp,"1",0);
#else
      Tcl_AppendResult(interp,"0",0);
#endif
      return TCL_OK;
    }
  }
  if( argc!=3 && argc!=4 ){
    Tcl_AppendResult(interp,"wrong # args: should be \"", argv[0],
       " HANDLE FILENAME ?MODE?\"", 0);
    return TCL_ERROR;
  }
  if( argc==3 ){
    mode = 0666;
  }else if( Tcl_GetInt(interp, argv[3], &mode)!=TCL_OK ){
    return TCL_ERROR;
  }
  zErrMsg = 0;
  p = (SqliteDb*)Tcl_Alloc( sizeof(*p) );
  if( p==0 ){
    Tcl_SetResult(interp, "malloc failed", TCL_STATIC);
    return TCL_ERROR;
  }
  memset(p, 0, sizeof(*p));
  p->db = sqlite_open(argv[2], mode, &zErrMsg);
  if( p->db==0 ){
    Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
    Tcl_Free((char*)p);
    free(zErrMsg);
    return TCL_ERROR;
  }
  Tcl_CreateObjCommand(interp, argv[1], DbObjCmd, (char*)p, DbDeleteCmd);

  /* The return value is the value of the sqlite* pointer
  */
  sprintf(zBuf, "%p", p->db);
  if( strncmp(zBuf,"0x",2) ){
    sprintf(zBuf, "0x%p", p->db);
  }
  Tcl_AppendResult(interp, zBuf, 0);

  /* If compiled with SQLITE_TEST turned on, then register the "md5sum"
  ** SQL function.
  */
#ifdef SQLITE_TEST
  {
    extern void Md5_Register(sqlite*);
    Md5_Register(p->db);
   }
#endif  
  return TCL_OK;
}

/*
** Provide a dummy Tcl_InitStubs if we are using this as a static
** library.
*/
#ifndef USE_TCL_STUBS
# undef  Tcl_InitStubs
# define Tcl_InitStubs(a,b,c)
#endif

/*
** Initialize this module.
**
** This Tcl module contains only a single new Tcl command named "sqlite".
** (Hence there is no namespace.  There is no point in using a namespace
** if the extension only supplies one new name!)  The "sqlite" command is
** used to open a new SQLite database.  See the DbMain() routine above
** for additional information.
*/
int Sqlite_Init(Tcl_Interp *interp){
  Tcl_InitStubs(interp, "8.0", 0);
  Tcl_CreateCommand(interp, "sqlite", (Tcl_CmdProc*)DbMain, 0, 0);
  Tcl_PkgProvide(interp, "sqlite", "2.0");
  return TCL_OK;
}
int Tclsqlite_Init(Tcl_Interp *interp){
  Tcl_InitStubs(interp, "8.0", 0);
  Tcl_CreateCommand(interp, "sqlite", (Tcl_CmdProc*)DbMain, 0, 0);
  Tcl_PkgProvide(interp, "sqlite", "2.0");
  return TCL_OK;
}
int Sqlite_SafeInit(Tcl_Interp *interp){
  return TCL_OK;
}
int Tclsqlite_SafeInit(Tcl_Interp *interp){
  return TCL_OK;
}

#if 0
/*
** If compiled using mktclapp, this routine runs to initialize
** everything.
*/
int Et_AppInit(Tcl_Interp *interp){
  return Sqlite_Init(interp);
}
#endif

/*
** If the macro TCLSH is defined and is one, then put in code for the
** "main" routine that will initialize Tcl.
*/
#if defined(TCLSH) && TCLSH==1
static char zMainloop[] =
  "set line {}\n"
  "while {![eof stdin]} {\n"
    "if {$line!=\"\"} {\n"
      "puts -nonewline \"> \"\n"
    "} else {\n"
      "puts -nonewline \"% \"\n"
    "}\n"
    "flush stdout\n"
    "append line [gets stdin]\n"
    "if {[info complete $line]} {\n"
      "if {[catch {uplevel #0 $line} result]} {\n"
        "puts stderr \"Error: $result\"\n"
      "} elseif {$result!=\"\"} {\n"
        "puts $result\n"
      "}\n"
      "set line {}\n"
    "} else {\n"
      "append line \\n\n"
    "}\n"
  "}\n"
;

#define TCLSH_MAIN main   /* Needed to fake out mktclapp */
int TCLSH_MAIN(int argc, char **argv){
  Tcl_Interp *interp;
  Tcl_FindExecutable(argv[0]);
  interp = Tcl_CreateInterp();
  Sqlite_Init(interp);
#ifdef SQLITE_TEST
  {
    extern int Sqlitetest1_Init(Tcl_Interp*);
    extern int Sqlitetest2_Init(Tcl_Interp*);
    extern int Sqlitetest3_Init(Tcl_Interp*);
    extern int Md5_Init(Tcl_Interp*);
    Sqlitetest1_Init(interp);
    Sqlitetest2_Init(interp);
    Sqlitetest3_Init(interp);
    Md5_Init(interp);
  }
#endif
  if( argc>=2 ){
    int i;
    Tcl_SetVar(interp,"argv0",argv[1],TCL_GLOBAL_ONLY);
    Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY);
    for(i=2; i<argc; i++){
      Tcl_SetVar(interp, "argv", argv[i],
          TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE);
    }
    if( Tcl_EvalFile(interp, argv[1])!=TCL_OK ){
      const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
      if( zInfo==0 ) zInfo = interp->result;
      fprintf(stderr,"%s: %s\n", *argv, zInfo);
      return 1;
    }
  }else{
    Tcl_GlobalEval(interp, zMainloop);
  }
  return 0;
}
#endif /* TCLSH */

#endif /* !defined(NO_TCL) */