simcop2387/DBD-SQLite-SQLcipher
1
0
Fork 0
mirror of https://github.com/DBD-SQLite/DBD-SQLite synced 2025-06-07 14:19:10 -04:00
Code Issues Releases Wiki Activity

initial support for virtual tables in Perl (WORK IN PROGRESS)

Browse source
This commit is contained in:
Laurent Dami 2014-07-04 10:07:19 +02:00
parent b6d9f86716
commit 78984a9de8
12 changed files with 1704 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
MANIFEST
View file

@ -7,6 +7,8 @@ inc/Test/NoWarnings/Warning.pm
lib/DBD/SQLite.pm
lib/DBD/SQLite/Cookbook.pod
lib/DBD/SQLite/Fulltext_search.pod
lib/DBD/SQLite/VirtualTable.pm
lib/DBD/SQLite/VirtualTable/Filesys.pm
LICENSE
Makefile.PL
MANIFEST This list of files
@ -107,6 +109,9 @@ t/rt_78833_utf8_flag_for_column_names.t
t/rt_81536_multi_column_primary_key_info.t
t/rt_88228_sqlite_3_8_0_crash.t
t/rt_96878_fts_contentless_table.t
t/virtual_table/00_base.t
t/virtual_table/01_destroy.t
t/virtual_table/10_filesys.t
typemap
util/getsqlite.pl
xt/meta.t

3
Makefile.PL
View file

@ -367,6 +367,9 @@ WriteMakefile(
clean => {
FILES => 'SQLite.xsi config.h tv.log *.old',
},
test => {
TESTS => 't/*.t t/**/*.t',
},
PL_FILES => {},
EXE_FILES => [],

15
SQLite.xs
View file

@ -283,6 +283,21 @@ db_status(dbh, reset = 0)
RETVAL
static int
create_module(dbh, name, perl_class)
SV *dbh
char *name
char *perl_class
ALIAS:
DBD::SQLite::db::sqlite_create_module = 1
CODE:
{
RETVAL = sqlite_db_create_module(aTHX_ dbh, name, perl_class);
}
OUTPUT:
RETVAL
MODULE = DBD::SQLite PACKAGE = DBD::SQLite::st
PROTOTYPES: DISABLE

822
dbdimp.c
View file

@ -1,3 +1,12 @@
/* -*- c-basic-offset: 4; -*- */
/* TODO : refactoring
- generalized use of stacked_sv_from_sqlite3_value
- decide about policy for errors in vtab methods : use G_EVAL or just die?
- find better name instead of "perl_instance"
*/
#define PERL_NO_GET_CONTEXT
#define NEED_newSVpvn_flags
@ -27,8 +36,7 @@ DBISTATE_DECLARE;
/*-----------------------------------------------------*
* Globals
*-----------------------------------------------------*/
imp_dbh_t *last_executed_dbh; /* needed by perl_tokenizer
to know if unicode is on/off */
imp_dbh_t *last_prepared_dbh; /* see _last_dbh_is_unicode() */
/*-----------------------------------------------------*
@ -42,6 +50,15 @@ imp_dbh_t *last_executed_dbh; /* needed by perl_tokenizer
#define sqlite_open2(dbname,db,flags) _sqlite_open(aTHX_ dbh, dbname, db, flags)
#define _isspace(c) (c == ' ' || c == '\t' || c == '\n' || c == '\r' || c == '\v' || c == '\f')
int _last_dbh_is_unicode() {
/* some functions need to know if the unicode flag is on, but
don't have a dbh pointer ... so unfortunately the only way is
to use a global variable */
return last_prepared_dbh && last_prepared_dbh->unicode;
}
static void
_sqlite_trace(pTHX_ char *file, int line, SV *h, imp_xxh_t *imp_xxh, const char *what)
{
@ -134,6 +151,56 @@ sqlite_type_from_odbc_type(int type)
}
}
SV *
stacked_sv_from_sqlite3_value(pTHX_ sqlite3_value *value, int is_unicode)
{
STRLEN len;
sqlite_int64 iv;
int type = sqlite3_value_type(value);
switch(type) {
case SQLITE_INTEGER:
iv = sqlite3_value_int64(value);
if ( iv >= IV_MIN && iv <= IV_MAX ) {
/* ^^^ compile-time constant (= true) when IV == int64 */
return sv_2mortal(newSViv((IV)iv));
}
else if ( iv >= 0 && iv <= UV_MAX ) {
/* warn("integer overflow, cast to UV"); */
return sv_2mortal(newSVuv((UV)iv));
}
else {
/* warn("integer overflow, cast to NV"); */
return sv_2mortal(newSVnv((NV)iv));
}
case SQLITE_FLOAT:
return sv_2mortal(newSVnv(sqlite3_value_double(value)));
break;
case SQLITE_TEXT:
len = sqlite3_value_bytes(value);
SV *sv = newSVpvn((const char *)sqlite3_value_text(value), len);
if (is_unicode) {
SvUTF8_on(sv);
}
return sv_2mortal(sv);
case SQLITE_BLOB:
len = sqlite3_value_bytes(value);
return sv_2mortal(newSVpvn(sqlite3_value_blob(value), len));
default:
return &PL_sv_undef;
}
}
static void
sqlite_set_result(pTHX_ sqlite3_context *context, SV *result, int is_error)
{
@ -593,6 +660,8 @@ sqlite_st_prepare(SV *sth, imp_sth_t *imp_sth, char *statement, SV *attribs)
const char *extra;
D_imp_dbh_from_sth;
last_prepared_dbh = imp_dbh;
if (!DBIc_ACTIVE(imp_dbh)) {
sqlite_error(sth, -2, "attempt to prepare on inactive database handle");
return FALSE; /* -> undef in lib/DBD/SQLite.pm */
@ -665,8 +734,6 @@ sqlite_st_execute(SV *sth, imp_sth_t *imp_sth)
croak_if_db_is_null();
croak_if_stmt_is_null();
last_executed_dbh = imp_dbh;
/* COMPAT: sqlite3_sql is only available for 3006000 or newer */
sqlite_trace(sth, imp_sth, 3, form("executing %s", sqlite3_sql(imp_sth->stmt)));
@ -1416,6 +1483,8 @@ sqlite_db_func_dispatcher(int is_unicode, sqlite3_context *context, int argc, sq
PUSHMARK(SP);
for ( i=0; i < argc; i++ ) {
/* TODO: XPUSHs(stacked_sv_from_sqlite3_value(aTHX_ value[i], is_unicode)); */
SV *arg;
STRLEN len;
int type = sqlite3_value_type(value[i]);
@ -1458,6 +1527,7 @@ sqlite_db_func_dispatcher(int is_unicode, sqlite3_context *context, int argc, sq
}
XPUSHs(arg);
}
PUTBACK;
@ -1705,9 +1775,14 @@ sqlite_db_aggr_step_dispatcher(sqlite3_context *context,
if ( aggr->err || !aggr->aggr_inst )
goto cleanup;
int is_unicode = 0; /* TODO : find out from db handle */
PUSHMARK(SP);
XPUSHs( sv_2mortal( newSVsv( aggr->aggr_inst ) ));
for ( i=0; i < argc; i++ ) {
/* TODO: XPUSHs(stacked_sv_from_sqlite3_value(aTHX_ value[i], is_unicode)); */
SV *arg;
int len = sqlite3_value_bytes(value[i]);
int type = sqlite3_value_type(value[i]);
@ -2587,7 +2662,7 @@ static int perl_tokenizer_Open(
flags = SVs_TEMP; /* will call sv_2mortal */
/* special handling if working with utf8 strings */
if (last_executed_dbh->unicode) { /* global var ... no better way ! */
if (_last_dbh_is_unicode()) {
/* data to keep track of byte offsets */
c->lastByteOffset = c->pInput = pInput;
@ -2769,4 +2844,741 @@ int sqlite_db_register_fts3_perl_tokenizer(pTHX_ SV *dbh)
return sqlite3_finalize(pStmt);
}
/***********************************************************************
** The set of routines that implement the perl "module"
** (i.e support for virtual table)
************************************************************************/
typedef struct perl_vtab {
sqlite3_vtab base;
SV *perl_vtab_instance;
} perl_vtab;
typedef struct perl_vtab_cursor {
sqlite3_vtab_cursor base;
SV *perl_cursor_instance;
} perl_vtab_cursor;
typedef struct perl_vtab_init {
SV *dbh;
const char *perl_class;
} perl_vtab_init;
static int _call_perl_vtab_method(sqlite3_vtab *pVTab, const char *method) {
dTHX;
dSP;
ENTER;
SAVETMPS;
int count;
PUSHMARK(SP);
XPUSHs(((perl_vtab *) pVTab)->perl_vtab_instance);
PUTBACK;
count = call_method (method, G_VOID);
SPAGAIN;
SP -= count;
PUTBACK;
FREETMPS;
LEAVE;
return SQLITE_OK;
}
static int _call_perl_vtab_method_int(sqlite3_vtab *pVTab,
const char *method, int i) {
dTHX;
dSP;
ENTER;
SAVETMPS;
int count;
PUSHMARK(SP);
XPUSHs(((perl_vtab *) pVTab)->perl_vtab_instance);
XPUSHs(sv_2mortal(newSViv(i)));
PUTBACK;
count = call_method (method, G_VOID);
SPAGAIN;
SP -= count;
PUTBACK;
FREETMPS;
LEAVE;
return SQLITE_OK;
}
static int perl_vt_New(const char *method,
sqlite3 *db, void *pAux,
int argc, const char *const *argv,
sqlite3_vtab **ppVTab, char **pzErr){
dTHX;
dSP;
perl_vtab *vt;
perl_vtab_init *init_data = (perl_vtab_init *)pAux;
int count, i;
/* allocate a perl_vtab structure */
vt = (perl_vtab *) sqlite3_malloc(sizeof(*vt));
if( vt==NULL ) return SQLITE_NOMEM;
memset(vt, 0, sizeof(*vt));
ENTER;
SAVETMPS;
/* call the ->CREATE/CONNECT() method */
PUSHMARK(SP);
XPUSHs(sv_2mortal(newSVpv(init_data->perl_class, 0)));
XPUSHs(init_data->dbh);
for(i = 0; i < argc; i++) {
XPUSHs(newSVpvn_flags(argv[i], strlen(argv[i]), SVs_TEMP|SVf_UTF8));
}
PUTBACK;
count = call_method (method, G_SCALAR);
SPAGAIN;
/* check the return value */
if ( count != 1 ) {
*pzErr = sqlite3_mprintf("vtab->NEW() should return one value, got %d",
count );
SP -= count; /* Clear the stack */
goto cleanup;
}
/* get the VirtualTable instance */
SV *perl_instance = POPs;
if ( !sv_isobject(perl_instance) ) {
*pzErr = sqlite3_mprintf("vtab->NEW() should return a blessed reference");
goto cleanup;
}
/* call the ->DECLARE_VTAB() method */
PUSHMARK(SP);
XPUSHs(perl_instance);
PUTBACK;
count = call_method ("VTAB_TO_DECLARE", G_SCALAR);
SPAGAIN;
/* check the return value */
if (count != 1 ) {
int i;
*pzErr = sqlite3_mprintf("vtab->VTAB_TO_DECLARE() should return one value, got %d",
count );
SP -= count; /* Clear the stack */
goto cleanup;
}
/* call sqlite3_declare_vtab with the sql returned from
method VTAB_TO_DECLARE(), converted to utf8 */
SV *sql = POPs;
int rc;
rc = sqlite3_declare_vtab(db, SvPVutf8_nolen(sql));
/* record the VirtualTable perl instance within the vtab structure */
vt->perl_vtab_instance = SvREFCNT_inc(perl_instance);
cleanup:
*ppVTab = &vt->base;
PUTBACK;
FREETMPS;
LEAVE;
return SQLITE_OK;
}
static int perl_vt_Create(sqlite3 *db, void *pAux,
int argc, const char *const *argv,
sqlite3_vtab **ppVTab, char **pzErr){
return perl_vt_New("CREATE", db, pAux, argc, argv, ppVTab, pzErr);
}
static int perl_vt_Connect(sqlite3 *db, void *pAux,
int argc, const char *const *argv,
sqlite3_vtab **ppVTab, char **pzErr){
return perl_vt_New("CONNECT", db, pAux, argc, argv, ppVTab, pzErr);
}
static int perl_vt_Disconnect(sqlite3_vtab *pVTab){
dTHX;
_call_perl_vtab_method(pVTab, "DISCONNECT");
perl_vtab *perl_pVTab = (perl_vtab *) pVTab;
SvREFCNT_dec(perl_pVTab->perl_vtab_instance);
sqlite3_free(perl_pVTab);
return SQLITE_OK;
}
static int perl_vt_Drop(sqlite3_vtab *pVTab){
dTHX;
_call_perl_vtab_method(pVTab, "DROP");
perl_vtab *perl_pVTab = (perl_vtab *) pVTab;
SvREFCNT_dec(perl_pVTab->perl_vtab_instance);
sqlite3_free(perl_pVTab);
return SQLITE_OK;
}
static char *
op2str(unsigned char op) {
switch (op) {
case SQLITE_INDEX_CONSTRAINT_EQ:
return "=";
case SQLITE_INDEX_CONSTRAINT_GT:
return ">";
case SQLITE_INDEX_CONSTRAINT_LE:
return "<=";
case SQLITE_INDEX_CONSTRAINT_LT:
return "<";
case SQLITE_INDEX_CONSTRAINT_GE:
return ">=";
case SQLITE_INDEX_CONSTRAINT_MATCH:
return "MATCH";
default:
return "unknown";
}
}
static int perl_vt_BestIndex(sqlite3_vtab *pVTab, sqlite3_index_info *pIdxInfo){
int i, count;
dTHX;
dSP;
ENTER;
SAVETMPS;
/* build the "where_constraints" datastructure */
AV *constraints = newAV();
for (i=0; i<pIdxInfo->nConstraint; i++){
struct sqlite3_index_constraint const *pCons = &pIdxInfo->aConstraint[i];
HV *constraint = newHV();
hv_stores(constraint, "col", newSViv(pCons->iColumn));
hv_stores(constraint, "op", newSVpv(op2str(pCons->op), 0));
hv_stores(constraint, "usable", pCons->usable ? &PL_sv_yes : &PL_sv_no);
av_push(constraints, newRV_noinc((SV*) constraint));
}
/* build the "order_by" datastructure */
AV *order_by = newAV();
for (i=0; i<pIdxInfo->nOrderBy; i++){
struct sqlite3_index_orderby const *pOrder = &pIdxInfo->aOrderBy[i];
HV *order = newHV();
hv_stores(order, "col", newSViv(pOrder->iColumn));
hv_stores(order, "desc", pOrder->desc ? &PL_sv_yes : &PL_sv_no);
av_push( order_by, newRV_noinc((SV*) order));
}
/* call the ->best_index() method */
PUSHMARK(SP);
XPUSHs( ((perl_vtab *) pVTab)->perl_vtab_instance);
XPUSHs( sv_2mortal( newRV_noinc((SV*) constraints)));
XPUSHs( sv_2mortal( newRV_noinc((SV*) order_by)));
PUTBACK;
count = call_method ("BEST_INDEX", G_SCALAR);
SPAGAIN;
/* get values back from the returned hashref */
if (count != 1)
croak("BEST_INDEX() method returned %d vals instead of 1", count);
SV *hashref = POPs;
if (!(hashref && SvROK(hashref) && SvTYPE(SvRV(hashref)) == SVt_PVHV))
croak("BEST_INDEX() method did not return a hashref");
HV *hv = (HV*)SvRV(hashref);
SV **val;
val = hv_fetch(hv, "idxNum", 6, FALSE);
pIdxInfo->idxNum = (val && SvOK(*val)) ? SvIV(*val) : 0;
val = hv_fetch(hv, "idxStr", 6, FALSE);
if (val && SvOK(*val)) {
char *str = SvPVutf8_nolen(*val);
pIdxInfo->idxStr = sqlite3_mprintf(str);
pIdxInfo->needToFreeIdxStr = 1;
}
val = hv_fetch(hv, "orderByConsumed", 15, FALSE);
pIdxInfo->orderByConsumed = (val && SvTRUE(*val)) ? 1 : 0;
val = hv_fetch(hv, "estimatedCost", 13, FALSE);
pIdxInfo->estimatedCost = (val && SvOK(*val)) ? SvNV(*val) : 0;
val = hv_fetch(hv, "estimatedRows", 13, FALSE);
pIdxInfo->estimatedRows = (val && SvOK(*val)) ? SvIV(*val) : 0;
/* loop over constraints to get back the "argvIndex" and "omit" keys
that shoud have been added by the best_index() method call */
for (i=0; i<pIdxInfo->nConstraint; i++){
struct sqlite3_index_constraint_usage *pConsUsage
= &pIdxInfo->aConstraintUsage[i];
SV **rv = av_fetch(constraints, i, FALSE);
if (!(rv && SvROK(*rv) && SvTYPE(SvRV(*rv)) == SVt_PVHV))
croak("the call to BEST_INDEX() has corrupted constraint data");
HV *hv = (HV*)SvRV(*rv);
SV **val;
val = hv_fetch(hv, "argvIndex", 9, FALSE);
int argvIndex = (val && SvOK(*val)) ? SvIV(*val) + 1: 0;
pConsUsage->argvIndex = argvIndex;
val = hv_fetch(hv, "omit", 4, FALSE);
pConsUsage->omit = (val && SvTRUE(*val)) ? 1 : 0;
}
PUTBACK;
FREETMPS;
LEAVE;
return SQLITE_OK;
}
static int perl_vt_Open(sqlite3_vtab *pVTab, sqlite3_vtab_cursor **ppCursor){
dTHX;
dSP;
ENTER;
SAVETMPS;
int count;
/* call the ->OPEN() method */
PUSHMARK(SP);
XPUSHs( ((perl_vtab *) pVTab)->perl_vtab_instance);
PUTBACK;
count = call_method ("OPEN", G_SCALAR);
SPAGAIN;
if (count != 1)
croak("vtab->OPEN() method returned %d vals instead of 1", count);
SV *perl_cursor = POPs;
if ( !sv_isobject(perl_cursor) )
croak("vtab->OPEN() method did not return a blessed cursor");
/* allocate a perl_vtab_cursor structure */
perl_vtab_cursor *cursor;
cursor = (perl_vtab_cursor *) sqlite3_malloc(sizeof(*cursor));
if( cursor==NULL ) return SQLITE_NOMEM;
memset(cursor, 0, sizeof(*cursor));
cursor->perl_cursor_instance = SvREFCNT_inc(perl_cursor);
/* return that cursor */
*ppCursor = &cursor->base;
PUTBACK;
FREETMPS;
LEAVE;
return SQLITE_OK;
}
static int perl_vt_Close(sqlite3_vtab_cursor *pVtabCursor){
dTHX;
dSP;
ENTER;
SAVETMPS;
int count;
/* call the close() method */
PUSHMARK(SP);
XPUSHs(((perl_vtab_cursor *) pVtabCursor)->perl_cursor_instance);
PUTBACK;
count = call_method("CLOSE", G_VOID);
SPAGAIN;
SP -= count;
perl_vtab_cursor *perl_pVTabCursor = (perl_vtab_cursor *) pVtabCursor;
SvREFCNT_dec(perl_pVTabCursor->perl_cursor_instance);
sqlite3_free(perl_pVTabCursor);
PUTBACK;
FREETMPS;
LEAVE;
return SQLITE_OK;
}
static int perl_vt_Filter(
sqlite3_vtab_cursor *pVtabCursor,
int idxNum, const char *idxStr,
int argc, sqlite3_value **argv
){
dTHX;
dSP;
ENTER;
SAVETMPS;
int i, count;
int is_unicode = _last_dbh_is_unicode();
/* call the FILTER() method with ($idxNum, $idxStr, @args) */
PUSHMARK(SP);
XPUSHs(((perl_vtab_cursor *) pVtabCursor)->perl_cursor_instance);
XPUSHs(sv_2mortal(newSViv(idxNum)));
XPUSHs(sv_2mortal(newSVpv(idxStr, 0)));
for(i = 0; i < argc; i++) {
XPUSHs(stacked_sv_from_sqlite3_value(aTHX_ argv[i], is_unicode));
}
PUTBACK;
count = call_method("FILTER", G_VOID);
SPAGAIN;
SP -= count;
PUTBACK;
FREETMPS;
LEAVE;
return SQLITE_OK;
}
static int perl_vt_Next(sqlite3_vtab_cursor *pVtabCursor){
dTHX;
dSP;
ENTER;
SAVETMPS;
int i, count;
/* call the next() method */
PUSHMARK(SP);
XPUSHs(((perl_vtab_cursor *) pVtabCursor)->perl_cursor_instance);
PUTBACK;
count = call_method ("NEXT", G_VOID);
SPAGAIN;
SP -= count;
PUTBACK;
FREETMPS;
LEAVE;
return SQLITE_OK;
}
static int perl_vt_Eof(sqlite3_vtab_cursor *pVtabCursor){
dTHX;
dSP;
ENTER;
SAVETMPS;
int count, eof;
/* call the eof() method */
PUSHMARK(SP);
XPUSHs(((perl_vtab_cursor *) pVtabCursor)->perl_cursor_instance);
PUTBACK;
count = call_method ("EOF", G_SCALAR);
SPAGAIN;
if (count != 1) {
warn("cursor->EOF() method returned %d vals instead of 1", count);
SP -= count;
}
else {
SV *sv = POPs; /* need 2 lines, because this doesn't work : */
eof = SvTRUE(sv); /* eof = SvTRUE(POPs); # I don't understand why :-( */
}
PUTBACK;
FREETMPS;
LEAVE;
return eof;
}
static int perl_vt_Column(sqlite3_vtab_cursor *pVtabCursor,
sqlite3_context* context,
int col){
dTHX;
dSP;
ENTER;
SAVETMPS;
int count;
/* call the column() method */
PUSHMARK(SP);
XPUSHs(((perl_vtab_cursor *) pVtabCursor)->perl_cursor_instance);
XPUSHs(sv_2mortal(newSViv(col)));
PUTBACK;
count = call_method ("COLUMN", G_SCALAR);
SPAGAIN;
if (count != 1) {
warn("cursor->COLUMN() method returned %d vals instead of 1", count);
SP -= count;
sqlite3_result_error(context, "column error", 12);
}
else {
SV *result = POPs;
sqlite_set_result(aTHX_ context, result, 0 );
}
PUTBACK;
FREETMPS;
LEAVE;
return SQLITE_OK;
}
static int perl_vt_Rowid(sqlite3_vtab_cursor *pVtabCursor, sqlite3_int64 *pRowid){
dTHX;
dSP;
ENTER;
SAVETMPS;
int count;
/* call the rowid() method */
PUSHMARK(SP);
XPUSHs(((perl_vtab_cursor *) pVtabCursor)->perl_cursor_instance);
PUTBACK;
count = call_method ("ROWID", G_SCALAR);
SPAGAIN;
if (count != 1) {
warn("cursor->ROWID() returned %d vals instead of 1", count);
SP -= count;
}
else {
*pRowid =POPi;
}
PUTBACK;
FREETMPS;
LEAVE;
return SQLITE_OK;
}
static int perl_vt_Update(sqlite3_vtab *pVTab,
int argc, sqlite3_value **argv,
sqlite3_int64 *pRowid){
dTHX;
dSP;
ENTER;
SAVETMPS;
int count, i;
int is_unicode = _last_dbh_is_unicode();
/* call the update() method */
PUSHMARK(SP);
XPUSHs(((perl_vtab *) pVTab)->perl_vtab_instance);
for(i = 0; i < argc; i++) {
XPUSHs(stacked_sv_from_sqlite3_value(aTHX_ argv[i], is_unicode));
}
PUTBACK;
count = call_method ("_SQLITE_UPDATE", G_SCALAR);
SPAGAIN;
if (count != 1) {
warn("cursor->_SQLITE_UPDATE() returned %d vals instead of 1", count);
SP -= count;
}
else if (argc > 1 && sqlite3_value_type(argv[0]) == SQLITE_NULL
&& sqlite3_value_type(argv[1]) == SQLITE_NULL) {
/* this was an insert without any given rowid, so the result of
the method call must be passed in *pRowid*/
SV *rowidsv = POPs;
if (!SvOK(rowidsv))
*pRowid = 0;
else if (SvUOK(rowidsv))
*pRowid = SvUV(rowidsv);
else if (SvIOK(rowidsv))
*pRowid = SvIV(rowidsv);
else
*pRowid = SvNV(rowidsv);
}
PUTBACK;
FREETMPS;
LEAVE;
return SQLITE_OK;
}
static int perl_vt_Begin(sqlite3_vtab *pVTab){
return _call_perl_vtab_method(pVTab, "BEGIN_TRANSACTION");
}
static int perl_vt_Sync(sqlite3_vtab *pVTab){
return _call_perl_vtab_method(pVTab, "SYNC_TRANSACTION");
}
static int perl_vt_Commit(sqlite3_vtab *pVTab){
return _call_perl_vtab_method(pVTab, "COMMIT_TRANSACTION");
}
static int perl_vt_Rollback(sqlite3_vtab *pVTab){
return _call_perl_vtab_method(pVTab, "ROLLBACK_TRANSACTION");
}
static int perl_vt_FindMethod(sqlite3_vtab *pVtab, int nArg, const char *zName,
void (**pxFunc)(sqlite3_context*,int,sqlite3_value**),
void **ppArg){
croak("VT_FINDMETHOD: not implemented yet"); /* TODO */
return SQLITE_OK;
}
static int perl_vt_Rename(sqlite3_vtab *pVTab, const char *zNew){
dTHX;
dSP;
ENTER;
SAVETMPS;
int count;
int rc = SQLITE_ERROR;
PUSHMARK(SP);
XPUSHs(((perl_vtab *) pVTab)->perl_vtab_instance);
XPUSHs(sv_2mortal(newSVpv(zNew, 0)));
PUTBACK;
count = call_method("RENAME", G_SCALAR);
SPAGAIN;
if (count != 1) {
warn("vtab->RENAME() returned %d args instead of 1", count);
SP -= count;
}
else {
rc = POPi;
}
PUTBACK;
FREETMPS;
LEAVE;
return rc;
}
static int perl_vt_Savepoint(sqlite3_vtab *pVTab, int point){
return _call_perl_vtab_method_int(pVTab, "SAVEPOINT", point);
}
static int perl_vt_Release(sqlite3_vtab *pVTab, int point){
return _call_perl_vtab_method_int(pVTab, "RELEASE", point);
}
static int perl_vt_RollbackTo(sqlite3_vtab *pVTab, int point){
return _call_perl_vtab_method_int(pVTab, "ROLLBACK_TO", point);
}
static sqlite3_module perl_vt_Module = {
1, /* iVersion */
perl_vt_Create, /* xCreate */
perl_vt_Connect, /* xConnect */
perl_vt_BestIndex, /* xBestIndex */
perl_vt_Disconnect, /* xDisconnect */
perl_vt_Drop, /* xDestroy */
perl_vt_Open, /* xOpen - open a cursor */
perl_vt_Close, /* xClose - close a cursor */
perl_vt_Filter, /* xFilter - configure scan constraints */
perl_vt_Next, /* xNext - advance a cursor */
perl_vt_Eof, /* xEof - check for end of scan */
perl_vt_Column, /* xColumn - read data */
perl_vt_Rowid, /* xRowid - read data */
perl_vt_Update, /* xUpdate (optional) */
perl_vt_Begin, /* xBegin (optional) */
perl_vt_Sync, /* xSync (optional) */
perl_vt_Commit, /* xCommit (optional) */
perl_vt_Rollback, /* xRollback (optional) */
/* perl_vt_FindMethod, /\* xFindMethod (optional) *\/ */
NULL, /* xFindMethod not implemented yet */
perl_vt_Rename, /* xRename */
perl_vt_Savepoint, /* xSavepoint (optional) */
perl_vt_Release, /* xRelease (optional) */
perl_vt_RollbackTo /* xRollbackTo (optional) */
};
void
sqlite_db_destroy_module_data(void *pAux)
{
dTHX;
dSP;
ENTER;
SAVETMPS;
int count;
int rc = SQLITE_ERROR;
perl_vtab_init *init_data = (perl_vtab_init *)pAux;
/* call the DESTROY_MODULE() method */
PUSHMARK(SP);
XPUSHs(sv_2mortal(newSVpv(init_data->perl_class, 0)));
PUTBACK;
count = call_method("DESTROY_MODULE", G_VOID);
SPAGAIN;
SP -= count;
/* free module memory */
SvREFCNT_dec(init_data->dbh);
sqlite3_free((char *)init_data->perl_class);
PUTBACK;
FREETMPS;
LEAVE;
}
int
sqlite_db_create_module(pTHX_ SV *dbh, const char *name, const char *perl_class)
{
D_imp_dbh(dbh);
int rc;
if (!DBIc_ACTIVE(imp_dbh)) {
sqlite_error(dbh, -2, "attempt to create module on inactive database handle");
return FALSE;
}
/* load the module if needed */
char *module_ISA = sqlite3_mprintf("%s::ISA", perl_class);
if (!get_av(module_ISA, 0)) {
char *loading_code = sqlite3_mprintf("require %s", perl_class);
eval_pv(loading_code, TRUE);
sqlite3_free(loading_code);
}
sqlite3_free(module_ISA);
/* build the init datastructure that will be passed to perl_vt_New() */
perl_vtab_init *init_data;
init_data = sqlite3_malloc(sizeof(*init_data));
init_data->dbh = newRV(dbh);
sv_rvweaken(init_data->dbh);
init_data->perl_class = sqlite3_mprintf(perl_class);
rc = sqlite3_create_module_v2( imp_dbh->db,
name,
&perl_vt_Module,
init_data,
sqlite_db_destroy_module_data
);
if ( rc != SQLITE_OK ) {
sqlite_error(dbh, rc, form("sqlite_create_module failed with error %s",
sqlite3_errmsg(imp_dbh->db)));
return FALSE;
}
return TRUE;
}
/* end */

3
dbdimp.h
View file

@ -110,10 +110,11 @@ int sqlite_db_profile(pTHX_ SV *dbh, SV *func);
HV* sqlite_db_table_column_metadata(pTHX_ SV *dbh, SV *dbname, SV *tablename, SV *columnname);
HV* _sqlite_db_status(pTHX_ SV *dbh, int reset);
SV* sqlite_db_filename(pTHX_ SV *dbh);
int sqlite_db_register_fts3_perl_tokenizer(pTHX_ SV *dbh);
HV* _sqlite_status(int reset);
HV* _sqlite_st_status(pTHX_ SV *sth, int reset);
int sqlite_db_create_module(pTHX_ SV *dbh, const char *name, const char *perl_class);
#ifdef SvUTF8_on

1
lib/DBD/SQLite.pm
View file

@ -56,6 +56,7 @@ sub driver {
DBD::SQLite::db->install_method('sqlite_db_filename', { O => 0x0004 });
DBD::SQLite::db->install_method('sqlite_db_status', { O => 0x0004 });
DBD::SQLite::st->install_method('sqlite_st_status', { O => 0x0004 });
DBD::SQLite::db->install_method('sqlite_create_module');
$methods_are_installed++;
}

272
lib/DBD/SQLite/VirtualTable.pm Normal file
View file

@ -0,0 +1,272 @@
package DBD::SQLite::VirtualTable;
use strict;
use warnings;
use Scalar::Util qw/weaken/;
use List::MoreUtils qw/part/;
use YAML::XS;
use Data::Dumper;
our $VERSION = '0.01';
our @ISA;
sub DESTROY_MODULE {
my $class = shift;
}
sub CREATE {
my $class = shift;
return $class->NEW(@_);
}
sub CONNECT {
my $class = shift;
return $class->NEW(@_);
}
sub NEW { # called when instanciating a virtual table
my ($class, $dbh_ref, $module_name, $db_name, $vtab_name, @args) = @_;
my @columns;
my %options;
# args containing '=' are options; others are column declarations
foreach my $arg (@args) {
if ($arg =~ /^([^=\s]+)\s*=\s*(.*)/) {
my ($key, $val) = ($1, $2);
$val =~ s/^"(.*)"$/$1/;
$options{$key} = $val;
}
else {
push @columns, $arg;
}
}
# build $self and initialize
my $self = {
dbh_ref => $dbh_ref,
module_name => $module_name,
db_name => $db_name,
vtab_name => $vtab_name,
columns => \@columns,
options => \%options,
};
weaken $self->{dbh_ref};
bless $self, $class;
$self->initialize();
return $self;
}
sub dbh {
my $self = shift;
return ${$self->{dbh_ref}};
}
sub initialize {
my $self = shift;
}
sub connect {
my $class = shift;
warn "TODO -- VTAB called connect() instead of new()";
return $class->new(@_);
}
sub DROP {
my $self = shift;
}
sub DISCONNECT {
my $self = shift;
}
sub VTAB_TO_DECLARE {
my $self = shift;
local $" = ", ";
my $sql = "CREATE TABLE $self->{vtab_name}(@{$self->{columns}})";
return $sql;
}
sub BEST_INDEX {
my ($self, $constraints, $order_by) = @_;
# print STDERR Dump [BEST_INDEX => {
# where => $constraints,
# order => $order_by,
# }];
my $ix = 0;
foreach my $constraint (@$constraints) {
# TMP HACK -- should put real values instead
$constraint->{argvIndex} = $ix++;
$constraint->{omit} = 0;
}
# TMP HACK -- should put real values instead
my $outputs = {
idxNum => 1,
idxStr => "foobar",
orderByConsumed => 0,
estimatedCost => 1.0,
estimatedRows => undef,
};
return $outputs;
}
sub OPEN {
my $self = shift;
my $class = ref $self;
my $cursor_class = $class . "::Cursor";
return $cursor_class->new($self, @_);
}
sub _SQLITE_UPDATE {
my ($self, $old_rowid, $new_rowid, @values) = @_;
warn "CURSOR->_SQLITE_UPDATE";
if (! defined $old_rowid) {
return $self->INSERT($new_rowid, @values);
}
elsif (!@values) {
return $self->DELETE($old_rowid);
}
else {
return $self->UPDATE($old_rowid, $new_rowid, @values);
}
}
sub INSERT {
my ($self, $new_rowid, @values) = @_;
warn "vtab->insert()";
my $new_computed_rowid;
return $new_computed_rowid;
}
sub DELETE {
my ($self, $old_rowid) = @_;
}
sub UPDATE {
my ($self, $old_rowid, $new_rowid, @values) = @_;
}
sub BEGIN_TRANSACTION {return 0}
sub SYNC_TRANSACTION {return 0}
sub COMMIT_TRANSACTION {return 0}
sub ROLLBACK_TRANSACTION {return 0}
sub SAVEPOINT {return 0}
sub RELEASE {return 0}
sub ROLLBACK_TO {return 0}
sub DESTROY {
my $self = shift;
}
package DBD::SQLite::VirtualTable::Cursor;
use strict;
use warnings;
sub new {
my ($class, $vtable, @args) = @_;
my $self = {vtable => $vtable,
args => \@args};
bless $self, $class;
}
sub FILTER {
my ($self, $idxNum, $idxStr, @values) = @_;
return;
}
sub EOF {
my ($self) = @_;
# stupid implementation, to be redefined in subclasses
return 1;
}
sub NEXT {
my ($self) = @_;
}
sub COLUMN {
my ($self, $idxCol) = @_;
}
sub ROWID {
my ($self) = @_;
# stupid implementation, to be redefined in subclasses
return 1;
}
sub CLOSE {
my ($self) = @_;
}
1;
__END__
=head1 NAME
DBD::SQLite::VirtualTable -- Abstract parent class for implementing virtual tables
=head1 SYNOPSIS
package My::Virtual::Table;
use parent 'DBD::SQLite::VirtualTable';
sub ...
=head1 DESCRIPTION
TODO
=head1 METHODS
TODO
=head1 COPYRIGHT AND LICENSE
Copyright Laurent Dami, 2014.
Parts of the code are borrowed from L<SQLite::VirtualTable>,
copyright (C) 2006, 2009 by Qindel Formacion y Servicios, S. L.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut

208
lib/DBD/SQLite/VirtualTable/Filesys.pm Normal file
View file

@ -0,0 +1,208 @@
package DBD::SQLite::VirtualTable::Filesys;
use strict;
use warnings;
use base 'DBD::SQLite::VirtualTable';
=head1 NAME
DBD::SQLite::VirtualTable::Filesys -- virtual table for viewing file contents
=head1 SYNOPSIS
-- $dbh->sqlite_create_module(filesys => "DBD::SQLite::VirtualTable::Filesys");
CREATE VIRTUAL TABLE tbl USING filesys(file_content,
index_table = idx,
path_col = path,
expose = "path, col1, col2, col3",
root = "/foo/bar")
=head1 DESCRIPTION
A "Filesys" virtual table is like a database view on some underlying
I<index table>, which has a column containing paths to
files; the virtual table then adds a supplementary column which exposes
the content from those files.
This is especially useful as an "external content" to some
fulltext table (see L<DBD::SQLite::Fulltext_search>) : the index
table stores some metadata about files, and then the fulltext engine
can index both the metadata and the file contents.
=head1 METHODS
=head2 new
=cut
sub initialize {
my $self = shift;
# verifications
@{$self->{columns}} == 1
or die "Filesys virtual table should declare exactly 1 content column";
for my $opt (qw/index_table path_col/) {
$self->{options}{$opt}
or die "Filesys virtual table: option '$opt' is missing";
}
# get list of columns from the index table
my $ix_table = $self->{options}{index_table};
my $sql = "PRAGMA table_info($ix_table)";
my $base_cols = $self->dbh->selectcol_arrayref($sql, {Columns => [2]});
@$base_cols
or die "wrong index table: $ix_table";
# check / complete the exposed columns
$self->{options}{expose} = "*" if not exists $self->{options}{expose};
my @exposed_cols;
if ($self->{options}{expose} eq '*') {
@exposed_cols = @$base_cols;
}
else {
@exposed_cols = split /\s*,\s*/, ($self->{options}{expose} || "");
my %is_ok_col = map {$_ => 1} @$base_cols;
my @bad_cols = grep {!$is_ok_col{$_}} @exposed_cols;
local $" = ", ";
die "table $ix_table has no column named @bad_cols" if @bad_cols;
}
push @{$self->{columns}}, @exposed_cols;
}
sub _SQLITE_UPDATE {
my ($self, $old_rowid, $new_rowid, @values) = @_;
die "readonly database";
}
sub BEST_INDEX {
my ($self, $constraints, $order_by) = @_;
my @conditions;
my $ix = 0;
foreach my $constraint (grep {$_->{usable}} @$constraints) {
my $col = $constraint->{col};
# if this is the content column, skip because we can't filter on it
next if $col == 0;
# for other columns, build a fragment for SQL WHERE on the underlying table
my $colname = $col == -1 ? "rowid" : $self->{columns}[$col];
push @conditions, "$colname $constraint->{op} ?";
$constraint->{argvIndex} = $ix++;
$constraint->{omit} = 1; # SQLite doesn't need to re-check the op
}
my $outputs = {
idxNum => 1,
idxStr => join(" AND ", @conditions),
orderByConsumed => 0,
estimatedCost => 1.0,
estimatedRows => undef,
};
return $outputs;
}
package DBD::SQLite::VirtualTable::Filesys::Cursor;
use 5.010;
use strict;
use warnings;
use base "DBD::SQLite::VirtualTable::Cursor";
sub FILTER {
my ($self, $idxNum, $idxStr, @values) = @_;
my $vtable = $self->{vtable};
# build SQL
local $" = ", ";
my @cols = @{$vtable->{columns}};
$cols[0] = 'rowid'; # replace the content column by the rowid
push @cols, $vtable->{options}{path_col}; # path col in last position
my $sql = "SELECT @cols FROM $vtable->{options}{index_table}";
$sql .= " WHERE $idxStr" if $idxStr;
# request on the index table
my $dbh = $vtable->dbh;
$self->{sth} = $dbh->prepare($sql)
or die DBI->errstr;
$self->{sth}->execute(@values);
$self->{row} = $self->{sth}->fetchrow_arrayref;
return;
}
sub EOF {
my ($self) = @_;
return !$self->{row};
}
sub NEXT {
my ($self) = @_;
$self->{row} = $self->{sth}->fetchrow_arrayref;
}
sub COLUMN {
my ($self, $idxCol) = @_;
return $idxCol == 0 ? $self->file_content : $self->{row}[$idxCol];
}
sub ROWID {
my ($self) = @_;
return $self->{row}[0];
}
sub file_content {
my ($self) = @_;
my $root = $self->{vtable}{options}{root};
my $path = $self->{row}[-1];
$path = "$root/$path" if $root;
my $content = "";
if (open my $fh, "<", $path) {
local $/; # slurp the whole file into a scalar
$content = <$fh>;
close $fh;
}
else {
warn "can't open $path";
}
return $content;
}
1;
__END__
=head1 COPYRIGHT AND LICENSE
Copyright Laurent Dami, 2014.
Parts of the code are borrowed from L<SQLite::VirtualTable>,
copyright (C) 2006, 2009 by Qindel Formacion y Servicios, S. L.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut

135
t/virtual_table/00_base.t Normal file
View file

@ -0,0 +1,135 @@
#!/usr/bin/perl
use strict;
BEGIN {
$| = 1;
$^W = 1;
}
use t::lib::Test qw/connect_ok/;
use Test::More;
# use Test::NoWarnings;
use DBI qw(:sql_types);
plan tests => 9;
my $dbh = connect_ok( RaiseError => 1, PrintError => 0, AutoCommit => 1 );
$dbh->sqlite_create_module(vtab => "DBD::SQLite::VirtualTable::T");
ok $dbh->do("CREATE VIRTUAL TABLE foobar USING vtab(foo INTEGER, bar INTEGER)");
my $sql = "SELECT rowid, foo, bar FROM foobar ";
my $rows = $dbh->selectall_arrayref($sql, {Slice => {}});
is scalar(@$rows), 5, "got 5 rows";
is $rows->[0]{rowid}, 5, "rowid column";
is $rows->[0]{foo}, "auto_vivify:0", "foo column";
is $rows->[0]{bar}, "auto_vivify:1", "bar column";
$sql = "SELECT * FROM foobar ";
$rows = $dbh->selectall_arrayref($sql, {Slice => {}});
is scalar(@$rows), 5, "got 5 rows again";
is_deeply([sort keys %{$rows->[0]}], [qw/bar foo/], "col list OK");
$sql = "SELECT * FROM foobar WHERE foo > -1 and bar < 33";
$rows = $dbh->selectall_arrayref($sql, {Slice => {}});
is scalar(@$rows), 5, "got 5 rows (because of omitted constraints)";
package DBD::SQLite::VirtualTable::T;
use strict;
use warnings;
use base 'DBD::SQLite::VirtualTable';
use YAML;
sub initialize {
my $self = shift;
# stupid pragma call, just to check that the dbh is OK
$self->dbh->do("PRAGMA application_id=999");
}
sub BEST_INDEX {
my ($self, $constraints, $order_by) = @_;
# print STDERR Dump [BEST_INDEX => {
# where => $constraints,
# order => $order_by,
# }];
my $ix = 0;
foreach my $constraint (@$constraints) {
$constraint->{argvIndex} = $ix++;
$constraint->{omit} = 1; # to prevent sqlite core to check values
}
# TMP HACK -- should put real values instead
my $outputs = {
idxNum => 1,
idxStr => "foobar",
orderByConsumed => 0,
estimatedCost => 1.0,
estimatedRows => undef,
};
return $outputs;
}
package DBD::SQLite::VirtualTable::T::Cursor;
use strict;
use warnings;
use base 'DBD::SQLite::VirtualTable::Cursor';
use YAML;
sub new {
my $class = shift;
my $self = $class->SUPER::new(@_);
$self->{row_count} = 5;
return $self;
}
sub FILTER {
my ($self, $idxNum, $idxStr, @values) = @_;
return;
}
sub EOF {
my $self = shift;
return !$self->{row_count};
}
sub NEXT {
my $self = shift;
$self->{row_count}--;
}
sub COLUMN {
my ($self, $idxCol) = @_;
return "auto_vivify:$idxCol";
return $idxCol;
}
sub ROWID {
my ($self) = @_;
return $self->{row_count};
}
1;

81
t/virtual_table/01_destroy.t Normal file
View file

@ -0,0 +1,81 @@
#!/usr/bin/perl
use strict;
BEGIN {
$| = 1;
$^W = 1;
}
use t::lib::Test qw/connect_ok/;
use Test::More;
use Test::NoWarnings;
plan tests => 23;
my $dbfile = "tmp.sqlite";
my $dbh = connect_ok( dbfile => $dbfile, RaiseError => 1, AutoCommit => 1 );
ok !$DBD::SQLite::VirtualTable::T::INITIALIZE_COUNT, "no vtab initialized";
# create 2 separate SQLite modules from the same Perl class
$dbh->sqlite_create_module(vtab1 => "DBD::SQLite::VirtualTable::T");
$dbh->sqlite_create_module(vtab2 => "DBD::SQLite::VirtualTable::T");
ok !$DBD::SQLite::VirtualTable::T::INITIALIZE_COUNT, "still no vtab";
# create 2 virtual tables from module vtab1
ok $dbh->do("CREATE VIRTUAL TABLE foobar USING vtab1(foo, bar)"), "create foobar";
ok $dbh->do("CREATE VIRTUAL TABLE barfoo USING vtab1(foo, bar)"), "create barfoo";
is $DBD::SQLite::VirtualTable::T::CREATE_COUNT, 2, "2 vtab created";
ok !$DBD::SQLite::VirtualTable::T::CONNECT_COUNT, "no vtab connected";
is $DBD::SQLite::VirtualTable::T::INITIALIZE_COUNT, 2, "2 vtab initialized";
# destructor is called when a vtable is dropped
ok !$DBD::SQLite::VirtualTable::T::DESTROY_COUNT, "no vtab destroyed";
ok $dbh->do("DROP TABLE foobar"), "dropped foobar";
is $DBD::SQLite::VirtualTable::T::DESTROY_COUNT, 1, "one vtab destroyed";
# all vtable and module destructors are called when the dbh is disconnected
undef $dbh;
is $DBD::SQLite::VirtualTable::T::DESTROY_COUNT, 2, "both vtab destroyed";
is $DBD::SQLite::VirtualTable::T::DISCONNECT_COUNT, 1, "1 vtab disconnected";
is $DBD::SQLite::VirtualTable::T::DROP_COUNT, 1, "1 vtab dropped";
is $DBD::SQLite::VirtualTable::T::DESTROY_MODULE_COUNT, 2, "2 modules destroyed";
# reconnect, check that we go through the CONNECT method
undef $DBD::SQLite::VirtualTable::T::CREATE_COUNT;
undef $DBD::SQLite::VirtualTable::T::CONNECT_COUNT;
undef $DBD::SQLite::VirtualTable::T::INITIALIZE_COUNT;
$dbh = connect_ok( dbfile => $dbfile, RaiseError => 1, AutoCommit => 1 );
$dbh->sqlite_create_module(vtab1 => "DBD::SQLite::VirtualTable::T");
ok !$DBD::SQLite::VirtualTable::T::CREATE_COUNT, "no vtab created";
ok !$DBD::SQLite::VirtualTable::T::CONNECT_COUNT, "no vtab connected";
ok !$DBD::SQLite::VirtualTable::T::INITIALIZE_COUNT, "no vtab initialized";
my $sth = $dbh->prepare("SELECT * FROM barfoo");
ok !$DBD::SQLite::VirtualTable::T::CREATE_COUNT, "no vtab created";
is $DBD::SQLite::VirtualTable::T::CONNECT_COUNT, 1, "1 vtab connected";
is $DBD::SQLite::VirtualTable::T::INITIALIZE_COUNT, 1, "1 vtab initialized";
package DBD::SQLite::VirtualTable::T;
use base 'DBD::SQLite::VirtualTable';
our $CREATE_COUNT;
our $CONNECT_COUNT;
our $INITIALIZE_COUNT;
our $DESTROY_COUNT;
our $DESTROY_MODULE_COUNT;
our $DROP_COUNT;
our $DISCONNECT_COUNT;
sub CREATE {$CREATE_COUNT++; return shift->SUPER::CREATE(@_)}
sub CONNECT {$CONNECT_COUNT++; return shift->SUPER::CONNECT(@_)}
sub initialize {$INITIALIZE_COUNT++}
sub DROP {$DROP_COUNT++}
sub DISCONNECT {$DISCONNECT_COUNT++}
sub DESTROY {$DESTROY_COUNT++}
sub DESTROY_MODULE {$DESTROY_MODULE_COUNT++}
1;

65
t/virtual_table/10_filesys.t Normal file
View file

@ -0,0 +1,65 @@
#!/usr/bin/perl
use strict;
BEGIN {
$| = 1;
$^W = 1;
}
use t::lib::Test qw/connect_ok/;
use Test::More;
# use Test::NoWarnings;
use DBI qw(:sql_types);
use FindBin;
plan tests => 12;
my $dbh = connect_ok( RaiseError => 1, PrintError => 0, AutoCommit => 1 );
# create index table
$dbh->do(<<"");
CREATE TABLE base (id INTEGER PRIMARY KEY, foo TEXT, path TEXT, bar TEXT)
$dbh->do(<<"");
INSERT INTO base VALUES(1, 'foo1', '00_base.t', 'bar1')
$dbh->do(<<"");
INSERT INTO base VALUES(2, 'foo2', '10_filesys.t', 'bar2')
# start tests
ok $dbh->sqlite_create_module(fs => "DBD::SQLite::VirtualTable::Filesys"),
"create_module";
ok $dbh->do(<<""), "create vtable";
CREATE VIRTUAL TABLE vfs USING fs(content,
index_table = base,
path_col = path,
expose = "path, foo, bar",
root = "$FindBin::Bin")
my $sql = "SELECT content, bar, rowid FROM vfs WHERE foo='foo2'";
my $rows = $dbh->selectall_arrayref($sql, {Slice => {}});
is scalar(@$rows), 1, "got 1 row";
is $rows->[0]{bar}, 'bar2', 'got bar2';
is $rows->[0]{rowid}, 2, 'got rowid';
like $rows->[0]{content}, qr/VIRTUAL TABLE vfs/, 'file content';
$sql = "SELECT * FROM vfs ORDER BY rowid";
$rows = $dbh->selectall_arrayref($sql, {Slice => {}});
is scalar(@$rows), 2, "got 2 rows";
is_deeply([sort keys %{$rows->[0]}], [qw/bar content foo path/], "col list OK");
is $rows->[0]{bar}, 'bar1', 'got bar1';
is $rows->[1]{bar}, 'bar2', 'got bar2';
# expensive request (reads content from all files in table) !
$sql = "SELECT * FROM vfs WHERE content LIKE '%filesys%'";
$rows = $dbh->selectall_arrayref($sql, {Slice => {}});
is scalar(@$rows), 1, "got 1 row";

100
t/virtual_table/11_fulltext_search.t Normal file
View file

@ -0,0 +1,100 @@
#!/usr/bin/perl
# TMP HACK
use strict;
BEGIN {
$| = 1;
$^W = 1;
}
use t::lib::Test qw/connect_ok/;
use Test::More;
use Test::NoWarnings;
use FindBin;
my $dbfile = "tmp.sqlite";
my @tests = (
["VirtualTable" => qw[lib/DBD/SQLite/VirtualTable.pm
lib/DBD/SQLite/VirtualTable/Filesys.pm]],
["install_method" => qw[lib/DBD/SQLite.pm]],
['"use strict"' => qw[inc/Test/NoWarnings.pm
inc/Test/NoWarnings/Warning.pm
lib/DBD/SQLite.pm
lib/DBD/SQLite/VirtualTable.pm
lib/DBD/SQLite/VirtualTable/Filesys.pm
t/lib/Test.pm
util/getsqlite.pl]],
['"use strict" AND "use warnings"' => qw[inc/Test/NoWarnings.pm
lib/DBD/SQLite/VirtualTable.pm
lib/DBD/SQLite/VirtualTable/Filesys.pm
]],
);
plan tests => 3 + 3 * @tests;
# find out perl files in this distrib
my $distrib_dir = "$FindBin::Bin/../..";
open my $fh, "<", "$distrib_dir/MANIFEST" or die "open $distrib_dir/MANIFEST: $!";
my @files = <$fh>;
close $fh;
chomp foreach @files;
my @perl_files = grep {/\.(pl|pm|pod)$/} @files;
# open database
my $dbh = connect_ok( dbfile => $dbfile, RaiseError => 1, AutoCommit => 1 );
# create index table
$dbh->do("CREATE TABLE files (id INTEGER PRIMARY KEY, path TEXT)");
my $sth = $dbh->prepare("INSERT INTO files(path) VALUES (?)");
$sth->execute($_) foreach @perl_files;
# create vtab table
$dbh->sqlite_create_module(fs => "DBD::SQLite::VirtualTable::Filesys");
$dbh->do(<<"");
CREATE VIRTUAL TABLE vfs USING fs(content,
index_table = files,
path_col = path,
expose = "path",
root = "$distrib_dir")
# create fts table
$dbh->do('CREATE VIRTUAL TABLE fts USING fts4(content="vfs")');
note "building fts index....";
$dbh->do("INSERT INTO fts(fts) VALUES ('rebuild')");
note "done";
# start tests
my $sql = "SELECT path FROM fts WHERE fts MATCH ?";
foreach my $test (@tests) {
my ($pattern, @expected) = @$test;
my $paths = $dbh->selectcol_arrayref($sql, {}, $pattern);
is_deeply([sort @$paths], \@expected, "search '$pattern'");
}
# remove one document
my $remove_path = 'lib/DBD/SQLite/VirtualTable.pm';
$dbh->do("DELETE FROM fts WHERE path='$remove_path'");
# test again
foreach my $test (@tests) {
my ($pattern, @expected) = @$test;
@expected = grep {$_ ne $remove_path} @expected;
my $paths = $dbh->selectcol_arrayref($sql, {}, $pattern);
is_deeply([sort @$paths], \@expected, "search '$pattern' -- no $remove_path");
}
# see if data was properly stored: disconnect, reconnect and test again
undef $dbh;
$dbh = connect_ok( dbfile => $dbfile, RaiseError => 1, AutoCommit => 1 );
$dbh->sqlite_create_module(fs => "DBD::SQLite::VirtualTable::Filesys");
foreach my $test (@tests) {
my ($pattern, @expected) = @$test;
@expected = grep {$_ ne $remove_path} @expected;
my $paths = $dbh->selectcol_arrayref($sql, {}, $pattern);
is_deeply([sort @$paths], \@expected, "search '$pattern' -- after reconnect");
}