2021-09-17 20:43:27 +00:00
/*
* * 2010 August 28
* *
* * The author disclaims copyright to this source code . In place of
* * a legal notice , here is a blessing :
* *
* * May you do good and not evil .
* * May you find forgiveness for yourself and forgive others .
* * May you share freely , never taking more than you give .
* *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* * Code for testing all sorts of SQLite interfaces . This code
* * is not included in the SQLite library .
*/
# include "sqlite3.h"
# if defined(INCLUDE_SQLITE_TCL_H)
# include "sqlite_tcl.h"
# else
# include "tcl.h"
# endif
/* Solely for the UNUSED_PARAMETER() macro. */
# include "sqliteInt.h"
# ifdef SQLITE_ENABLE_RTREE
typedef struct BoxGeomCtx BoxGeomCtx ;
struct BoxGeomCtx {
Tcl_Interp * interp ;
Tcl_Obj * pScript ;
} ;
2021-09-29 16:38:02 +00:00
typedef struct BoxQueryCtx BoxQueryCtx ;
struct BoxQueryCtx {
Tcl_Interp * interp ;
Tcl_Obj * pScript ;
} ;
2021-09-18 16:15:54 +00:00
static void testDelUser ( void * pCtx ) {
BoxGeomCtx * p = ( BoxGeomCtx * ) pCtx ;
Tcl_EvalObjEx ( p - > interp , p - > pScript , 0 ) ;
Tcl_DecrRefCount ( p - > pScript ) ;
sqlite3_free ( p ) ;
}
2021-09-17 20:43:27 +00:00
static int invokeTclGeomCb (
const char * zName ,
sqlite3_rtree_geometry * p ,
int nCoord ,
sqlite3_rtree_dbl * aCoord
) {
int rc = SQLITE_OK ;
if ( p - > pContext ) {
char aPtr [ 64 ] ;
BoxGeomCtx * pCtx = ( BoxGeomCtx * ) p - > pContext ;
Tcl_Interp * interp = pCtx - > interp ;
Tcl_Obj * pScript = 0 ;
Tcl_Obj * pParam = 0 ;
Tcl_Obj * pCoord = 0 ;
int ii ;
Tcl_Obj * pRes ;
2021-09-18 16:15:54 +00:00
2021-09-17 20:43:27 +00:00
pScript = Tcl_DuplicateObj ( pCtx - > pScript ) ;
Tcl_IncrRefCount ( pScript ) ;
Tcl_ListObjAppendElement ( interp , pScript , Tcl_NewStringObj ( zName , - 1 ) ) ;
sqlite3_snprintf ( sizeof ( aPtr ) - 1 , aPtr , " %p " , ( void * ) p - > pContext ) ;
Tcl_ListObjAppendElement ( interp , pScript , Tcl_NewStringObj ( aPtr , - 1 ) ) ;
pParam = Tcl_NewObj ( ) ;
for ( ii = 0 ; ii < p - > nParam ; ii + + ) {
Tcl_ListObjAppendElement (
interp , pParam , Tcl_NewDoubleObj ( p - > aParam [ ii ] )
) ;
}
Tcl_ListObjAppendElement ( interp , pScript , pParam ) ;
pCoord = Tcl_NewObj ( ) ;
for ( ii = 0 ; ii < nCoord ; ii + + ) {
Tcl_ListObjAppendElement ( interp , pCoord , Tcl_NewDoubleObj ( aCoord [ ii ] ) ) ;
}
Tcl_ListObjAppendElement ( interp , pScript , pCoord ) ;
sqlite3_snprintf ( sizeof ( aPtr ) - 1 , aPtr , " %p " , ( void * ) p ) ;
Tcl_ListObjAppendElement ( interp , pScript , Tcl_NewStringObj ( aPtr , - 1 ) ) ;
rc = Tcl_EvalObjEx ( interp , pScript , 0 ) ;
2021-09-18 16:15:54 +00:00
if ( rc ! = TCL_OK ) {
rc = SQLITE_ERROR ;
} else {
int nObj = 0 ;
Tcl_Obj * * aObj = 0 ;
pRes = Tcl_GetObjResult ( interp ) ;
if ( Tcl_ListObjGetElements ( interp , pRes , & nObj , & aObj ) ) return TCL_ERROR ;
if ( nObj > 0 ) {
const char * zCmd = Tcl_GetString ( aObj [ 0 ] ) ;
if ( 0 = = sqlite3_stricmp ( zCmd , " zero " ) ) {
p - > aParam [ 0 ] = 0.0 ;
p - > nParam = 1 ;
}
else if ( 0 = = sqlite3_stricmp ( zCmd , " user " ) ) {
if ( p - > pUser | | p - > xDelUser ) {
rc = SQLITE_ERROR ;
} else {
2021-10-22 11:17:29 +00:00
BoxGeomCtx * pBGCtx = sqlite3_malloc ( sizeof ( BoxGeomCtx ) ) ;
if ( pBGCtx = = 0 ) {
2021-09-18 16:15:54 +00:00
rc = SQLITE_NOMEM ;
} else {
2021-10-22 11:17:29 +00:00
pBGCtx - > interp = interp ;
pBGCtx - > pScript = Tcl_DuplicateObj ( pRes ) ;
Tcl_IncrRefCount ( pBGCtx - > pScript ) ;
Tcl_ListObjReplace ( interp , pBGCtx - > pScript , 0 , 1 , 0 , 0 ) ;
p - > pUser = ( void * ) pBGCtx ;
2021-09-18 16:15:54 +00:00
p - > xDelUser = testDelUser ;
}
}
}
else if ( 0 = = sqlite3_stricmp ( zCmd , " user_is_zero " ) ) {
if ( p - > pUser | | p - > xDelUser ) rc = SQLITE_ERROR ;
}
}
2021-09-17 20:43:27 +00:00
}
}
return rc ;
}
/*
# EVIDENCE-OF: R-00693-36727 The legacy xGeom callback is invoked with
# four arguments.
# EVIDENCE-OF: R-50437-53270 The first argument is a pointer to an
# sqlite3_rtree_geometry structure which provides information about how
# the SQL function was invoked.
# EVIDENCE-OF: R-00090-24248 The third argument, aCoord[], is an array
# of nCoord coordinates that defines a bounding box to be tested.
# EVIDENCE-OF: R-28207-40885 The last argument is a pointer into which
# the callback result should be written.
*/
static int box_geom (
sqlite3_rtree_geometry * p , /* R-50437-53270 */
int nCoord , /* R-02424-24769 */
sqlite3_rtree_dbl * aCoord , /* R-00090-24248 */
int * pRes /* R-28207-40885 */
) {
int ii ;
if ( p - > nParam ! = nCoord ) {
invokeTclGeomCb ( " box " , p , nCoord , aCoord ) ;
return SQLITE_ERROR ;
}
if ( invokeTclGeomCb ( " box " , p , nCoord , aCoord ) ) return SQLITE_ERROR ;
for ( ii = 0 ; ii < nCoord ; ii + = 2 ) {
if ( aCoord [ ii ] > p - > aParam [ ii + 1 ] | | aCoord [ ii + 1 ] < p - > aParam [ ii ] ) {
/* R-28207-40885 */
* pRes = 0 ;
return SQLITE_OK ;
}
}
/* R-28207-40885 */
* pRes = 1 ;
return SQLITE_OK ;
}
static int SQLITE_TCLAPI register_box_geom (
void * clientData ,
Tcl_Interp * interp ,
int objc ,
Tcl_Obj * CONST objv [ ]
) {
extern int getDbPointer ( Tcl_Interp * , const char * , sqlite3 * * ) ;
extern const char * sqlite3ErrName ( int ) ;
sqlite3 * db ;
BoxGeomCtx * pCtx ;
char aPtr [ 64 ] ;
if ( objc ! = 3 ) {
Tcl_WrongNumArgs ( interp , 1 , objv , " DB SCRIPT " ) ;
return TCL_ERROR ;
}
if ( getDbPointer ( interp , Tcl_GetString ( objv [ 1 ] ) , & db ) ) return TCL_ERROR ;
pCtx = ( BoxGeomCtx * ) ckalloc ( sizeof ( BoxGeomCtx * ) ) ;
pCtx - > interp = interp ;
pCtx - > pScript = Tcl_DuplicateObj ( objv [ 2 ] ) ;
Tcl_IncrRefCount ( pCtx - > pScript ) ;
2021-09-18 16:15:54 +00:00
sqlite3_rtree_geometry_callback ( db , " box " , box_geom , ( void * ) pCtx ) ;
2021-09-17 20:43:27 +00:00
sqlite3_snprintf ( 64 , aPtr , " %p " , ( void * ) pCtx ) ;
Tcl_SetObjResult ( interp , Tcl_NewStringObj ( aPtr , - 1 ) ) ;
return TCL_OK ;
}
2021-09-29 16:38:02 +00:00
static int box_query ( sqlite3_rtree_query_info * pInfo ) {
const char * azParentWithin [ ] = { " not " , " partly " , " fully " , 0 } ;
BoxQueryCtx * pCtx = ( BoxQueryCtx * ) pInfo - > pContext ;
Tcl_Interp * interp = pCtx - > interp ;
Tcl_Obj * pEval ;
Tcl_Obj * pArg ;
Tcl_Obj * pTmp = 0 ;
int rc ;
int ii ;
pEval = Tcl_DuplicateObj ( pCtx - > pScript ) ;
Tcl_IncrRefCount ( pEval ) ;
pArg = Tcl_NewObj ( ) ;
Tcl_IncrRefCount ( pArg ) ;
/* aParam[] */
pTmp = Tcl_NewObj ( ) ;
Tcl_IncrRefCount ( pTmp ) ;
for ( ii = 0 ; ii < pInfo - > nParam ; ii + + ) {
Tcl_Obj * p = Tcl_NewDoubleObj ( pInfo - > aParam [ ii ] ) ;
Tcl_ListObjAppendElement ( interp , pTmp , p ) ;
}
Tcl_ListObjAppendElement ( interp , pArg , Tcl_NewStringObj ( " aParam " , - 1 ) ) ;
Tcl_ListObjAppendElement ( interp , pArg , pTmp ) ;
Tcl_DecrRefCount ( pTmp ) ;
/* aCoord[] */
pTmp = Tcl_NewObj ( ) ;
Tcl_IncrRefCount ( pTmp ) ;
for ( ii = 0 ; ii < pInfo - > nCoord ; ii + + ) {
Tcl_Obj * p = Tcl_NewDoubleObj ( pInfo - > aCoord [ ii ] ) ;
Tcl_ListObjAppendElement ( interp , pTmp , p ) ;
}
Tcl_ListObjAppendElement ( interp , pArg , Tcl_NewStringObj ( " aCoord " , - 1 ) ) ;
Tcl_ListObjAppendElement ( interp , pArg , pTmp ) ;
Tcl_DecrRefCount ( pTmp ) ;
/* anQueue[] */
pTmp = Tcl_NewObj ( ) ;
Tcl_IncrRefCount ( pTmp ) ;
for ( ii = 0 ; ii < = pInfo - > mxLevel ; ii + + ) {
Tcl_Obj * p = Tcl_NewIntObj ( ( int ) pInfo - > anQueue [ ii ] ) ;
Tcl_ListObjAppendElement ( interp , pTmp , p ) ;
}
Tcl_ListObjAppendElement ( interp , pArg , Tcl_NewStringObj ( " anQueue " , - 1 ) ) ;
Tcl_ListObjAppendElement ( interp , pArg , pTmp ) ;
Tcl_DecrRefCount ( pTmp ) ;
/* iLevel */
Tcl_ListObjAppendElement ( interp , pArg , Tcl_NewStringObj ( " iLevel " , - 1 ) ) ;
Tcl_ListObjAppendElement ( interp , pArg , Tcl_NewIntObj ( pInfo - > iLevel ) ) ;
/* mxLevel */
Tcl_ListObjAppendElement ( interp , pArg , Tcl_NewStringObj ( " mxLevel " , - 1 ) ) ;
Tcl_ListObjAppendElement ( interp , pArg , Tcl_NewIntObj ( pInfo - > mxLevel ) ) ;
/* iRowid */
Tcl_ListObjAppendElement ( interp , pArg , Tcl_NewStringObj ( " iRowid " , - 1 ) ) ;
Tcl_ListObjAppendElement ( interp , pArg , Tcl_NewWideIntObj ( pInfo - > iRowid ) ) ;
/* rParentScore */
Tcl_ListObjAppendElement ( interp , pArg , Tcl_NewStringObj ( " rParentScore " , - 1 ) ) ;
Tcl_ListObjAppendElement ( interp , pArg , Tcl_NewDoubleObj ( pInfo - > rParentScore ) ) ;
/* eParentWithin */
assert ( pInfo - > eParentWithin = = 0
| | pInfo - > eParentWithin = = 1
| | pInfo - > eParentWithin = = 2
) ;
Tcl_ListObjAppendElement ( interp , pArg , Tcl_NewStringObj ( " eParentWithin " , - 1 ) ) ;
Tcl_ListObjAppendElement ( interp , pArg ,
Tcl_NewStringObj ( azParentWithin [ pInfo - > eParentWithin ] , - 1 )
) ;
Tcl_ListObjAppendElement ( interp , pEval , pArg ) ;
rc = Tcl_EvalObjEx ( interp , pEval , 0 ) ? SQLITE_ERROR : SQLITE_OK ;
if ( rc = = SQLITE_OK ) {
double rScore = 0.0 ;
int nObj = 0 ;
int eP = 0 ;
Tcl_Obj * * aObj = 0 ;
Tcl_Obj * pRes = Tcl_GetObjResult ( interp ) ;
if ( Tcl_ListObjGetElements ( interp , pRes , & nObj , & aObj )
| | nObj ! = 2
| | Tcl_GetDoubleFromObj ( interp , aObj [ 1 ] , & rScore )
| | Tcl_GetIndexFromObj ( interp , aObj [ 0 ] , azParentWithin , " value " , 0 , & eP )
) {
rc = SQLITE_ERROR ;
} else {
pInfo - > rScore = rScore ;
pInfo - > eParentWithin = eP ;
}
}
Tcl_DecrRefCount ( pArg ) ;
Tcl_DecrRefCount ( pEval ) ;
return rc ;
}
static void box_query_destroy ( void * p ) {
BoxQueryCtx * pCtx = ( BoxQueryCtx * ) p ;
Tcl_DecrRefCount ( pCtx - > pScript ) ;
2021-12-31 18:26:50 +00:00
ckfree ( ( char * ) pCtx ) ;
2021-09-29 16:38:02 +00:00
}
2021-09-17 20:43:27 +00:00
static int SQLITE_TCLAPI register_box_query (
void * clientData ,
Tcl_Interp * interp ,
int objc ,
Tcl_Obj * CONST objv [ ]
) {
extern int getDbPointer ( Tcl_Interp * , const char * , sqlite3 * * ) ;
extern const char * sqlite3ErrName ( int ) ;
sqlite3 * db ;
2021-09-29 16:38:02 +00:00
BoxQueryCtx * pCtx ;
2021-09-17 20:43:27 +00:00
if ( objc ! = 3 ) {
Tcl_WrongNumArgs ( interp , 1 , objv , " DB SCRIPT " ) ;
return TCL_ERROR ;
}
if ( getDbPointer ( interp , Tcl_GetString ( objv [ 1 ] ) , & db ) ) return TCL_ERROR ;
2022-02-22 15:47:55 +00:00
pCtx = ( BoxQueryCtx * ) ckalloc ( sizeof ( BoxQueryCtx ) ) ;
2021-09-29 16:38:02 +00:00
pCtx - > interp = interp ;
pCtx - > pScript = Tcl_DuplicateObj ( objv [ 2 ] ) ;
Tcl_IncrRefCount ( pCtx - > pScript ) ;
sqlite3_rtree_query_callback (
db , " qbox " , box_query , ( void * ) pCtx , box_query_destroy
) ;
Tcl_ResetResult ( interp ) ;
2021-09-17 20:43:27 +00:00
return TCL_OK ;
}
# endif /* SQLITE_ENABLE_RTREE */
int Sqlitetestrtreedoc_Init ( Tcl_Interp * interp ) {
# ifdef SQLITE_ENABLE_RTREE
Tcl_CreateObjCommand ( interp , " register_box_geom " , register_box_geom , 0 , 0 ) ;
Tcl_CreateObjCommand ( interp , " register_box_query " , register_box_query , 0 , 0 ) ;
# endif /* SQLITE_ENABLE_RTREE */
return TCL_OK ;
}