Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Difference From andygoth-tcl-function To root:andygoth-tcl-function
2019-02-03
| ||
07:30 | Rename -new to -initial Leaf check-in: e4a7d847d1 user: andy tags: andygoth-tcl-function | |
06:44 | Add missing initialization check-in: 5e7cff8436 user: andy tags: andygoth-tcl-function | |
2019-01-30
| ||
17:30 | Initial implementation of user-defined Tcl aggregate functions. Testing and documentation to come. check-in: e0689f05d1 user: andygoth tags: andygoth-tcl-function | |
15:47 | Add the --progress, --using, and -q options to the index_usage utility program. check-in: a5e6be7cbc user: drh tags: trunk | |
14:01 | Enhancements to the index_usage utility program. check-in: 19c739b4a8 user: drh tags: trunk | |
12:15 | Fix another buffer overread in fts5 that may occur when accessing a corrupt database. check-in: 760d14374d user: dan tags: trunk | |
Changes to src/tclsqlite.c.
︙ | ︙ | |||
83 84 85 86 87 88 89 | #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLEXPORT #endif /* BUILD_sqlite */ #define NUM_PREPARED_STMTS 10 #define MAX_PREPARED_STMTS 100 | < < < < < < < < < < < < < < < < < < < < | < | < < < < < < < < < | 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 | #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLEXPORT #endif /* BUILD_sqlite */ #define NUM_PREPARED_STMTS 10 #define MAX_PREPARED_STMTS 100 /* Forward declaration */ typedef struct SqliteDb SqliteDb; /* ** New SQL functions can be created as TCL scripts. Each such function ** is described by an instance of the following structure. */ typedef struct SqlFunc SqlFunc; struct SqlFunc { Tcl_Interp *interp; /* The TCL interpret to execute the function */ Tcl_Obj *pScript; /* The Tcl_Obj representation of the script */ SqliteDb *pDb; /* Database connection that owns this function */ int useEvalObjv; /* True if it is safe to use Tcl_EvalObjv */ char *zName; /* Name of this function */ SqlFunc *pNext; /* Next function on the list of them all */ }; /* ** New collation sequences function can be created as TCL scripts. Each such ** function is described by an instance of the following structure. */ typedef struct SqlCollate SqlCollate; struct SqlCollate { Tcl_Interp *interp; /* The TCL interpret to execute the function */ |
︙ | ︙ | |||
451 452 453 454 455 456 457 458 459 460 461 462 463 464 | Tcl_SetResult(interp, (char *)Tcl_GetChannelName(p->channel), TCL_VOLATILE); return TCL_OK; } #else /* else clause for "#ifndef SQLITE_OMIT_INCRBLOB" */ #define closeIncrblobChannels(pDb) #endif /* ** Find an SqlFunc structure with the given name. Or create a new ** one if an existing one cannot be found. Return a pointer to the ** structure. */ static SqlFunc *findSqlFunc(SqliteDb *pDb, const char *zName){ | > > > > > > > > > > > > > > > > > > > > > > > > > > > | 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 | Tcl_SetResult(interp, (char *)Tcl_GetChannelName(p->channel), TCL_VOLATILE); return TCL_OK; } #else /* else clause for "#ifndef SQLITE_OMIT_INCRBLOB" */ #define closeIncrblobChannels(pDb) #endif /* ** Look at the script prefix in pCmd. We will be executing this script ** after first appending one or more arguments. This routine analyzes ** the script to see if it is safe to use Tcl_EvalObjv() on the script ** rather than the more general Tcl_EvalEx(). Tcl_EvalObjv() is much ** faster. ** ** Scripts that are safe to use with Tcl_EvalObjv() consists of a ** command name followed by zero or more arguments with no [...] or $ ** or {...} or ; to be seen anywhere. Most callback scripts consist ** of just a single procedure name and they meet this requirement. */ static int safeToUseEvalObjv(Tcl_Interp *interp, Tcl_Obj *pCmd){ /* We could try to do something with Tcl_Parse(). But we will instead ** just do a search for forbidden characters. If any of the forbidden ** characters appear in pCmd, we will report the string as unsafe. */ const char *z; int n; z = Tcl_GetStringFromObj(pCmd, &n); while( n-- > 0 ){ int c = *(z++); if( c=='$' || c=='[' || c==';' ) return 0; } return 1; } /* ** Find an SqlFunc structure with the given name. Or create a new ** one if an existing one cannot be found. Return a pointer to the ** structure. */ static SqlFunc *findSqlFunc(SqliteDb *pDb, const char *zName){ |
︙ | ︙ | |||
472 473 474 475 476 477 478 | Tcl_Free((char*)pNew); return p; } } pNew->interp = pDb->interp; pNew->pDb = pDb; pNew->pScript = 0; | < | 469 470 471 472 473 474 475 476 477 478 479 480 481 482 | Tcl_Free((char*)pNew); return p; } } pNew->interp = pDb->interp; pNew->pDb = pDb; pNew->pScript = 0; pNew->pNext = pDb->pFunc; pDb->pFunc = pNew; return pNew; } /* ** Free a single SqlPreparedStmt object. |
︙ | ︙ | |||
521 522 523 524 525 526 527 | closeIncrblobChannels(pDb); sqlite3_close(pDb->db); while( pDb->pFunc ){ SqlFunc *pFunc = pDb->pFunc; pDb->pFunc = pFunc->pNext; assert( pFunc->pDb==pDb ); Tcl_DecrRefCount(pFunc->pScript); | < < < | 517 518 519 520 521 522 523 524 525 526 527 528 529 530 | closeIncrblobChannels(pDb); sqlite3_close(pDb->db); while( pDb->pFunc ){ SqlFunc *pFunc = pDb->pFunc; pDb->pFunc = pFunc->pNext; assert( pFunc->pDb==pDb ); Tcl_DecrRefCount(pFunc->pScript); Tcl_Free((char*)pFunc); } while( pDb->pCollate ){ SqlCollate *pCollate = pDb->pCollate; pDb->pCollate = pCollate->pNext; Tcl_Free((char*)pCollate); } |
︙ | ︙ | |||
901 902 903 904 905 906 907 | Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zA, nA)); Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zB, nB)); Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT); Tcl_DecrRefCount(pCmd); return (atoi(Tcl_GetStringResult(p->interp))); } | < < < < < < < < < < < < < < | | < < < < < < < < < < < < | < < < < | < < < < < < < < | > | > | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < > > | | | | > | | | | | > | | > > > > > | > > | < < < < | < < < < < < < < < < < | < | | | | | | | | | | | | | | | | | | | | | | | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 | Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zA, nA)); Tcl_ListObjAppendElement(p->interp, pCmd, Tcl_NewStringObj(zB, nB)); Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT); Tcl_DecrRefCount(pCmd); return (atoi(Tcl_GetStringResult(p->interp))); } /* ** This routine is called to evaluate an SQL function implemented ** using TCL script. */ static void tclSqlFunc(sqlite3_context *context, int argc, sqlite3_value**argv){ SqlFunc *p = sqlite3_user_data(context); Tcl_Obj *pCmd; int i; int rc; if( argc==0 ){ /* If there are no arguments to the function, call Tcl_EvalObjEx on the ** script object directly. This allows the TCL compiler to generate ** bytecode for the command on the first invocation and thus make ** subsequent invocations much faster. */ pCmd = p->pScript; Tcl_IncrRefCount(pCmd); rc = Tcl_EvalObjEx(p->interp, pCmd, 0); Tcl_DecrRefCount(pCmd); }else{ /* If there are arguments to the function, make a shallow copy of the ** script object, lappend the arguments, then evaluate the copy. ** ** By "shallow" copy, we mean only the outer list Tcl_Obj is duplicated. ** The new Tcl_Obj contains pointers to the original list elements. ** That way, when Tcl_EvalObjv() is run and shimmers the first element ** of the list to tclCmdNameType, that alternate representation will ** be preserved and reused on the next invocation. */ Tcl_Obj **aArg; int nArg; if( Tcl_ListObjGetElements(p->interp, p->pScript, &nArg, &aArg) ){ sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1); return; } pCmd = Tcl_NewListObj(nArg, aArg); Tcl_IncrRefCount(pCmd); for(i=0; i<argc; i++){ sqlite3_value *pIn = argv[i]; Tcl_Obj *pVal; /* Set pVal to contain the i'th column of this row. */ switch( sqlite3_value_type(pIn) ){ case SQLITE_BLOB: { int bytes = sqlite3_value_bytes(pIn); pVal = Tcl_NewByteArrayObj(sqlite3_value_blob(pIn), bytes); break; } case SQLITE_INTEGER: { sqlite_int64 v = sqlite3_value_int64(pIn); if( v>=-2147483647 && v<=2147483647 ){ pVal = Tcl_NewIntObj((int)v); }else{ pVal = Tcl_NewWideIntObj(v); } break; } case SQLITE_FLOAT: { double r = sqlite3_value_double(pIn); pVal = Tcl_NewDoubleObj(r); break; } case SQLITE_NULL: { pVal = Tcl_NewStringObj(p->pDb->zNull, -1); break; } default: { int bytes = sqlite3_value_bytes(pIn); pVal = Tcl_NewStringObj((char *)sqlite3_value_text(pIn), bytes); break; } } rc = Tcl_ListObjAppendElement(p->interp, pCmd, pVal); if( rc ){ Tcl_DecrRefCount(pCmd); sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1); return; } } if( !p->useEvalObjv ){ /* Tcl_EvalObjEx() will automatically call Tcl_EvalObjv() if pCmd ** is a list without a string representation. To prevent this from ** happening, make sure pCmd has a valid string representation */ Tcl_GetString(pCmd); } rc = Tcl_EvalObjEx(p->interp, pCmd, TCL_EVAL_DIRECT); Tcl_DecrRefCount(pCmd); } if( rc && rc!=TCL_RETURN ){ sqlite3_result_error(context, Tcl_GetStringResult(p->interp), -1); }else{ Tcl_Obj *pVar = Tcl_GetObjResult(p->interp); int n; u8 *data; const char *zType = (pVar->typePtr ? pVar->typePtr->name : ""); char c = zType[0]; if( c=='b' && strcmp(zType,"bytearray")==0 && pVar->bytes==0 ){ /* Only return a BLOB type if the Tcl variable is a bytearray and ** has no string representation. */ data = Tcl_GetByteArrayFromObj(pVar, &n); sqlite3_result_blob(context, data, n, SQLITE_TRANSIENT); }else if( c=='b' && strcmp(zType,"boolean")==0 ){ Tcl_GetIntFromObj(0, pVar, &n); sqlite3_result_int(context, n); }else if( c=='d' && strcmp(zType,"double")==0 ){ double r; Tcl_GetDoubleFromObj(0, pVar, &r); sqlite3_result_double(context, r); }else if( (c=='w' && strcmp(zType,"wideInt")==0) || (c=='i' && strcmp(zType,"int")==0) ){ Tcl_WideInt v; Tcl_GetWideIntFromObj(0, pVar, &v); sqlite3_result_int64(context, v); }else{ data = (unsigned char *)Tcl_GetStringFromObj(pVar, &n); sqlite3_result_text(context, (char *)data, n, SQLITE_TRANSIENT); } } } #ifndef SQLITE_OMIT_AUTHORIZATION /* ** This is the authentication function. It appends the authentication ** type code and the two arguments to zCmd[] then invokes the result ** on the interpreter. The reply is examined to determine if the |
︙ | ︙ | |||
2880 2881 2882 2883 2884 2885 2886 | cd2[1] = (void *)pScript; rc = DbEvalNextCmd(cd2, interp, TCL_OK); } break; } /* | | < < < < < < < < < | < < | | < | | | | < < | | | < < < < < | < < < < | | < < < | | > < < < | < < < < < < | | < < < < < < < < < < < | 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 | cd2[1] = (void *)pScript; rc = DbEvalNextCmd(cd2, interp, TCL_OK); } break; } /* ** $db function NAME [-argcount N] [-deterministic] SCRIPT ** ** Create a new SQL function called NAME. Whenever that function is ** called, invoke SCRIPT to evaluate the function. */ case DB_FUNCTION: { int flags = SQLITE_UTF8; SqlFunc *pFunc; Tcl_Obj *pScript; char *zName; int nArg = -1; int i; if( objc<4 ){ Tcl_WrongNumArgs(interp, 2, objv, "NAME ?SWITCHES? SCRIPT"); return TCL_ERROR; } for(i=3; i<(objc-1); i++){ const char *z = Tcl_GetString(objv[i]); int n = strlen30(z); if( n>2 && strncmp(z, "-argcount",n)==0 ){ if( i==(objc-2) ){ Tcl_AppendResult(interp, "option requires an argument: ", z,(char*)0); return TCL_ERROR; } if( Tcl_GetIntFromObj(interp, objv[i+1], &nArg) ) return TCL_ERROR; if( nArg<0 ){ Tcl_AppendResult(interp, "number of arguments must be non-negative", (char*)0); return TCL_ERROR; } i++; }else if( n>2 && strncmp(z, "-deterministic",n)==0 ){ flags |= SQLITE_DETERMINISTIC; }else{ Tcl_AppendResult(interp, "bad option \"", z, "\": must be -argcount or -deterministic", (char*)0 ); return TCL_ERROR; } } pScript = objv[objc-1]; zName = Tcl_GetStringFromObj(objv[2], 0); pFunc = findSqlFunc(pDb, zName); if( pFunc==0 ) return TCL_ERROR; if( pFunc->pScript ){ Tcl_DecrRefCount(pFunc->pScript); } pFunc->pScript = pScript; Tcl_IncrRefCount(pScript); pFunc->useEvalObjv = safeToUseEvalObjv(interp, pScript); rc = sqlite3_create_function(pDb->db, zName, nArg, flags, pFunc, tclSqlFunc, 0, 0); if( rc!=SQLITE_OK ){ rc = TCL_ERROR; Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE); } break; } |
︙ | ︙ | |||
3972 3973 3974 3975 3976 3977 3978 | ** for additional information. ** ** The EXTERN macros are required by TCL in order to work on windows. */ EXTERN int Sqlite3_Init(Tcl_Interp *interp){ int rc = Tcl_InitStubs(interp, "8.4", 0) ? TCL_OK : TCL_ERROR; if( rc==TCL_OK ){ | < < < < < < < < < < < | < < < < < < < < < | < < | 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 | ** for additional information. ** ** The EXTERN macros are required by TCL in order to work on windows. */ EXTERN int Sqlite3_Init(Tcl_Interp *interp){ int rc = Tcl_InitStubs(interp, "8.4", 0) ? TCL_OK : TCL_ERROR; if( rc==TCL_OK ){ Tcl_CreateObjCommand(interp, "sqlite3", (Tcl_ObjCmdProc*)DbMain, 0, 0); #ifndef SQLITE_3_SUFFIX_ONLY /* The "sqlite" alias is undocumented. It is here only to support ** legacy scripts. All new scripts should use only the "sqlite3" ** command. */ Tcl_CreateObjCommand(interp, "sqlite", (Tcl_ObjCmdProc*)DbMain, 0, 0); #endif rc = Tcl_PkgProvide(interp, "sqlite3", PACKAGE_VERSION); } return rc; } EXTERN int Tclsqlite3_Init(Tcl_Interp *interp){ return Sqlite3_Init(interp); } EXTERN int Sqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; } EXTERN int Tclsqlite3_Unload(Tcl_Interp *interp, int flags){ return TCL_OK; } /* Because it accesses the file-system and uses persistent state, SQLite ** is not considered appropriate for safe interpreters. Hence, we cause ** the _SafeInit() interfaces return TCL_ERROR. */ EXTERN int Sqlite3_SafeInit(Tcl_Interp *interp){ return TCL_ERROR; } EXTERN int Sqlite3_SafeUnload(Tcl_Interp *interp, int flags){return TCL_ERROR;} |
︙ | ︙ |