1 /* 2 ** 2001 September 15 3 ** 4 ** The author disclaims copyright to this source code. In place of 5 ** a legal notice, here is a blessing: 6 ** 7 ** May you do good and not evil. 8 ** May you find forgiveness for yourself and forgive others. 9 ** May you share freely, never taking more than you give. 10 ** 11 ************************************************************************* 12 ** A TCL Interface to SQLite 13 ** 14 ** $Id: tclsqlite.c,v 1.176 2007/02/01 01:53:44 drh Exp $ 15 */ 16 #ifndef NO_TCL /* Omit this whole file if TCL is unavailable */ 17 18 #include "sqliteInt.h" 19 #include "hash.h" 20 #include "tcl.h" 21 #include <stdlib.h> 22 #include <string.h> 23 #include <assert.h> 24 #include <ctype.h> 25 26 /* 27 * Windows needs to know which symbols to export. Unix does not. 28 * BUILD_sqlite should be undefined for Unix. 29 */ 30 #ifdef BUILD_sqlite 31 #undef TCL_STORAGE_CLASS 32 #define TCL_STORAGE_CLASS DLLEXPORT 33 #endif /* BUILD_sqlite */ 34 35 #define NUM_PREPARED_STMTS 10 36 #define MAX_PREPARED_STMTS 100 37 38 /* 39 ** If TCL uses UTF-8 and SQLite is configured to use iso8859, then we 40 ** have to do a translation when going between the two. Set the 41 ** UTF_TRANSLATION_NEEDED macro to indicate that we need to do 42 ** this translation. 43 */ 44 #if defined(TCL_UTF_MAX) && !defined(SQLITE_UTF8) 45 # define UTF_TRANSLATION_NEEDED 1 46 #endif 47 48 /* 49 ** New SQL functions can be created as TCL scripts. Each such function 50 ** is described by an instance of the following structure. 51 */ 52 typedef struct SqlFunc SqlFunc; 53 struct SqlFunc { 54 Tcl_Interp *interp; /* The TCL interpret to execute the function */ 55 Tcl_Obj *pScript; /* The Tcl_Obj representation of the script */ 56 int useEvalObjv; /* True if it is safe to use Tcl_EvalObjv */ 57 char *zName; /* Name of this function */ 58 SqlFunc *pNext; /* Next function on the list of them all */ 59 }; 60 61 /* 62 ** New collation sequences function can be created as TCL scripts. Each such 63 ** function is described by an instance of the following structure. 64 */ 65 typedef struct SqlCollate SqlCollate; 66 struct SqlCollate { 67 Tcl_Interp *interp; /* The TCL interpret to execute the function */ 68 char *zScript; /* The script to be run */ 69 SqlCollate *pNext; /* Next function on the list of them all */ 70 }; 71 72 /* 73 ** Prepared statements are cached for faster execution. Each prepared 74 ** statement is described by an instance of the following structure. 75 */ 76 typedef struct SqlPreparedStmt SqlPreparedStmt; 77 struct SqlPreparedStmt { 78 SqlPreparedStmt *pNext; /* Next in linked list */ 79 SqlPreparedStmt *pPrev; /* Previous on the list */ 80 sqlite3_stmt *pStmt; /* The prepared statement */ 81 int nSql; /* chars in zSql[] */ 82 char zSql[1]; /* Text of the SQL statement */ 83 }; 84 85 /* 86 ** There is one instance of this structure for each SQLite database 87 ** that has been opened by the SQLite TCL interface. 88 */ 89 typedef struct SqliteDb SqliteDb; 90 struct SqliteDb { 91 sqlite3 *db; /* The "real" database structure. MUST BE FIRST */ 92 Tcl_Interp *interp; /* The interpreter used for this database */ 93 char *zBusy; /* The busy callback routine */ 94 char *zCommit; /* The commit hook callback routine */ 95 char *zTrace; /* The trace callback routine */ 96 char *zProfile; /* The profile callback routine */ 97 char *zProgress; /* The progress callback routine */ 98 char *zAuth; /* The authorization callback routine */ 99 char *zNull; /* Text to substitute for an SQL NULL value */ 100 SqlFunc *pFunc; /* List of SQL functions */ 101 Tcl_Obj *pUpdateHook; /* Update hook script (if any) */ 102 Tcl_Obj *pRollbackHook; /* Rollback hook script (if any) */ 103 SqlCollate *pCollate; /* List of SQL collation functions */ 104 int rc; /* Return code of most recent sqlite3_exec() */ 105 Tcl_Obj *pCollateNeeded; /* Collation needed script */ 106 SqlPreparedStmt *stmtList; /* List of prepared statements*/ 107 SqlPreparedStmt *stmtLast; /* Last statement in the list */ 108 int maxStmt; /* The next maximum number of stmtList */ 109 int nStmt; /* Number of statements in stmtList */ 110 }; 111 112 /* 113 ** Look at the script prefix in pCmd. We will be executing this script 114 ** after first appending one or more arguments. This routine analyzes 115 ** the script to see if it is safe to use Tcl_EvalObjv() on the script 116 ** rather than the more general Tcl_EvalEx(). Tcl_EvalObjv() is much 117 ** faster. 118 ** 119 ** Scripts that are safe to use with Tcl_EvalObjv() consists of a 120 ** command name followed by zero or more arguments with no [...] or $ 121 ** or {...} or ; to be seen anywhere. Most callback scripts consist 122 ** of just a single procedure name and they meet this requirement. 123 */ 124 static int safeToUseEvalObjv(Tcl_Interp *interp, Tcl_Obj *pCmd){ 125 /* We could try to do something with Tcl_Parse(). But we will instead 126 ** just do a search for forbidden characters. If any of the forbidden 127 ** characters appear in pCmd, we will report the string as unsafe. 128 */ 129 const char *z; 130 int n; 131 z = Tcl_GetStringFromObj(pCmd, &n); 132 while( n-- > 0 ){ 133 int c = *(z++); 134 if( c=='$' || c=='[' || c==';' ) return 0; 135 } 136 return 1; 137 } 138 139 /* 140 ** Find an SqlFunc structure with the given name. Or create a new 141 ** one if an existing one cannot be found. Return a pointer to the 142 ** structure. 143 */ 144 static SqlFunc *findSqlFunc(SqliteDb *pDb, const char *zName){ 145 SqlFunc *p, *pNew; 146 int i; 147 pNew = (SqlFunc*)Tcl_Alloc( sizeof(*pNew) + strlen(zName) + 1 ); 148 pNew->zName = (char*)&pNew[1]; 149 for(i=0; zName[i]; i++){ pNew->zName[i] = tolower(zName[i]); } 150 pNew->zName[i] = 0; 151 for(p=pDb->pFunc; p; p=p->pNext){ 152 if( strcmp(p->zName, pNew->zName)==0 ){ 153 Tcl_Free((char*)pNew); 154 return p; 155 } 156 } 157 pNew->interp = pDb->interp; 158 pNew->pScript = 0; 159 pNew->pNext = pDb->pFunc; 160 pDb->pFunc = pNew; 161 return pNew; 162 } 163 164 /* 165 ** Finalize and free a list of prepared statements 166 */ 167 static void flushStmtCache( SqliteDb *pDb ){ 168 SqlPreparedStmt *pPreStmt; 169 170 while( pDb->stmtList ){ 171 sqlite3_finalize( pDb->stmtList->pStmt ); 172 pPreStmt = pDb->stmtList; 173 pDb->stmtList = pDb->stmtList->pNext; 174 Tcl_Free( (char*)pPreStmt ); 175 } 176 pDb->nStmt = 0; 177 pDb->stmtLast = 0; 178 } 179 180 /* 181 ** TCL calls this procedure when an sqlite3 database command is 182 ** deleted. 183 */ 184 static void DbDeleteCmd(void *db){ 185 SqliteDb *pDb = (SqliteDb*)db; 186 flushStmtCache(pDb); 187 sqlite3_close(pDb->db); 188 while( pDb->pFunc ){ 189 SqlFunc *pFunc = pDb->pFunc; 190 pDb->pFunc = pFunc->pNext; 191 Tcl_DecrRefCount(pFunc->pScript); 192 Tcl_Free((char*)pFunc); 193 } 194 while( pDb->pCollate ){ 195 SqlCollate *pCollate = pDb->pCollate; 196 pDb->pCollate = pCollate->pNext; 197 Tcl_Free((char*)pCollate); 198 } 199 if( pDb->zBusy ){ 200 Tcl_Free(pDb->zBusy); 201 } 202 if( pDb->zTrace ){ 203 Tcl_Free(pDb->zTrace); 204 } 205 if( pDb->zProfile ){ 206 Tcl_Free(pDb->zProfile); 207 } 208 if( pDb->zAuth ){ 209 Tcl_Free(pDb->zAuth); 210 } 211 if( pDb->zNull ){ 212 Tcl_Free(pDb->zNull); 213 } 214 if( pDb->pUpdateHook ){ 215 Tcl_DecrRefCount(pDb->pUpdateHook); 216 } 217 if( pDb->pRollbackHook ){ 218 Tcl_DecrRefCount(pDb->pRollbackHook); 219 } 220 if( pDb->pCollateNeeded ){ 221 Tcl_DecrRefCount(pDb->pCollateNeeded); 222 } 223 Tcl_Free((char*)pDb); 224 } 225 226 /* 227 ** This routine is called when a database file is locked while trying 228 ** to execute SQL. 229 */ 230 static int DbBusyHandler(void *cd, int nTries){ 231 SqliteDb *pDb = (SqliteDb*)cd; 232 int rc; 233 char zVal[30]; 234 235 sprintf(zVal, "%d", nTries); 236 rc = Tcl_VarEval(pDb->interp, pDb->zBusy, " ", zVal, (char*)0); 237 if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){ 238 return 0; 239 } 240 return 1; 241 } 242 243 /* 244 ** This routine is invoked as the 'progress callback' for the database. 245 */ 246 static int DbProgressHandler(void *cd){ 247 SqliteDb *pDb = (SqliteDb*)cd; 248 int rc; 249 250 assert( pDb->zProgress ); 251 rc = Tcl_Eval(pDb->interp, pDb->zProgress); 252 if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){ 253 return 1; 254 } 255 return 0; 256 } 257 258 #ifndef SQLITE_OMIT_TRACE 259 /* 260 ** This routine is called by the SQLite trace handler whenever a new 261 ** block of SQL is executed. The TCL script in pDb->zTrace is executed. 262 */ 263 static void DbTraceHandler(void *cd, const char *zSql){ 264 SqliteDb *pDb = (SqliteDb*)cd; 265 Tcl_DString str; 266 267 Tcl_DStringInit(&str); 268 Tcl_DStringAppend(&str, pDb->zTrace, -1); 269 Tcl_DStringAppendElement(&str, zSql); 270 Tcl_Eval(pDb->interp, Tcl_DStringValue(&str)); 271 Tcl_DStringFree(&str); 272 Tcl_ResetResult(pDb->interp); 273 } 274 #endif 275 276 #ifndef SQLITE_OMIT_TRACE 277 /* 278 ** This routine is called by the SQLite profile handler after a statement 279 ** SQL has executed. The TCL script in pDb->zProfile is evaluated. 280 */ 281 static void DbProfileHandler(void *cd, const char *zSql, sqlite_uint64 tm){ 282 SqliteDb *pDb = (SqliteDb*)cd; 283 Tcl_DString str; 284 char zTm[100]; 285 286 sqlite3_snprintf(sizeof(zTm)-1, zTm, "%lld", tm); 287 Tcl_DStringInit(&str); 288 Tcl_DStringAppend(&str, pDb->zProfile, -1); 289 Tcl_DStringAppendElement(&str, zSql); 290 Tcl_DStringAppendElement(&str, zTm); 291 Tcl_Eval(pDb->interp, Tcl_DStringValue(&str)); 292 Tcl_DStringFree(&str); 293 Tcl_ResetResult(pDb->interp); 294 } 295 #endif 296 297 /* 298 ** This routine is called when a transaction is committed. The 299 ** TCL script in pDb->zCommit is executed. If it returns non-zero or 300 ** if it throws an exception, the transaction is rolled back instead 301 ** of being committed. 302 */ 303 static int DbCommitHandler(void *cd){ 304 SqliteDb *pDb = (SqliteDb*)cd; 305 int rc; 306 307 rc = Tcl_Eval(pDb->interp, pDb->zCommit); 308 if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){ 309 return 1; 310 } 311 return 0; 312 } 313 314 static void DbRollbackHandler(void *clientData){ 315 SqliteDb *pDb = (SqliteDb*)clientData; 316 assert(pDb->pRollbackHook); 317 if( TCL_OK!=Tcl_EvalObjEx(pDb->interp, pDb->pRollbackHook, 0) ){ 318 Tcl_BackgroundError(pDb->interp); 319 } 320 } 321 322 static void DbUpdateHandler( 323 void *p, 324 int op, 325 const char *zDb, 326 const char *zTbl, 327 sqlite_int64 rowid 328 ){ 329 SqliteDb *pDb = (SqliteDb *)p; 330 Tcl_Obj *pCmd; 331 332 assert( pDb->pUpdateHook ); 333 assert( op==SQLITE_INSERT || op==SQLITE_UPDATE || op==SQLITE_DELETE ); 334 335 pCmd = Tcl_DuplicateObj(pDb->pUpdateHook); 336 Tcl_IncrRefCount(pCmd); 337 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj( 338 ( (op==SQLITE_INSERT)?"INSERT":(op==SQLITE_UPDATE)?"UPDATE":"DELETE"), -1)); 339 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zDb, -1)); 340 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewStringObj(zTbl, -1)); 341 Tcl_ListObjAppendElement(0, pCmd, Tcl_NewWideIntObj(rowid)); 342 Tcl_EvalObjEx(pDb->interp, pCmd, TCL_EVAL_DIRECT); 343 } 344 345 static void tclCollateNeeded( 346 void *pCtx, 347 sqlite3 *db, 348 int enc, 349 const char *zName 350 ){ 351 SqliteDb *pDb = (SqliteDb *)pCtx; 352 Tcl_Obj *pScript = Tcl_DuplicateObj(pDb->pCollateNeeded); 353 Tcl_IncrRefCount(pScript); 354 Tcl_ListObjAppendElement(0, pScript, Tcl_NewStringObj(zName, -1)); 355 Tcl_EvalObjEx(pDb->interp, pScript, 0); 356 Tcl_DecrRefCount(pScript); 357 } 358 359 /* 360 ** This routine is called to evaluate an SQL collation function implemented 361 ** using TCL script. 362 */ 363 static int tclSqlCollate( 364 void *pCtx, 365 int nA, 366 const void *zA, 367 int nB, 368 const void *zB 369 ){ 370 SqlCollate *p = (SqlCollate *)pCtx; 371 Tcl_Obj *pCmd; 372 373 pCmd = Tcl_NewStringObj(p->zScript, -1); 374 Tcl_IncrRefCount(pCmd); 375 Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zA, nA)); 376 Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zB, nB)); 377 Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT); 378 Tcl_DecrRefCount(pCmd); 379 return (atoi(Tcl_GetStringResult(p->interp))); 380 } 381 382 /* 383 ** This routine is called to evaluate an SQL function implemented 384 ** using TCL script. 385 */ 386 static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){ 387 SqlFunc *p = sqlite3_user_data(context); 388 Tcl_Obj *pCmd; 389 int i; 390 int rc; 391 392 if( argc==0 ){ 393 /* If there are no arguments to the function, call Tcl_EvalObjEx on the 394 ** script object directly. This allows the TCL compiler to generate 395 ** bytecode for the command on the first invocation and thus make 396 ** subsequent invocations much faster. */ 397 pCmd = p->pScript; 398 Tcl_IncrRefCount(pCmd); 399 rc = Tcl_EvalObjEx(p->interp, pCmd, 0); 400 Tcl_DecrRefCount(pCmd); 401 }else{ 402 /* If there are arguments to the function, make a shallow copy of the 403 ** script object, lappend the arguments, then evaluate the copy. 404 ** 405 ** By "shallow" copy, we mean a only the outer list Tcl_Obj is duplicated. 406 ** The new Tcl_Obj contains pointers to the original list elements. 407 ** That way, when Tcl_EvalObjv() is run and shimmers the first element 408 ** of the list to tclCmdNameType, that alternate representation will 409 ** be preserved and reused on the next invocation. 410 */ 411 Tcl_Obj **aArg; 412 int nArg; 413 if( Tcl_ListObjGetElements(p->interp, p->pScript, &nArg, &aArg) ){ 414 sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1); 415 return; 416 } 417 pCmd = Tcl_NewListObj(nArg, aArg); 418 Tcl_IncrRefCount(pCmd); 419 for(i=0; i<argc; i++){ 420 sqlite3_value *pIn = argv[i]; 421 Tcl_Obj *pVal; 422 423 /* Set pVal to contain the i'th column of this row. */ 424 switch( sqlite3_value_type(pIn) ){ 425 case SQLITE_BLOB: { 426 int bytes = sqlite3_value_bytes(pIn); 427 pVal = Tcl_NewByteArrayObj(sqlite3_value_blob(pIn), bytes); 428 break; 429 } 430 case SQLITE_INTEGER: { 431 sqlite_int64 v = sqlite3_value_int64(pIn); 432 if( v>=-2147483647 && v<=2147483647 ){ 433 pVal = Tcl_NewIntObj(v); 434 }else{ 435 pVal = Tcl_NewWideIntObj(v); 436 } 437 break; 438 } 439 case SQLITE_FLOAT: { 440 double r = sqlite3_value_double(pIn); 441 pVal = Tcl_NewDoubleObj(r); 442 break; 443 } 444 case SQLITE_NULL: { 445 pVal = Tcl_NewStringObj("", 0); 446 break; 447 } 448 default: { 449 int bytes = sqlite3_value_bytes(pIn); 450 pVal = Tcl_NewStringObj((char *)sqlite3_value_text(pIn), bytes); 451 break; 452 } 453 } 454 rc = Tcl_ListObjAppendElement(p->interp, pCmd, pVal); 455 if( rc ){ 456 Tcl_DecrRefCount(pCmd); 457 sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1); 458 return; 459 } 460 } 461 if( !p->useEvalObjv ){ 462 /* Tcl_EvalObjEx() will automatically call Tcl_EvalObjv() if pCmd 463 ** is a list without a string representation. To prevent this from 464 ** happening, make sure pCmd has a valid string representation */ 465 Tcl_GetString(pCmd); 466 } 467 rc = Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT); 468 Tcl_DecrRefCount(pCmd); 469 } 470 471 if( rc && rc!=TCL_RETURN ){ 472 sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1); 473 }else{ 474 Tcl_Obj *pVar = Tcl_GetObjResult(p->interp); 475 int n; 476 u8 *data; 477 char *zType = pVar->typePtr ? pVar->typePtr->name : ""; 478 char c = zType[0]; 479 if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){ 480 /* Only return a BLOB type if the Tcl variable is a bytearray and 481 ** has no string representation. */ 482 data = Tcl_GetByteArrayFromObj(pVar, &n); 483 sqlite3_result_blob(context, data, n, SQLITE_TRANSIENT); 484 }else if( (c=='b' && strcmp(zType,"boolean")==0) || 485 (c=='i' && strcmp(zType,"int")==0) ){ 486 Tcl_GetIntFromObj(0, pVar, &n); 487 sqlite3_result_int(context, n); 488 }else if( c=='d' && strcmp(zType,"double")==0 ){ 489 double r; 490 Tcl_GetDoubleFromObj(0, pVar, &r); 491 sqlite3_result_double(context, r); 492 }else if( c=='w' && strcmp(zType,"wideInt")==0 ){ 493 Tcl_WideInt v; 494 Tcl_GetWideIntFromObj(0, pVar, &v); 495 sqlite3_result_int64(context, v); 496 }else{ 497 data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n); 498 sqlite3_result_text(context, (char *)data, n, SQLITE_TRANSIENT); 499 } 500 } 501 } 502 503 #ifndef SQLITE_OMIT_AUTHORIZATION 504 /* 505 ** This is the authentication function. It appends the authentication 506 ** type code and the two arguments to zCmd[] then invokes the result 507 ** on the interpreter. The reply is examined to determine if the 508 ** authentication fails or succeeds. 509 */ 510 static int auth_callback( 511 void *pArg, 512 int code, 513 const char *zArg1, 514 const char *zArg2, 515 const char *zArg3, 516 const char *zArg4 517 ){ 518 char *zCode; 519 Tcl_DString str; 520 int rc; 521 const char *zReply; 522 SqliteDb *pDb = (SqliteDb*)pArg; 523 524 switch( code ){ 525 case SQLITE_COPY : zCode="SQLITE_COPY"; break; 526 case SQLITE_CREATE_INDEX : zCode="SQLITE_CREATE_INDEX"; break; 527 case SQLITE_CREATE_TABLE : zCode="SQLITE_CREATE_TABLE"; break; 528 case SQLITE_CREATE_TEMP_INDEX : zCode="SQLITE_CREATE_TEMP_INDEX"; break; 529 case SQLITE_CREATE_TEMP_TABLE : zCode="SQLITE_CREATE_TEMP_TABLE"; break; 530 case SQLITE_CREATE_TEMP_TRIGGER: zCode="SQLITE_CREATE_TEMP_TRIGGER"; break; 531 case SQLITE_CREATE_TEMP_VIEW : zCode="SQLITE_CREATE_TEMP_VIEW"; break; 532 case SQLITE_CREATE_TRIGGER : zCode="SQLITE_CREATE_TRIGGER"; break; 533 case SQLITE_CREATE_VIEW : zCode="SQLITE_CREATE_VIEW"; break; 534 case SQLITE_DELETE : zCode="SQLITE_DELETE"; break; 535 case SQLITE_DROP_INDEX : zCode="SQLITE_DROP_INDEX"; break; 536 case SQLITE_DROP_TABLE : zCode="SQLITE_DROP_TABLE"; break; 537 case SQLITE_DROP_TEMP_INDEX : zCode="SQLITE_DROP_TEMP_INDEX"; break; 538 case SQLITE_DROP_TEMP_TABLE : zCode="SQLITE_DROP_TEMP_TABLE"; break; 539 case SQLITE_DROP_TEMP_TRIGGER : zCode="SQLITE_DROP_TEMP_TRIGGER"; break; 540 case SQLITE_DROP_TEMP_VIEW : zCode="SQLITE_DROP_TEMP_VIEW"; break; 541 case SQLITE_DROP_TRIGGER : zCode="SQLITE_DROP_TRIGGER"; break; 542 case SQLITE_DROP_VIEW : zCode="SQLITE_DROP_VIEW"; break; 543 case SQLITE_INSERT : zCode="SQLITE_INSERT"; break; 544 case SQLITE_PRAGMA : zCode="SQLITE_PRAGMA"; break; 545 case SQLITE_READ : zCode="SQLITE_READ"; break; 546 case SQLITE_SELECT : zCode="SQLITE_SELECT"; break; 547 case SQLITE_TRANSACTION : zCode="SQLITE_TRANSACTION"; break; 548 case SQLITE_UPDATE : zCode="SQLITE_UPDATE"; break; 549 case SQLITE_ATTACH : zCode="SQLITE_ATTACH"; break; 550 case SQLITE_DETACH : zCode="SQLITE_DETACH"; break; 551 case SQLITE_ALTER_TABLE : zCode="SQLITE_ALTER_TABLE"; break; 552 case SQLITE_REINDEX : zCode="SQLITE_REINDEX"; break; 553 case SQLITE_ANALYZE : zCode="SQLITE_ANALYZE"; break; 554 case SQLITE_CREATE_VTABLE : zCode="SQLITE_CREATE_VTABLE"; break; 555 case SQLITE_DROP_VTABLE : zCode="SQLITE_DROP_VTABLE"; break; 556 case SQLITE_FUNCTION : zCode="SQLITE_FUNCTION"; break; 557 default : zCode="????"; break; 558 } 559 Tcl_DStringInit(&str); 560 Tcl_DStringAppend(&str, pDb->zAuth, -1); 561 Tcl_DStringAppendElement(&str, zCode); 562 Tcl_DStringAppendElement(&str, zArg1 ? zArg1 : ""); 563 Tcl_DStringAppendElement(&str, zArg2 ? zArg2 : ""); 564 Tcl_DStringAppendElement(&str, zArg3 ? zArg3 : ""); 565 Tcl_DStringAppendElement(&str, zArg4 ? zArg4 : ""); 566 rc = Tcl_GlobalEval(pDb->interp, Tcl_DStringValue(&str)); 567 Tcl_DStringFree(&str); 568 zReply = Tcl_GetStringResult(pDb->interp); 569 if( strcmp(zReply,"SQLITE_OK")==0 ){ 570 rc = SQLITE_OK; 571 }else if( strcmp(zReply,"SQLITE_DENY")==0 ){ 572 rc = SQLITE_DENY; 573 }else if( strcmp(zReply,"SQLITE_IGNORE")==0 ){ 574 rc = SQLITE_IGNORE; 575 }else{ 576 rc = 999; 577 } 578 return rc; 579 } 580 #endif /* SQLITE_OMIT_AUTHORIZATION */ 581 582 /* 583 ** zText is a pointer to text obtained via an sqlite3_result_text() 584 ** or similar interface. This routine returns a Tcl string object, 585 ** reference count set to 0, containing the text. If a translation 586 ** between iso8859 and UTF-8 is required, it is preformed. 587 */ 588 static Tcl_Obj *dbTextToObj(char const *zText){ 589 Tcl_Obj *pVal; 590 #ifdef UTF_TRANSLATION_NEEDED 591 Tcl_DString dCol; 592 Tcl_DStringInit(&dCol); 593 Tcl_ExternalToUtfDString(NULL, zText, -1, &dCol); 594 pVal = Tcl_NewStringObj(Tcl_DStringValue(&dCol), -1); 595 Tcl_DStringFree(&dCol); 596 #else 597 pVal = Tcl_NewStringObj(zText, -1); 598 #endif 599 return pVal; 600 } 601 602 /* 603 ** This routine reads a line of text from FILE in, stores 604 ** the text in memory obtained from malloc() and returns a pointer 605 ** to the text. NULL is returned at end of file, or if malloc() 606 ** fails. 607 ** 608 ** The interface is like "readline" but no command-line editing 609 ** is done. 610 ** 611 ** copied from shell.c from '.import' command 612 */ 613 static char *local_getline(char *zPrompt, FILE *in){ 614 char *zLine; 615 int nLine; 616 int n; 617 int eol; 618 619 nLine = 100; 620 zLine = malloc( nLine ); 621 if( zLine==0 ) return 0; 622 n = 0; 623 eol = 0; 624 while( !eol ){ 625 if( n+100>nLine ){ 626 nLine = nLine*2 + 100; 627 zLine = realloc(zLine, nLine); 628 if( zLine==0 ) return 0; 629 } 630 if( fgets(&zLine[n], nLine - n, in)==0 ){ 631 if( n==0 ){ 632 free(zLine); 633 return 0; 634 } 635 zLine[n] = 0; 636 eol = 1; 637 break; 638 } 639 while( zLine[n] ){ n++; } 640 if( n>0 && zLine[n-1]=='\n' ){ 641 n--; 642 zLine[n] = 0; 643 eol = 1; 644 } 645 } 646 zLine = realloc( zLine, n+1 ); 647 return zLine; 648 } 649 650 /* 651 ** The "sqlite" command below creates a new Tcl command for each 652 ** connection it opens to an SQLite database. This routine is invoked 653 ** whenever one of those connection-specific commands is executed 654 ** in Tcl. For example, if you run Tcl code like this: 655 ** 656 ** sqlite3 db1 "my_database" 657 ** db1 close 658 ** 659 ** The first command opens a connection to the "my_database" database 660 ** and calls that connection "db1". The second command causes this 661 ** subroutine to be invoked. 662 */ 663 static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){ 664 SqliteDb *pDb = (SqliteDb*)cd; 665 int choice; 666 int rc = TCL_OK; 667 static const char *DB_strs[] = { 668 "authorizer", "busy", "cache", 669 "changes", "close", "collate", 670 "collation_needed", "commit_hook", "complete", 671 "copy", "enable_load_extension","errorcode", 672 "eval", "exists", "function", 673 "interrupt", "last_insert_rowid", "nullvalue", 674 "onecolumn", "profile", "progress", 675 "rekey", "rollback_hook", "timeout", 676 "total_changes", "trace", "transaction", 677 "update_hook", "version", 0 678 }; 679 enum DB_enum { 680 DB_AUTHORIZER, DB_BUSY, DB_CACHE, 681 DB_CHANGES, DB_CLOSE, DB_COLLATE, 682 DB_COLLATION_NEEDED, DB_COMMIT_HOOK, DB_COMPLETE, 683 DB_COPY, DB_ENABLE_LOAD_EXTENSION,DB_ERRORCODE, 684 DB_EVAL, DB_EXISTS, DB_FUNCTION, 685 DB_INTERRUPT, DB_LAST_INSERT_ROWID,DB_NULLVALUE, 686 DB_ONECOLUMN, DB_PROFILE, DB_PROGRESS, 687 DB_REKEY, DB_ROLLBACK_HOOK, DB_TIMEOUT, 688 DB_TOTAL_CHANGES, DB_TRACE, DB_TRANSACTION, 689 DB_UPDATE_HOOK, DB_VERSION, 690 }; 691 /* don't leave trailing commas on DB_enum, it confuses the AIX xlc compiler */ 692 693 if( objc<2 ){ 694 Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ..."); 695 return TCL_ERROR; 696 } 697 if( Tcl_GetIndexFromObj(interp, objv[1], DB_strs, "option", 0, &choice) ){ 698 return TCL_ERROR; 699 } 700 701 switch( (enum DB_enum)choice ){ 702 703 /* $db authorizer ?CALLBACK? 704 ** 705 ** Invoke the given callback to authorize each SQL operation as it is 706 ** compiled. 5 arguments are appended to the callback before it is 707 ** invoked: 708 ** 709 ** (1) The authorization type (ex: SQLITE_CREATE_TABLE, SQLITE_INSERT, ...) 710 ** (2) First descriptive name (depends on authorization type) 711 ** (3) Second descriptive name 712 ** (4) Name of the database (ex: "main", "temp") 713 ** (5) Name of trigger that is doing the access 714 ** 715 ** The callback should return on of the following strings: SQLITE_OK, 716 ** SQLITE_IGNORE, or SQLITE_DENY. Any other return value is an error. 717 ** 718 ** If this method is invoked with no arguments, the current authorization 719 ** callback string is returned. 720 */ 721 case DB_AUTHORIZER: { 722 #ifdef SQLITE_OMIT_AUTHORIZATION 723 Tcl_AppendResult(interp, "authorization not available in this build", 0); 724 return TCL_ERROR; 725 #else 726 if( objc>3 ){ 727 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); 728 return TCL_ERROR; 729 }else if( objc==2 ){ 730 if( pDb->zAuth ){ 731 Tcl_AppendResult(interp, pDb->zAuth, 0); 732 } 733 }else{ 734 char *zAuth; 735 int len; 736 if( pDb->zAuth ){ 737 Tcl_Free(pDb->zAuth); 738 } 739 zAuth = Tcl_GetStringFromObj(objv[2], &len); 740 if( zAuth && len>0 ){ 741 pDb->zAuth = Tcl_Alloc( len + 1 ); 742 strcpy(pDb->zAuth, zAuth); 743 }else{ 744 pDb->zAuth = 0; 745 } 746 if( pDb->zAuth ){ 747 pDb->interp = interp; 748 sqlite3_set_authorizer(pDb->db, auth_callback, pDb); 749 }else{ 750 sqlite3_set_authorizer(pDb->db, 0, 0); 751 } 752 } 753 #endif 754 break; 755 } 756 757 /* $db busy ?CALLBACK? 758 ** 759 ** Invoke the given callback if an SQL statement attempts to open 760 ** a locked database file. 761 */ 762 case DB_BUSY: { 763 if( objc>3 ){ 764 Tcl_WrongNumArgs(interp, 2, objv, "CALLBACK"); 765 return TCL_ERROR; 766 }else if( objc==2 ){ 767 if( pDb->zBusy ){ 768 Tcl_AppendResult(interp, pDb->zBusy, 0); 769 } 770 }else{ 771 char *zBusy; 772 int len; 773 if( pDb->zBusy ){ 774 Tcl_Free(pDb->zBusy); 775 } 776 zBusy = Tcl_GetStringFromObj(objv[2], &len); 777 if( zBusy && len>0 ){ 778 pDb->zBusy = Tcl_Alloc( len + 1 ); 779 strcpy(pDb->zBusy, zBusy); 780 }else{ 781 pDb->zBusy = 0; 782 } 783 if( pDb->zBusy ){ 784 pDb->interp = interp; 785 sqlite3_busy_handler(pDb->db, DbBusyHandler, pDb); 786 }else{ 787 sqlite3_busy_handler(pDb->db, 0, 0); 788 } 789 } 790 break; 791 } 792 793 /* $db cache flush 794 ** $db cache size n 795 ** 796 ** Flush the prepared statement cache, or set the maximum number of 797 ** cached statements. 798 */ 799 case DB_CACHE: { 800 char *subCmd; 801 int n; 802 803 if( objc<=2 ){ 804 Tcl_WrongNumArgs(interp, 1, objv, "cache option ?arg?"); 805 return TCL_ERROR; 806 } 807 subCmd = Tcl_GetStringFromObj( objv[2], 0 ); 808 if( *subCmd=='f' && strcmp(subCmd,"flush")==0 ){ 809 if( objc!=3 ){ 810 Tcl_WrongNumArgs(interp, 2, objv, "flush"); 811 return TCL_ERROR; 812 }else{ 813 flushStmtCache( pDb ); 814 } 815 }else if( *subCmd=='s' && strcmp(subCmd,"size")==0 ){ 816 if( objc!=4 ){ 817 Tcl_WrongNumArgs(interp, 2, objv, "size n"); 818 return TCL_ERROR; 819 }else{ 820 if( TCL_ERROR==Tcl_GetIntFromObj(interp, objv[3], &n) ){ 821 Tcl_AppendResult( interp, "cannot convert \"", 822 Tcl_GetStringFromObj(objv[3],0), "\" to integer", 0); 823 return TCL_ERROR; 824 }else{ 825 if( n<0 ){ 826 flushStmtCache( pDb ); 827 n = 0; 828 }else if( n>MAX_PREPARED_STMTS ){ 829 n = MAX_PREPARED_STMTS; 830 } 831 pDb->maxStmt = n; 832 } 833 } 834 }else{ 835 Tcl_AppendResult( interp, "bad option \"", 836 Tcl_GetStringFromObj(objv[0],0), "\": must be flush or size", 0); 837 return TCL_ERROR; 838 } 839 break; 840 } 841 842 /* $db changes 843 ** 844 ** Return the number of rows that were modified, inserted, or deleted by 845 ** the most recent INSERT, UPDATE or DELETE statement, not including 846 ** any changes made by trigger programs. 847 */ 848 case DB_CHANGES: { 849 Tcl_Obj *pResult; 850 if( objc!=2 ){ 851 Tcl_WrongNumArgs(interp, 2, objv, ""); 852 return TCL_ERROR; 853 } 854 pResult = Tcl_GetObjResult(interp); 855 Tcl_SetIntObj(pResult, sqlite3_changes(pDb->db)); 856 break; 857 } 858 859 /* $db close 860 ** 861 ** Shutdown the database 862 */ 863 case DB_CLOSE: { 864 Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], 0)); 865 break; 866 } 867 868 /* 869 ** $db collate NAME SCRIPT 870 ** 871 ** Create a new SQL collation function called NAME. Whenever 872 ** that function is called, invoke SCRIPT to evaluate the function. 873 */ 874 case DB_COLLATE: { 875 SqlCollate *pCollate; 876 char *zName; 877 char *zScript; 878 int nScript; 879 if( objc!=4 ){ 880 Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPT"); 881 return TCL_ERROR; 882 } 883 zName = Tcl_GetStringFromObj(objv[2], 0); 884 zScript = Tcl_GetStringFromObj(objv[3], &nScript); 885 pCollate = (SqlCollate*)Tcl_Alloc( sizeof(*pCollate) + nScript + 1 ); 886 if( pCollate==0 ) return TCL_ERROR; 887 pCollate->interp = interp; 888 pCollate->pNext = pDb->pCollate; 889 pCollate->zScript = (char*)&pCollate[1]; 890 pDb->pCollate = pCollate; 891 strcpy(pCollate->zScript, zScript); 892 if( sqlite3_create_collation(pDb->db, zName, SQLITE_UTF8, 893 pCollate, tclSqlCollate) ){ 894 Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE); 895 return TCL_ERROR; 896 } 897 break; 898 } 899 900 /* 901 ** $db collation_needed SCRIPT 902 ** 903 ** Create a new SQL collation function called NAME. Whenever 904 ** that function is called, invoke SCRIPT to evaluate the function. 905 */ 906 case DB_COLLATION_NEEDED: { 907 if( objc!=3 ){ 908 Tcl_WrongNumArgs(interp, 2, objv, "SCRIPT"); 909 return TCL_ERROR; 910 } 911 if( pDb->pCollateNeeded ){ 912 Tcl_DecrRefCount(pDb->pCollateNeeded); 913 } 914 pDb->pCollateNeeded = Tcl_DuplicateObj(objv[2]); 915 Tcl_IncrRefCount(pDb->pCollateNeeded); 916 sqlite3_collation_needed(pDb->db, pDb, tclCollateNeeded); 917 break; 918 } 919 920 /* $db commit_hook ?CALLBACK? 921 ** 922 ** Invoke the given callback just before committing every SQL transaction. 923 ** If the callback throws an exception or returns non-zero, then the 924 ** transaction is aborted. If CALLBACK is an empty string, the callback 925 ** is disabled. 926 */ 927 case DB_COMMIT_HOOK: { 928 if( objc>3 ){ 929 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); 930 return TCL_ERROR; 931 }else if( objc==2 ){ 932 if( pDb->zCommit ){ 933 Tcl_AppendResult(interp, pDb->zCommit, 0); 934 } 935 }else{ 936 char *zCommit; 937 int len; 938 if( pDb->zCommit ){ 939 Tcl_Free(pDb->zCommit); 940 } 941 zCommit = Tcl_GetStringFromObj(objv[2], &len); 942 if( zCommit && len>0 ){ 943 pDb->zCommit = Tcl_Alloc( len + 1 ); 944 strcpy(pDb->zCommit, zCommit); 945 }else{ 946 pDb->zCommit = 0; 947 } 948 if( pDb->zCommit ){ 949 pDb->interp = interp; 950 sqlite3_commit_hook(pDb->db, DbCommitHandler, pDb); 951 }else{ 952 sqlite3_commit_hook(pDb->db, 0, 0); 953 } 954 } 955 break; 956 } 957 958 /* $db complete SQL 959 ** 960 ** Return TRUE if SQL is a complete SQL statement. Return FALSE if 961 ** additional lines of input are needed. This is similar to the 962 ** built-in "info complete" command of Tcl. 963 */ 964 case DB_COMPLETE: { 965 #ifndef SQLITE_OMIT_COMPLETE 966 Tcl_Obj *pResult; 967 int isComplete; 968 if( objc!=3 ){ 969 Tcl_WrongNumArgs(interp, 2, objv, "SQL"); 970 return TCL_ERROR; 971 } 972 isComplete = sqlite3_complete( Tcl_GetStringFromObj(objv[2], 0) ); 973 pResult = Tcl_GetObjResult(interp); 974 Tcl_SetBooleanObj(pResult, isComplete); 975 #endif 976 break; 977 } 978 979 /* $db copy conflict-algorithm table filename ?SEPARATOR? ?NULLINDICATOR? 980 ** 981 ** Copy data into table from filename, optionally using SEPARATOR 982 ** as column separators. If a column contains a null string, or the 983 ** value of NULLINDICATOR, a NULL is inserted for the column. 984 ** conflict-algorithm is one of the sqlite conflict algorithms: 985 ** rollback, abort, fail, ignore, replace 986 ** On success, return the number of lines processed, not necessarily same 987 ** as 'db changes' due to conflict-algorithm selected. 988 ** 989 ** This code is basically an implementation/enhancement of 990 ** the sqlite3 shell.c ".import" command. 991 ** 992 ** This command usage is equivalent to the sqlite2.x COPY statement, 993 ** which imports file data into a table using the PostgreSQL COPY file format: 994 ** $db copy $conflit_algo $table_name $filename \t \\N 995 */ 996 case DB_COPY: { 997 char *zTable; /* Insert data into this table */ 998 char *zFile; /* The file from which to extract data */ 999 char *zConflict; /* The conflict algorithm to use */ 1000 sqlite3_stmt *pStmt; /* A statement */ 1001 int rc; /* Result code */ 1002 int nCol; /* Number of columns in the table */ 1003 int nByte; /* Number of bytes in an SQL string */ 1004 int i, j; /* Loop counters */ 1005 int nSep; /* Number of bytes in zSep[] */ 1006 int nNull; /* Number of bytes in zNull[] */ 1007 char *zSql; /* An SQL statement */ 1008 char *zLine; /* A single line of input from the file */ 1009 char **azCol; /* zLine[] broken up into columns */ 1010 char *zCommit; /* How to commit changes */ 1011 FILE *in; /* The input file */ 1012 int lineno = 0; /* Line number of input file */ 1013 char zLineNum[80]; /* Line number print buffer */ 1014 Tcl_Obj *pResult; /* interp result */ 1015 1016 char *zSep; 1017 char *zNull; 1018 if( objc<5 || objc>7 ){ 1019 Tcl_WrongNumArgs(interp, 2, objv, 1020 "CONFLICT-ALGORITHM TABLE FILENAME ?SEPARATOR? ?NULLINDICATOR?"); 1021 return TCL_ERROR; 1022 } 1023 if( objc>=6 ){ 1024 zSep = Tcl_GetStringFromObj(objv[5], 0); 1025 }else{ 1026 zSep = "\t"; 1027 } 1028 if( objc>=7 ){ 1029 zNull = Tcl_GetStringFromObj(objv[6], 0); 1030 }else{ 1031 zNull = ""; 1032 } 1033 zConflict = Tcl_GetStringFromObj(objv[2], 0); 1034 zTable = Tcl_GetStringFromObj(objv[3], 0); 1035 zFile = Tcl_GetStringFromObj(objv[4], 0); 1036 nSep = strlen(zSep); 1037 nNull = strlen(zNull); 1038 if( nSep==0 ){ 1039 Tcl_AppendResult(interp,"Error: non-null separator required for copy",0); 1040 return TCL_ERROR; 1041 } 1042 if(sqlite3StrICmp(zConflict, "rollback") != 0 && 1043 sqlite3StrICmp(zConflict, "abort" ) != 0 && 1044 sqlite3StrICmp(zConflict, "fail" ) != 0 && 1045 sqlite3StrICmp(zConflict, "ignore" ) != 0 && 1046 sqlite3StrICmp(zConflict, "replace" ) != 0 ) { 1047 Tcl_AppendResult(interp, "Error: \"", zConflict, 1048 "\", conflict-algorithm must be one of: rollback, " 1049 "abort, fail, ignore, or replace", 0); 1050 return TCL_ERROR; 1051 } 1052 zSql = sqlite3_mprintf("SELECT * FROM '%q'", zTable); 1053 if( zSql==0 ){ 1054 Tcl_AppendResult(interp, "Error: no such table: ", zTable, 0); 1055 return TCL_ERROR; 1056 } 1057 nByte = strlen(zSql); 1058 rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0); 1059 sqlite3_free(zSql); 1060 if( rc ){ 1061 Tcl_AppendResult(interp, "Error: ", sqlite3_errmsg(pDb->db), 0); 1062 nCol = 0; 1063 }else{ 1064 nCol = sqlite3_column_count(pStmt); 1065 } 1066 sqlite3_finalize(pStmt); 1067 if( nCol==0 ) { 1068 return TCL_ERROR; 1069 } 1070 zSql = malloc( nByte + 50 + nCol*2 ); 1071 if( zSql==0 ) { 1072 Tcl_AppendResult(interp, "Error: can't malloc()", 0); 1073 return TCL_ERROR; 1074 } 1075 sqlite3_snprintf(nByte+50, zSql, "INSERT OR %q INTO '%q' VALUES(?", 1076 zConflict, zTable); 1077 j = strlen(zSql); 1078 for(i=1; i<nCol; i++){ 1079 zSql[j++] = ','; 1080 zSql[j++] = '?'; 1081 } 1082 zSql[j++] = ')'; 1083 zSql[j] = 0; 1084 rc = sqlite3_prepare(pDb->db, zSql, -1, &pStmt, 0); 1085 free(zSql); 1086 if( rc ){ 1087 Tcl_AppendResult(interp, "Error: ", sqlite3_errmsg(pDb->db), 0); 1088 sqlite3_finalize(pStmt); 1089 return TCL_ERROR; 1090 } 1091 in = fopen(zFile, "rb"); 1092 if( in==0 ){ 1093 Tcl_AppendResult(interp, "Error: cannot open file: ", zFile, NULL); 1094 sqlite3_finalize(pStmt); 1095 return TCL_ERROR; 1096 } 1097 azCol = malloc( sizeof(azCol[0])*(nCol+1) ); 1098 if( azCol==0 ) { 1099 Tcl_AppendResult(interp, "Error: can't malloc()", 0); 1100 fclose(in); 1101 return TCL_ERROR; 1102 } 1103 (void)sqlite3_exec(pDb->db, "BEGIN", 0, 0, 0); 1104 zCommit = "COMMIT"; 1105 while( (zLine = local_getline(0, in))!=0 ){ 1106 char *z; 1107 i = 0; 1108 lineno++; 1109 azCol[0] = zLine; 1110 for(i=0, z=zLine; *z; z++){ 1111 if( *z==zSep[0] && strncmp(z, zSep, nSep)==0 ){ 1112 *z = 0; 1113 i++; 1114 if( i<nCol ){ 1115 azCol[i] = &z[nSep]; 1116 z += nSep-1; 1117 } 1118 } 1119 } 1120 if( i+1!=nCol ){ 1121 char *zErr; 1122 zErr = malloc(200 + strlen(zFile)); 1123 if( zErr ){ 1124 sprintf(zErr, 1125 "Error: %s line %d: expected %d columns of data but found %d", 1126 zFile, lineno, nCol, i+1); 1127 Tcl_AppendResult(interp, zErr, 0); 1128 free(zErr); 1129 } 1130 zCommit = "ROLLBACK"; 1131 break; 1132 } 1133 for(i=0; i<nCol; i++){ 1134 /* check for null data, if so, bind as null */ 1135 if ((nNull>0 && strcmp(azCol[i], zNull)==0) || strlen(azCol[i])==0) { 1136 sqlite3_bind_null(pStmt, i+1); 1137 }else{ 1138 sqlite3_bind_text(pStmt, i+1, azCol[i], -1, SQLITE_STATIC); 1139 } 1140 } 1141 sqlite3_step(pStmt); 1142 rc = sqlite3_reset(pStmt); 1143 free(zLine); 1144 if( rc!=SQLITE_OK ){ 1145 Tcl_AppendResult(interp,"Error: ", sqlite3_errmsg(pDb->db), 0); 1146 zCommit = "ROLLBACK"; 1147 break; 1148 } 1149 } 1150 free(azCol); 1151 fclose(in); 1152 sqlite3_finalize(pStmt); 1153 (void)sqlite3_exec(pDb->db, zCommit, 0, 0, 0); 1154 1155 if( zCommit[0] == 'C' ){ 1156 /* success, set result as number of lines processed */ 1157 pResult = Tcl_GetObjResult(interp); 1158 Tcl_SetIntObj(pResult, lineno); 1159 rc = TCL_OK; 1160 }else{ 1161 /* failure, append lineno where failed */ 1162 sprintf(zLineNum,"%d",lineno); 1163 Tcl_AppendResult(interp,", failed while processing line: ",zLineNum,0); 1164 rc = TCL_ERROR; 1165 } 1166 break; 1167 } 1168 1169 /* 1170 ** $db enable_load_extension BOOLEAN 1171 ** 1172 ** Turn the extension loading feature on or off. It if off by 1173 ** default. 1174 */ 1175 case DB_ENABLE_LOAD_EXTENSION: { 1176 #ifndef SQLITE_OMIT_LOAD_EXTENSION 1177 int onoff; 1178 if( objc!=3 ){ 1179 Tcl_WrongNumArgs(interp, 2, objv, "BOOLEAN"); 1180 return TCL_ERROR; 1181 } 1182 if( Tcl_GetBooleanFromObj(interp, objv[2], &onoff) ){ 1183 return TCL_ERROR; 1184 } 1185 sqlite3_enable_load_extension(pDb->db, onoff); 1186 break; 1187 #else 1188 Tcl_AppendResult(interp, "extension loading is turned off at compile-time", 1189 0); 1190 return TCL_ERROR; 1191 #endif 1192 } 1193 1194 /* 1195 ** $db errorcode 1196 ** 1197 ** Return the numeric error code that was returned by the most recent 1198 ** call to sqlite3_exec(). 1199 */ 1200 case DB_ERRORCODE: { 1201 Tcl_SetObjResult(interp, Tcl_NewIntObj(sqlite3_errcode(pDb->db))); 1202 break; 1203 } 1204 1205 /* 1206 ** $db eval $sql ?array? ?{ ...code... }? 1207 ** $db onecolumn $sql 1208 ** 1209 ** The SQL statement in $sql is evaluated. For each row, the values are 1210 ** placed in elements of the array named "array" and ...code... is executed. 1211 ** If "array" and "code" are omitted, then no callback is every invoked. 1212 ** If "array" is an empty string, then the values are placed in variables 1213 ** that have the same name as the fields extracted by the query. 1214 ** 1215 ** The onecolumn method is the equivalent of: 1216 ** lindex [$db eval $sql] 0 1217 */ 1218 case DB_ONECOLUMN: 1219 case DB_EVAL: 1220 case DB_EXISTS: { 1221 char const *zSql; /* Next SQL statement to execute */ 1222 char const *zLeft; /* What is left after first stmt in zSql */ 1223 sqlite3_stmt *pStmt; /* Compiled SQL statment */ 1224 Tcl_Obj *pArray; /* Name of array into which results are written */ 1225 Tcl_Obj *pScript; /* Script to run for each result set */ 1226 Tcl_Obj **apParm; /* Parameters that need a Tcl_DecrRefCount() */ 1227 int nParm; /* Number of entries used in apParm[] */ 1228 Tcl_Obj *aParm[10]; /* Static space for apParm[] in the common case */ 1229 Tcl_Obj *pRet; /* Value to be returned */ 1230 SqlPreparedStmt *pPreStmt; /* Pointer to a prepared statement */ 1231 int rc2; 1232 1233 if( choice==DB_EVAL ){ 1234 if( objc<3 || objc>5 ){ 1235 Tcl_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME? ?SCRIPT?"); 1236 return TCL_ERROR; 1237 } 1238 pRet = Tcl_NewObj(); 1239 Tcl_IncrRefCount(pRet); 1240 }else{ 1241 if( objc!=3 ){ 1242 Tcl_WrongNumArgs(interp, 2, objv, "SQL"); 1243 return TCL_ERROR; 1244 } 1245 if( choice==DB_EXISTS ){ 1246 pRet = Tcl_NewBooleanObj(0); 1247 Tcl_IncrRefCount(pRet); 1248 }else{ 1249 pRet = 0; 1250 } 1251 } 1252 if( objc==3 ){ 1253 pArray = pScript = 0; 1254 }else if( objc==4 ){ 1255 pArray = 0; 1256 pScript = objv[3]; 1257 }else{ 1258 pArray = objv[3]; 1259 if( Tcl_GetString(pArray)[0]==0 ) pArray = 0; 1260 pScript = objv[4]; 1261 } 1262 1263 Tcl_IncrRefCount(objv[2]); 1264 zSql = Tcl_GetStringFromObj(objv[2], 0); 1265 while( rc==TCL_OK && zSql[0] ){ 1266 int i; /* Loop counter */ 1267 int nVar; /* Number of bind parameters in the pStmt */ 1268 int nCol; /* Number of columns in the result set */ 1269 Tcl_Obj **apColName = 0; /* Array of column names */ 1270 int len; /* String length of zSql */ 1271 1272 /* Try to find a SQL statement that has already been compiled and 1273 ** which matches the next sequence of SQL. 1274 */ 1275 pStmt = 0; 1276 pPreStmt = pDb->stmtList; 1277 len = strlen(zSql); 1278 if( pPreStmt && sqlite3_expired(pPreStmt->pStmt) ){ 1279 flushStmtCache(pDb); 1280 pPreStmt = 0; 1281 } 1282 for(; pPreStmt; pPreStmt=pPreStmt->pNext){ 1283 int n = pPreStmt->nSql; 1284 if( len>=n 1285 && memcmp(pPreStmt->zSql, zSql, n)==0 1286 && (zSql[n]==0 || zSql[n-1]==';') 1287 ){ 1288 pStmt = pPreStmt->pStmt; 1289 zLeft = &zSql[pPreStmt->nSql]; 1290 1291 /* When a prepared statement is found, unlink it from the 1292 ** cache list. It will later be added back to the beginning 1293 ** of the cache list in order to implement LRU replacement. 1294 */ 1295 if( pPreStmt->pPrev ){ 1296 pPreStmt->pPrev->pNext = pPreStmt->pNext; 1297 }else{ 1298 pDb->stmtList = pPreStmt->pNext; 1299 } 1300 if( pPreStmt->pNext ){ 1301 pPreStmt->pNext->pPrev = pPreStmt->pPrev; 1302 }else{ 1303 pDb->stmtLast = pPreStmt->pPrev; 1304 } 1305 pDb->nStmt--; 1306 break; 1307 } 1308 } 1309 1310 /* If no prepared statement was found. Compile the SQL text 1311 */ 1312 if( pStmt==0 ){ 1313 if( SQLITE_OK!=sqlite3_prepare(pDb->db, zSql, -1, &pStmt, &zLeft) ){ 1314 Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db))); 1315 rc = TCL_ERROR; 1316 break; 1317 } 1318 if( pStmt==0 ){ 1319 if( SQLITE_OK!=sqlite3_errcode(pDb->db) ){ 1320 /* A compile-time error in the statement 1321 */ 1322 Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db))); 1323 rc = TCL_ERROR; 1324 break; 1325 }else{ 1326 /* The statement was a no-op. Continue to the next statement 1327 ** in the SQL string. 1328 */ 1329 zSql = zLeft; 1330 continue; 1331 } 1332 } 1333 assert( pPreStmt==0 ); 1334 } 1335 1336 /* Bind values to parameters that begin with $ or : 1337 */ 1338 nVar = sqlite3_bind_parameter_count(pStmt); 1339 nParm = 0; 1340 if( nVar>sizeof(aParm)/sizeof(aParm[0]) ){ 1341 apParm = (Tcl_Obj**)Tcl_Alloc(nVar*sizeof(apParm[0])); 1342 }else{ 1343 apParm = aParm; 1344 } 1345 for(i=1; i<=nVar; i++){ 1346 const char *zVar = sqlite3_bind_parameter_name(pStmt, i); 1347 if( zVar!=0 && (zVar[0]=='$' || zVar[0]==':') ){ 1348 Tcl_Obj *pVar = Tcl_GetVar2Ex(interp, &zVar[1], 0, 0); 1349 if( pVar ){ 1350 int n; 1351 u8 *data; 1352 char *zType = pVar->typePtr ? pVar->typePtr->name : ""; 1353 char c = zType[0]; 1354 if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){ 1355 /* Only load a BLOB type if the Tcl variable is a bytearray and 1356 ** has no string representation. */ 1357 data = Tcl_GetByteArrayFromObj(pVar, &n); 1358 sqlite3_bind_blob(pStmt, i, data, n, SQLITE_STATIC); 1359 Tcl_IncrRefCount(pVar); 1360 apParm[nParm++] = pVar; 1361 }else if( (c=='b' && strcmp(zType,"boolean")==0) || 1362 (c=='i' && strcmp(zType,"int")==0) ){ 1363 Tcl_GetIntFromObj(interp, pVar, &n); 1364 sqlite3_bind_int(pStmt, i, n); 1365 }else if( c=='d' && strcmp(zType,"double")==0 ){ 1366 double r; 1367 Tcl_GetDoubleFromObj(interp, pVar, &r); 1368 sqlite3_bind_double(pStmt, i, r); 1369 }else if( c=='w' && strcmp(zType,"wideInt")==0 ){ 1370 Tcl_WideInt v; 1371 Tcl_GetWideIntFromObj(interp, pVar, &v); 1372 sqlite3_bind_int64(pStmt, i, v); 1373 }else{ 1374 data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n); 1375 sqlite3_bind_text(pStmt, i, (char *)data, n, SQLITE_STATIC); 1376 Tcl_IncrRefCount(pVar); 1377 apParm[nParm++] = pVar; 1378 } 1379 }else{ 1380 sqlite3_bind_null( pStmt, i ); 1381 } 1382 } 1383 } 1384 1385 /* Compute column names */ 1386 nCol = sqlite3_column_count(pStmt); 1387 if( pScript ){ 1388 apColName = (Tcl_Obj**)Tcl_Alloc( sizeof(Tcl_Obj*)*nCol ); 1389 if( apColName==0 ) break; 1390 for(i=0; i<nCol; i++){ 1391 apColName[i] = dbTextToObj(sqlite3_column_name(pStmt,i)); 1392 Tcl_IncrRefCount(apColName[i]); 1393 } 1394 } 1395 1396 /* If results are being stored in an array variable, then create 1397 ** the array(*) entry for that array 1398 */ 1399 if( pArray ){ 1400 Tcl_Obj *pColList = Tcl_NewObj(); 1401 Tcl_Obj *pStar = Tcl_NewStringObj("*", -1); 1402 Tcl_IncrRefCount(pColList); 1403 for(i=0; i<nCol; i++){ 1404 Tcl_ListObjAppendElement(interp, pColList, apColName[i]); 1405 } 1406 Tcl_ObjSetVar2(interp, pArray, pStar, pColList,0); 1407 Tcl_DecrRefCount(pColList); 1408 Tcl_DecrRefCount(pStar); 1409 } 1410 1411 /* Execute the SQL 1412 */ 1413 while( rc==TCL_OK && pStmt && SQLITE_ROW==sqlite3_step(pStmt) ){ 1414 for(i=0; i<nCol; i++){ 1415 Tcl_Obj *pVal; 1416 1417 /* Set pVal to contain the i'th column of this row. */ 1418 switch( sqlite3_column_type(pStmt, i) ){ 1419 case SQLITE_BLOB: { 1420 int bytes = sqlite3_column_bytes(pStmt, i); 1421 pVal = Tcl_NewByteArrayObj(sqlite3_column_blob(pStmt, i), bytes); 1422 break; 1423 } 1424 case SQLITE_INTEGER: { 1425 sqlite_int64 v = sqlite3_column_int64(pStmt, i); 1426 if( v>=-2147483647 && v<=2147483647 ){ 1427 pVal = Tcl_NewIntObj(v); 1428 }else{ 1429 pVal = Tcl_NewWideIntObj(v); 1430 } 1431 break; 1432 } 1433 case SQLITE_FLOAT: { 1434 double r = sqlite3_column_double(pStmt, i); 1435 pVal = Tcl_NewDoubleObj(r); 1436 break; 1437 } 1438 case SQLITE_NULL: { 1439 pVal = dbTextToObj(pDb->zNull); 1440 break; 1441 } 1442 default: { 1443 pVal = dbTextToObj((char *)sqlite3_column_text(pStmt, i)); 1444 break; 1445 } 1446 } 1447 1448 if( pScript ){ 1449 if( pArray==0 ){ 1450 Tcl_ObjSetVar2(interp, apColName[i], 0, pVal, 0); 1451 }else{ 1452 Tcl_ObjSetVar2(interp, pArray, apColName[i], pVal, 0); 1453 } 1454 }else if( choice==DB_ONECOLUMN ){ 1455 assert( pRet==0 ); 1456 if( pRet==0 ){ 1457 pRet = pVal; 1458 Tcl_IncrRefCount(pRet); 1459 } 1460 rc = TCL_BREAK; 1461 i = nCol; 1462 }else if( choice==DB_EXISTS ){ 1463 Tcl_DecrRefCount(pRet); 1464 pRet = Tcl_NewBooleanObj(1); 1465 Tcl_IncrRefCount(pRet); 1466 rc = TCL_BREAK; 1467 i = nCol; 1468 }else{ 1469 Tcl_ListObjAppendElement(interp, pRet, pVal); 1470 } 1471 } 1472 1473 if( pScript ){ 1474 rc = Tcl_EvalObjEx(interp, pScript, 0); 1475 if( rc==TCL_CONTINUE ){ 1476 rc = TCL_OK; 1477 } 1478 } 1479 } 1480 if( rc==TCL_BREAK ){ 1481 rc = TCL_OK; 1482 } 1483 1484 /* Free the column name objects */ 1485 if( pScript ){ 1486 for(i=0; i<nCol; i++){ 1487 Tcl_DecrRefCount(apColName[i]); 1488 } 1489 Tcl_Free((char*)apColName); 1490 } 1491 1492 /* Free the bound string and blob parameters */ 1493 for(i=0; i<nParm; i++){ 1494 Tcl_DecrRefCount(apParm[i]); 1495 } 1496 if( apParm!=aParm ){ 1497 Tcl_Free((char*)apParm); 1498 } 1499 1500 /* Reset the statement. If the result code is SQLITE_SCHEMA, then 1501 ** flush the statement cache and try the statement again. 1502 */ 1503 rc2 = sqlite3_reset(pStmt); 1504 if( SQLITE_SCHEMA==rc2 ){ 1505 /* After a schema change, flush the cache and try to run the 1506 ** statement again 1507 */ 1508 flushStmtCache( pDb ); 1509 sqlite3_finalize(pStmt); 1510 if( pPreStmt ) Tcl_Free((char*)pPreStmt); 1511 continue; 1512 }else if( SQLITE_OK!=rc2 ){ 1513 /* If a run-time error occurs, report the error and stop reading 1514 ** the SQL 1515 */ 1516 Tcl_SetObjResult(interp, dbTextToObj(sqlite3_errmsg(pDb->db))); 1517 sqlite3_finalize(pStmt); 1518 rc = TCL_ERROR; 1519 if( pPreStmt ) Tcl_Free((char*)pPreStmt); 1520 break; 1521 }else if( pDb->maxStmt<=0 ){ 1522 /* If the cache is turned off, deallocated the statement */ 1523 if( pPreStmt ) Tcl_Free((char*)pPreStmt); 1524 sqlite3_finalize(pStmt); 1525 }else{ 1526 /* Everything worked and the cache is operational. 1527 ** Create a new SqlPreparedStmt structure if we need one. 1528 ** (If we already have one we can just reuse it.) 1529 */ 1530 if( pPreStmt==0 ){ 1531 len = zLeft - zSql; 1532 pPreStmt = (SqlPreparedStmt*)Tcl_Alloc( sizeof(*pPreStmt) + len ); 1533 if( pPreStmt==0 ) return TCL_ERROR; 1534 pPreStmt->pStmt = pStmt; 1535 pPreStmt->nSql = len; 1536 memcpy(pPreStmt->zSql, zSql, len); 1537 pPreStmt->zSql[len] = 0; 1538 } 1539 1540 /* Add the prepared statement to the beginning of the cache list 1541 */ 1542 pPreStmt->pNext = pDb->stmtList; 1543 pPreStmt->pPrev = 0; 1544 if( pDb->stmtList ){ 1545 pDb->stmtList->pPrev = pPreStmt; 1546 } 1547 pDb->stmtList = pPreStmt; 1548 if( pDb->stmtLast==0 ){ 1549 assert( pDb->nStmt==0 ); 1550 pDb->stmtLast = pPreStmt; 1551 }else{ 1552 assert( pDb->nStmt>0 ); 1553 } 1554 pDb->nStmt++; 1555 1556 /* If we have too many statement in cache, remove the surplus from the 1557 ** end of the cache list. 1558 */ 1559 while( pDb->nStmt>pDb->maxStmt ){ 1560 sqlite3_finalize(pDb->stmtLast->pStmt); 1561 pDb->stmtLast = pDb->stmtLast->pPrev; 1562 Tcl_Free((char*)pDb->stmtLast->pNext); 1563 pDb->stmtLast->pNext = 0; 1564 pDb->nStmt--; 1565 } 1566 } 1567 1568 /* Proceed to the next statement */ 1569 zSql = zLeft; 1570 } 1571 Tcl_DecrRefCount(objv[2]); 1572 1573 if( pRet ){ 1574 if( rc==TCL_OK ){ 1575 Tcl_SetObjResult(interp, pRet); 1576 } 1577 Tcl_DecrRefCount(pRet); 1578 }else if( rc==TCL_OK ){ 1579 Tcl_ResetResult(interp); 1580 } 1581 break; 1582 } 1583 1584 /* 1585 ** $db function NAME SCRIPT 1586 ** 1587 ** Create a new SQL function called NAME. Whenever that function is 1588 ** called, invoke SCRIPT to evaluate the function. 1589 */ 1590 case DB_FUNCTION: { 1591 SqlFunc *pFunc; 1592 Tcl_Obj *pScript; 1593 char *zName; 1594 if( objc!=4 ){ 1595 Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPT"); 1596 return TCL_ERROR; 1597 } 1598 zName = Tcl_GetStringFromObj(objv[2], 0); 1599 pScript = objv[3]; 1600 pFunc = findSqlFunc(pDb, zName); 1601 if( pFunc==0 ) return TCL_ERROR; 1602 if( pFunc->pScript ){ 1603 Tcl_DecrRefCount(pFunc->pScript); 1604 } 1605 pFunc->pScript = pScript; 1606 Tcl_IncrRefCount(pScript); 1607 pFunc->useEvalObjv = safeToUseEvalObjv(interp, pScript); 1608 rc = sqlite3_create_function(pDb->db, zName, -1, SQLITE_UTF8, 1609 pFunc, tclSqlFunc, 0, 0); 1610 if( rc!=SQLITE_OK ){ 1611 rc = TCL_ERROR; 1612 Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE); 1613 }else{ 1614 /* Must flush any cached statements */ 1615 flushStmtCache( pDb ); 1616 } 1617 break; 1618 } 1619 1620 /* 1621 ** $db interrupt 1622 ** 1623 ** Interrupt the execution of the inner-most SQL interpreter. This 1624 ** causes the SQL statement to return an error of SQLITE_INTERRUPT. 1625 */ 1626 case DB_INTERRUPT: { 1627 sqlite3_interrupt(pDb->db); 1628 break; 1629 } 1630 1631 /* 1632 ** $db nullvalue ?STRING? 1633 ** 1634 ** Change text used when a NULL comes back from the database. If ?STRING? 1635 ** is not present, then the current string used for NULL is returned. 1636 ** If STRING is present, then STRING is returned. 1637 ** 1638 */ 1639 case DB_NULLVALUE: { 1640 if( objc!=2 && objc!=3 ){ 1641 Tcl_WrongNumArgs(interp, 2, objv, "NULLVALUE"); 1642 return TCL_ERROR; 1643 } 1644 if( objc==3 ){ 1645 int len; 1646 char *zNull = Tcl_GetStringFromObj(objv[2], &len); 1647 if( pDb->zNull ){ 1648 Tcl_Free(pDb->zNull); 1649 } 1650 if( zNull && len>0 ){ 1651 pDb->zNull = Tcl_Alloc( len + 1 ); 1652 strncpy(pDb->zNull, zNull, len); 1653 pDb->zNull[len] = '\0'; 1654 }else{ 1655 pDb->zNull = 0; 1656 } 1657 } 1658 Tcl_SetObjResult(interp, dbTextToObj(pDb->zNull)); 1659 break; 1660 } 1661 1662 /* 1663 ** $db last_insert_rowid 1664 ** 1665 ** Return an integer which is the ROWID for the most recent insert. 1666 */ 1667 case DB_LAST_INSERT_ROWID: { 1668 Tcl_Obj *pResult; 1669 Tcl_WideInt rowid; 1670 if( objc!=2 ){ 1671 Tcl_WrongNumArgs(interp, 2, objv, ""); 1672 return TCL_ERROR; 1673 } 1674 rowid = sqlite3_last_insert_rowid(pDb->db); 1675 pResult = Tcl_GetObjResult(interp); 1676 Tcl_SetWideIntObj(pResult, rowid); 1677 break; 1678 } 1679 1680 /* 1681 ** The DB_ONECOLUMN method is implemented together with DB_EVAL. 1682 */ 1683 1684 /* $db progress ?N CALLBACK? 1685 ** 1686 ** Invoke the given callback every N virtual machine opcodes while executing 1687 ** queries. 1688 */ 1689 case DB_PROGRESS: { 1690 if( objc==2 ){ 1691 if( pDb->zProgress ){ 1692 Tcl_AppendResult(interp, pDb->zProgress, 0); 1693 } 1694 }else if( objc==4 ){ 1695 char *zProgress; 1696 int len; 1697 int N; 1698 if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &N) ){ 1699 return TCL_ERROR; 1700 }; 1701 if( pDb->zProgress ){ 1702 Tcl_Free(pDb->zProgress); 1703 } 1704 zProgress = Tcl_GetStringFromObj(objv[3], &len); 1705 if( zProgress && len>0 ){ 1706 pDb->zProgress = Tcl_Alloc( len + 1 ); 1707 strcpy(pDb->zProgress, zProgress); 1708 }else{ 1709 pDb->zProgress = 0; 1710 } 1711 #ifndef SQLITE_OMIT_PROGRESS_CALLBACK 1712 if( pDb->zProgress ){ 1713 pDb->interp = interp; 1714 sqlite3_progress_handler(pDb->db, N, DbProgressHandler, pDb); 1715 }else{ 1716 sqlite3_progress_handler(pDb->db, 0, 0, 0); 1717 } 1718 #endif 1719 }else{ 1720 Tcl_WrongNumArgs(interp, 2, objv, "N CALLBACK"); 1721 return TCL_ERROR; 1722 } 1723 break; 1724 } 1725 1726 /* $db profile ?CALLBACK? 1727 ** 1728 ** Make arrangements to invoke the CALLBACK routine after each SQL statement 1729 ** that has run. The text of the SQL and the amount of elapse time are 1730 ** appended to CALLBACK before the script is run. 1731 */ 1732 case DB_PROFILE: { 1733 if( objc>3 ){ 1734 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); 1735 return TCL_ERROR; 1736 }else if( objc==2 ){ 1737 if( pDb->zProfile ){ 1738 Tcl_AppendResult(interp, pDb->zProfile, 0); 1739 } 1740 }else{ 1741 char *zProfile; 1742 int len; 1743 if( pDb->zProfile ){ 1744 Tcl_Free(pDb->zProfile); 1745 } 1746 zProfile = Tcl_GetStringFromObj(objv[2], &len); 1747 if( zProfile && len>0 ){ 1748 pDb->zProfile = Tcl_Alloc( len + 1 ); 1749 strcpy(pDb->zProfile, zProfile); 1750 }else{ 1751 pDb->zProfile = 0; 1752 } 1753 #ifndef SQLITE_OMIT_TRACE 1754 if( pDb->zProfile ){ 1755 pDb->interp = interp; 1756 sqlite3_profile(pDb->db, DbProfileHandler, pDb); 1757 }else{ 1758 sqlite3_profile(pDb->db, 0, 0); 1759 } 1760 #endif 1761 } 1762 break; 1763 } 1764 1765 /* 1766 ** $db rekey KEY 1767 ** 1768 ** Change the encryption key on the currently open database. 1769 */ 1770 case DB_REKEY: { 1771 int nKey; 1772 void *pKey; 1773 if( objc!=3 ){ 1774 Tcl_WrongNumArgs(interp, 2, objv, "KEY"); 1775 return TCL_ERROR; 1776 } 1777 pKey = Tcl_GetByteArrayFromObj(objv[2], &nKey); 1778 #ifdef SQLITE_HAS_CODEC 1779 rc = sqlite3_rekey(pDb->db, pKey, nKey); 1780 if( rc ){ 1781 Tcl_AppendResult(interp, sqlite3ErrStr(rc), 0); 1782 rc = TCL_ERROR; 1783 } 1784 #endif 1785 break; 1786 } 1787 1788 /* 1789 ** $db timeout MILLESECONDS 1790 ** 1791 ** Delay for the number of milliseconds specified when a file is locked. 1792 */ 1793 case DB_TIMEOUT: { 1794 int ms; 1795 if( objc!=3 ){ 1796 Tcl_WrongNumArgs(interp, 2, objv, "MILLISECONDS"); 1797 return TCL_ERROR; 1798 } 1799 if( Tcl_GetIntFromObj(interp, objv[2], &ms) ) return TCL_ERROR; 1800 sqlite3_busy_timeout(pDb->db, ms); 1801 break; 1802 } 1803 1804 /* 1805 ** $db total_changes 1806 ** 1807 ** Return the number of rows that were modified, inserted, or deleted 1808 ** since the database handle was created. 1809 */ 1810 case DB_TOTAL_CHANGES: { 1811 Tcl_Obj *pResult; 1812 if( objc!=2 ){ 1813 Tcl_WrongNumArgs(interp, 2, objv, ""); 1814 return TCL_ERROR; 1815 } 1816 pResult = Tcl_GetObjResult(interp); 1817 Tcl_SetIntObj(pResult, sqlite3_total_changes(pDb->db)); 1818 break; 1819 } 1820 1821 /* $db trace ?CALLBACK? 1822 ** 1823 ** Make arrangements to invoke the CALLBACK routine for each SQL statement 1824 ** that is executed. The text of the SQL is appended to CALLBACK before 1825 ** it is executed. 1826 */ 1827 case DB_TRACE: { 1828 if( objc>3 ){ 1829 Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?"); 1830 return TCL_ERROR; 1831 }else if( objc==2 ){ 1832 if( pDb->zTrace ){ 1833 Tcl_AppendResult(interp, pDb->zTrace, 0); 1834 } 1835 }else{ 1836 char *zTrace; 1837 int len; 1838 if( pDb->zTrace ){ 1839 Tcl_Free(pDb->zTrace); 1840 } 1841 zTrace = Tcl_GetStringFromObj(objv[2], &len); 1842 if( zTrace && len>0 ){ 1843 pDb->zTrace = Tcl_Alloc( len + 1 ); 1844 strcpy(pDb->zTrace, zTrace); 1845 }else{ 1846 pDb->zTrace = 0; 1847 } 1848 #ifndef SQLITE_OMIT_TRACE 1849 if( pDb->zTrace ){ 1850 pDb->interp = interp; 1851 sqlite3_trace(pDb->db, DbTraceHandler, pDb); 1852 }else{ 1853 sqlite3_trace(pDb->db, 0, 0); 1854 } 1855 #endif 1856 } 1857 break; 1858 } 1859 1860 /* $db transaction [-deferred|-immediate|-exclusive] SCRIPT 1861 ** 1862 ** Start a new transaction (if we are not already in the midst of a 1863 ** transaction) and execute the TCL script SCRIPT. After SCRIPT 1864 ** completes, either commit the transaction or roll it back if SCRIPT 1865 ** throws an exception. Or if no new transation was started, do nothing. 1866 ** pass the exception on up the stack. 1867 ** 1868 ** This command was inspired by Dave Thomas's talk on Ruby at the 1869 ** 2005 O'Reilly Open Source Convention (OSCON). 1870 */ 1871 case DB_TRANSACTION: { 1872 int inTrans; 1873 Tcl_Obj *pScript; 1874 const char *zBegin = "BEGIN"; 1875 if( objc!=3 && objc!=4 ){ 1876 Tcl_WrongNumArgs(interp, 2, objv, "[TYPE] SCRIPT"); 1877 return TCL_ERROR; 1878 } 1879 if( objc==3 ){ 1880 pScript = objv[2]; 1881 } else { 1882 static const char *TTYPE_strs[] = { 1883 "deferred", "exclusive", "immediate", 0 1884 }; 1885 enum TTYPE_enum { 1886 TTYPE_DEFERRED, TTYPE_EXCLUSIVE, TTYPE_IMMEDIATE 1887 }; 1888 int ttype; 1889 if( Tcl_GetIndexFromObj(interp, objv[2], TTYPE_strs, "transaction type", 1890 0, &ttype) ){ 1891 return TCL_ERROR; 1892 } 1893 switch( (enum TTYPE_enum)ttype ){ 1894 case TTYPE_DEFERRED: /* no-op */; break; 1895 case TTYPE_EXCLUSIVE: zBegin = "BEGIN EXCLUSIVE"; break; 1896 case TTYPE_IMMEDIATE: zBegin = "BEGIN IMMEDIATE"; break; 1897 } 1898 pScript = objv[3]; 1899 } 1900 inTrans = !sqlite3_get_autocommit(pDb->db); 1901 if( !inTrans ){ 1902 (void)sqlite3_exec(pDb->db, zBegin, 0, 0, 0); 1903 } 1904 rc = Tcl_EvalObjEx(interp, pScript, 0); 1905 if( !inTrans ){ 1906 const char *zEnd; 1907 if( rc==TCL_ERROR ){ 1908 zEnd = "ROLLBACK"; 1909 } else { 1910 zEnd = "COMMIT"; 1911 } 1912 (void)sqlite3_exec(pDb->db, zEnd, 0, 0, 0); 1913 } 1914 break; 1915 } 1916 1917 /* 1918 ** $db update_hook ?script? 1919 ** $db rollback_hook ?script? 1920 */ 1921 case DB_UPDATE_HOOK: 1922 case DB_ROLLBACK_HOOK: { 1923 1924 /* set ppHook to point at pUpdateHook or pRollbackHook, depending on 1925 ** whether [$db update_hook] or [$db rollback_hook] was invoked. 1926 */ 1927 Tcl_Obj **ppHook; 1928 if( choice==DB_UPDATE_HOOK ){ 1929 ppHook = &pDb->pUpdateHook; 1930 }else{ 1931 ppHook = &pDb->pRollbackHook; 1932 } 1933 1934 if( objc!=2 && objc!=3 ){ 1935 Tcl_WrongNumArgs(interp, 2, objv, "?SCRIPT?"); 1936 return TCL_ERROR; 1937 } 1938 if( *ppHook ){ 1939 Tcl_SetObjResult(interp, *ppHook); 1940 if( objc==3 ){ 1941 Tcl_DecrRefCount(*ppHook); 1942 *ppHook = 0; 1943 } 1944 } 1945 if( objc==3 ){ 1946 assert( !(*ppHook) ); 1947 if( Tcl_GetCharLength(objv[2])>0 ){ 1948 *ppHook = objv[2]; 1949 Tcl_IncrRefCount(*ppHook); 1950 } 1951 } 1952 1953 sqlite3_update_hook(pDb->db, (pDb->pUpdateHook?DbUpdateHandler:0), pDb); 1954 sqlite3_rollback_hook(pDb->db,(pDb->pRollbackHook?DbRollbackHandler:0),pDb); 1955 1956 break; 1957 } 1958 1959 /* $db version 1960 ** 1961 ** Return the version string for this database. 1962 */ 1963 case DB_VERSION: { 1964 Tcl_SetResult(interp, (char *)sqlite3_libversion(), TCL_STATIC); 1965 break; 1966 } 1967 1968 1969 } /* End of the SWITCH statement */ 1970 return rc; 1971 } 1972 1973 /* 1974 ** sqlite3 DBNAME FILENAME ?MODE? ?-key KEY? 1975 ** 1976 ** This is the main Tcl command. When the "sqlite" Tcl command is 1977 ** invoked, this routine runs to process that command. 1978 ** 1979 ** The first argument, DBNAME, is an arbitrary name for a new 1980 ** database connection. This command creates a new command named 1981 ** DBNAME that is used to control that connection. The database 1982 ** connection is deleted when the DBNAME command is deleted. 1983 ** 1984 ** The second argument is the name of the directory that contains 1985 ** the sqlite database that is to be accessed. 1986 ** 1987 ** For testing purposes, we also support the following: 1988 ** 1989 ** sqlite3 -encoding 1990 ** 1991 ** Return the encoding used by LIKE and GLOB operators. Choices 1992 ** are UTF-8 and iso8859. 1993 ** 1994 ** sqlite3 -version 1995 ** 1996 ** Return the version number of the SQLite library. 1997 ** 1998 ** sqlite3 -tcl-uses-utf 1999 ** 2000 ** Return "1" if compiled with a Tcl uses UTF-8. Return "0" if 2001 ** not. Used by tests to make sure the library was compiled 2002 ** correctly. 2003 */ 2004 static int DbMain(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){ 2005 SqliteDb *p; 2006 void *pKey = 0; 2007 int nKey = 0; 2008 const char *zArg; 2009 char *zErrMsg; 2010 const char *zFile; 2011 Tcl_DString translatedFilename; 2012 if( objc==2 ){ 2013 zArg = Tcl_GetStringFromObj(objv[1], 0); 2014 if( strcmp(zArg,"-version")==0 ){ 2015 Tcl_AppendResult(interp,sqlite3_version,0); 2016 return TCL_OK; 2017 } 2018 if( strcmp(zArg,"-has-codec")==0 ){ 2019 #ifdef SQLITE_HAS_CODEC 2020 Tcl_AppendResult(interp,"1",0); 2021 #else 2022 Tcl_AppendResult(interp,"0",0); 2023 #endif 2024 return TCL_OK; 2025 } 2026 if( strcmp(zArg,"-tcl-uses-utf")==0 ){ 2027 #ifdef TCL_UTF_MAX 2028 Tcl_AppendResult(interp,"1",0); 2029 #else 2030 Tcl_AppendResult(interp,"0",0); 2031 #endif 2032 return TCL_OK; 2033 } 2034 } 2035 if( objc==5 || objc==6 ){ 2036 zArg = Tcl_GetStringFromObj(objv[objc-2], 0); 2037 if( strcmp(zArg,"-key")==0 ){ 2038 pKey = Tcl_GetByteArrayFromObj(objv[objc-1], &nKey); 2039 objc -= 2; 2040 } 2041 } 2042 if( objc!=3 && objc!=4 ){ 2043 Tcl_WrongNumArgs(interp, 1, objv, 2044 #ifdef SQLITE_HAS_CODEC 2045 "HANDLE FILENAME ?-key CODEC-KEY?" 2046 #else 2047 "HANDLE FILENAME ?MODE?" 2048 #endif 2049 ); 2050 return TCL_ERROR; 2051 } 2052 zErrMsg = 0; 2053 p = (SqliteDb*)Tcl_Alloc( sizeof(*p) ); 2054 if( p==0 ){ 2055 Tcl_SetResult(interp, "malloc failed", TCL_STATIC); 2056 return TCL_ERROR; 2057 } 2058 memset(p, 0, sizeof(*p)); 2059 zFile = Tcl_GetStringFromObj(objv[2], 0); 2060 zFile = Tcl_TranslateFileName(interp, zFile, &translatedFilename); 2061 sqlite3_open(zFile, &p->db); 2062 Tcl_DStringFree(&translatedFilename); 2063 if( SQLITE_OK!=sqlite3_errcode(p->db) ){ 2064 zErrMsg = sqlite3_mprintf("%s", sqlite3_errmsg(p->db)); 2065 sqlite3_close(p->db); 2066 p->db = 0; 2067 } 2068 #ifdef SQLITE_HAS_CODEC 2069 sqlite3_key(p->db, pKey, nKey); 2070 #endif 2071 if( p->db==0 ){ 2072 Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE); 2073 Tcl_Free((char*)p); 2074 sqlite3_free(zErrMsg); 2075 return TCL_ERROR; 2076 } 2077 p->maxStmt = NUM_PREPARED_STMTS; 2078 p->interp = interp; 2079 zArg = Tcl_GetStringFromObj(objv[1], 0); 2080 Tcl_CreateObjCommand(interp, zArg, DbObjCmd, (char*)p, DbDeleteCmd); 2081 2082 /* If compiled with SQLITE_TEST turned on, then register the "md5sum" 2083 ** SQL function. 2084 */ 2085 #ifdef SQLITE_TEST 2086 { 2087 extern void Md5_Register(sqlite3*); 2088 #ifdef SQLITE_MEMDEBUG 2089 int mallocfail = sqlite3_iMallocFail; 2090 sqlite3_iMallocFail = 0; 2091 #endif 2092 Md5_Register(p->db); 2093 #ifdef SQLITE_MEMDEBUG 2094 sqlite3_iMallocFail = mallocfail; 2095 #endif 2096 } 2097 #endif 2098 return TCL_OK; 2099 } 2100 2101 /* 2102 ** Provide a dummy Tcl_InitStubs if we are using this as a static 2103 ** library. 2104 */ 2105 #ifndef USE_TCL_STUBS 2106 # undef Tcl_InitStubs 2107 # define Tcl_InitStubs(a,b,c) 2108 #endif 2109 2110 /* 2111 ** Make sure we have a PACKAGE_VERSION macro defined. This will be 2112 ** defined automatically by the TEA makefile. But other makefiles 2113 ** do not define it. 2114 */ 2115 #ifndef PACKAGE_VERSION 2116 # define PACKAGE_VERSION SQLITE_VERSION 2117 #endif 2118 2119 /* 2120 ** Initialize this module. 2121 ** 2122 ** This Tcl module contains only a single new Tcl command named "sqlite". 2123 ** (Hence there is no namespace. There is no point in using a namespace 2124 ** if the extension only supplies one new name!) The "sqlite" command is 2125 ** used to open a new SQLite database. See the DbMain() routine above 2126 ** for additional information. 2127 */ 2128 EXTERN int Sqlite3_Init(Tcl_Interp *interp){ 2129 Tcl_InitStubs(interp, "8.4", 0); 2130 Tcl_CreateObjCommand(interp, "sqlite3", (Tcl_ObjCmdProc*)DbMain, 0, 0); 2131 Tcl_PkgProvide(interp, "sqlite3", PACKAGE_VERSION); 2132 Tcl_CreateObjCommand(interp, "sqlite", (Tcl_ObjCmdProc*)DbMain, 0, 0); 2133 Tcl_PkgProvide(interp, "sqlite", PACKAGE_VERSION); 2134 return TCL_OK; 2135 } 2136 EXTERN int Tclsqlite3_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); } 2137 EXTERN int Sqlite3_SafeInit(Tcl_Interp *interp){ return TCL_OK; } 2138 EXTERN int Tclsqlite3_SafeInit(Tcl_Interp *interp){ return TCL_OK; } 2139 2140 #ifndef SQLITE_3_SUFFIX_ONLY 2141 EXTERN int Sqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); } 2142 EXTERN int Tclsqlite_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); } 2143 EXTERN int Sqlite_SafeInit(Tcl_Interp *interp){ return TCL_OK; } 2144 EXTERN int Tclsqlite_SafeInit(Tcl_Interp *interp){ return TCL_OK; } 2145 #endif 2146 2147 #ifdef TCLSH 2148 /***************************************************************************** 2149 ** The code that follows is used to build standalone TCL interpreters 2150 */ 2151 2152 /* 2153 ** If the macro TCLSH is one, then put in code this for the 2154 ** "main" routine that will initialize Tcl and take input from 2155 ** standard input. 2156 */ 2157 #if TCLSH==1 2158 static char zMainloop[] = 2159 "set line {}\n" 2160 "while {![eof stdin]} {\n" 2161 "if {$line!=\"\"} {\n" 2162 "puts -nonewline \"> \"\n" 2163 "} else {\n" 2164 "puts -nonewline \"% \"\n" 2165 "}\n" 2166 "flush stdout\n" 2167 "append line [gets stdin]\n" 2168 "if {[info complete $line]} {\n" 2169 "if {[catch {uplevel #0 $line} result]} {\n" 2170 "puts stderr \"Error: $result\"\n" 2171 "} elseif {$result!=\"\"} {\n" 2172 "puts $result\n" 2173 "}\n" 2174 "set line {}\n" 2175 "} else {\n" 2176 "append line \\n\n" 2177 "}\n" 2178 "}\n" 2179 ; 2180 #endif 2181 2182 /* 2183 ** If the macro TCLSH is two, then get the main loop code out of 2184 ** the separate file "spaceanal_tcl.h". 2185 */ 2186 #if TCLSH==2 2187 static char zMainloop[] = 2188 #include "spaceanal_tcl.h" 2189 ; 2190 #endif 2191 2192 #define TCLSH_MAIN main /* Needed to fake out mktclapp */ 2193 int TCLSH_MAIN(int argc, char **argv){ 2194 Tcl_Interp *interp; 2195 Tcl_FindExecutable(argv[0]); 2196 interp = Tcl_CreateInterp(); 2197 Sqlite3_Init(interp); 2198 #ifdef SQLITE_TEST 2199 { 2200 extern int Sqlitetest1_Init(Tcl_Interp*); 2201 extern int Sqlitetest2_Init(Tcl_Interp*); 2202 extern int Sqlitetest3_Init(Tcl_Interp*); 2203 extern int Sqlitetest4_Init(Tcl_Interp*); 2204 extern int Sqlitetest5_Init(Tcl_Interp*); 2205 extern int Sqlitetest6_Init(Tcl_Interp*); 2206 extern int Sqlitetest7_Init(Tcl_Interp*); 2207 extern int Sqlitetest8_Init(Tcl_Interp*); 2208 extern int Md5_Init(Tcl_Interp*); 2209 extern int Sqlitetestsse_Init(Tcl_Interp*); 2210 extern int Sqlitetestasync_Init(Tcl_Interp*); 2211 extern int Sqlitetesttclvar_Init(Tcl_Interp*); 2212 extern int Sqlitetestschema_Init(Tcl_Interp*); 2213 extern int Sqlitetest_autoext_Init(Tcl_Interp*); 2214 2215 Sqlitetest1_Init(interp); 2216 Sqlitetest2_Init(interp); 2217 Sqlitetest3_Init(interp); 2218 Sqlitetest4_Init(interp); 2219 Sqlitetest5_Init(interp); 2220 Sqlitetest6_Init(interp); 2221 Sqlitetest7_Init(interp); 2222 Sqlitetest8_Init(interp); 2223 Sqlitetestasync_Init(interp); 2224 Sqlitetesttclvar_Init(interp); 2225 Sqlitetestschema_Init(interp); 2226 Sqlitetest_autoext_Init(interp); 2227 Md5_Init(interp); 2228 #ifdef SQLITE_SSE 2229 Sqlitetestsse_Init(interp); 2230 #endif 2231 } 2232 #endif 2233 if( argc>=2 || TCLSH==2 ){ 2234 int i; 2235 char zArgc[32]; 2236 sqlite3_snprintf(sizeof(zArgc), zArgc, "%d", argc-(3-TCLSH)); 2237 Tcl_SetVar(interp,"argc", zArgc, TCL_GLOBAL_ONLY); 2238 Tcl_SetVar(interp,"argv0",argv[1],TCL_GLOBAL_ONLY); 2239 Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY); 2240 for(i=3-TCLSH; i<argc; i++){ 2241 Tcl_SetVar(interp, "argv", argv[i], 2242 TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE); 2243 } 2244 if( TCLSH==1 && Tcl_EvalFile(interp, argv[1])!=TCL_OK ){ 2245 const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); 2246 if( zInfo==0 ) zInfo = interp->result; 2247 fprintf(stderr,"%s: %s\n", *argv, zInfo); 2248 return 1; 2249 } 2250 } 2251 if( argc<=1 || TCLSH==2 ){ 2252 Tcl_GlobalEval(interp, zMainloop); 2253 } 2254 return 0; 2255 } 2256 #endif /* TCLSH */ 2257 2258 #endif /* !defined(NO_TCL) */ 2259