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