From 78984a9de82676c68b62ee9c97cad744144c4556 Mon Sep 17 00:00:00 2001 From: Laurent Dami Date: Fri, 4 Jul 2014 10:07:19 +0200 Subject: [PATCH] initial support for virtual tables in Perl (WORK IN PROGRESS) --- MANIFEST | 5 + Makefile.PL | 3 + SQLite.xs | 15 + dbdimp.c | 822 ++++++++++++++++++++++++- dbdimp.h | 3 +- lib/DBD/SQLite.pm | 1 + lib/DBD/SQLite/VirtualTable.pm | 272 ++++++++ lib/DBD/SQLite/VirtualTable/Filesys.pm | 208 +++++++ t/virtual_table/00_base.t | 135 ++++ t/virtual_table/01_destroy.t | 81 +++ t/virtual_table/10_filesys.t | 65 ++ t/virtual_table/11_fulltext_search.t | 100 +++ 12 files changed, 1704 insertions(+), 6 deletions(-) create mode 100644 lib/DBD/SQLite/VirtualTable.pm create mode 100644 lib/DBD/SQLite/VirtualTable/Filesys.pm create mode 100644 t/virtual_table/00_base.t create mode 100644 t/virtual_table/01_destroy.t create mode 100644 t/virtual_table/10_filesys.t create mode 100644 t/virtual_table/11_fulltext_search.t diff --git a/MANIFEST b/MANIFEST index 2b0a7da..0dec102 100644 --- a/MANIFEST +++ b/MANIFEST @@ -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 diff --git a/Makefile.PL b/Makefile.PL index ebfc4d7..ba70991 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -367,6 +367,9 @@ WriteMakefile( clean => { FILES => 'SQLite.xsi config.h tv.log *.old', }, + test => { + TESTS => 't/*.t t/**/*.t', + }, PL_FILES => {}, EXE_FILES => [], diff --git a/SQLite.xs b/SQLite.xs index ee307e8..5f9b415 100644 --- a/SQLite.xs +++ b/SQLite.xs @@ -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 diff --git a/dbdimp.c b/dbdimp.c index f47e618..d192c21 100644 --- a/dbdimp.c +++ b/dbdimp.c @@ -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; inConstraint; 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; inOrderBy; 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; inConstraint; 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 */ diff --git a/dbdimp.h b/dbdimp.h index 944d5d2..bf6588a 100644 --- a/dbdimp.h +++ b/dbdimp.h @@ -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 diff --git a/lib/DBD/SQLite.pm b/lib/DBD/SQLite.pm index c5d0649..54c0f99 100644 --- a/lib/DBD/SQLite.pm +++ b/lib/DBD/SQLite.pm @@ -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++; } diff --git a/lib/DBD/SQLite/VirtualTable.pm b/lib/DBD/SQLite/VirtualTable.pm new file mode 100644 index 0000000..707ed85 --- /dev/null +++ b/lib/DBD/SQLite/VirtualTable.pm @@ -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, +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 diff --git a/lib/DBD/SQLite/VirtualTable/Filesys.pm b/lib/DBD/SQLite/VirtualTable/Filesys.pm new file mode 100644 index 0000000..5a1fd26 --- /dev/null +++ b/lib/DBD/SQLite/VirtualTable/Filesys.pm @@ -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, 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) : 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, +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 diff --git a/t/virtual_table/00_base.t b/t/virtual_table/00_base.t new file mode 100644 index 0000000..cba5a12 --- /dev/null +++ b/t/virtual_table/00_base.t @@ -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; + + + diff --git a/t/virtual_table/01_destroy.t b/t/virtual_table/01_destroy.t new file mode 100644 index 0000000..d1dce00 --- /dev/null +++ b/t/virtual_table/01_destroy.t @@ -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; + diff --git a/t/virtual_table/10_filesys.t b/t/virtual_table/10_filesys.t new file mode 100644 index 0000000..88fc7a7 --- /dev/null +++ b/t/virtual_table/10_filesys.t @@ -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"; + diff --git a/t/virtual_table/11_fulltext_search.t b/t/virtual_table/11_fulltext_search.t new file mode 100644 index 0000000..32add66 --- /dev/null +++ b/t/virtual_table/11_fulltext_search.t @@ -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"); +} +