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