mirror of
https://github.com/DBD-SQLite/DBD-SQLite
synced 2025-06-07 14:19:10 -04:00
initial support for virtual tables in Perl (WORK IN PROGRESS)
This commit is contained in:
Laurent Dami
parent
b6d9f86716
commit
78984a9de8
12 changed files with 1704 additions and 6 deletions
5
MANIFEST
5
MANIFEST
|
|
@ -7,6 +7,8 @@ inc/Test/NoWarnings/Warning.pm
|
||||||
lib/DBD/SQLite.pm
|
lib/DBD/SQLite.pm
|
||||||
lib/DBD/SQLite/Cookbook.pod
|
lib/DBD/SQLite/Cookbook.pod
|
||||||
lib/DBD/SQLite/Fulltext_search.pod
|
lib/DBD/SQLite/Fulltext_search.pod
|
||||||
|
lib/DBD/SQLite/VirtualTable.pm
|
||||||
|
lib/DBD/SQLite/VirtualTable/Filesys.pm
|
||||||
LICENSE
|
LICENSE
|
||||||
Makefile.PL
|
Makefile.PL
|
||||||
MANIFEST This list of files
|
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_81536_multi_column_primary_key_info.t
|
||||||
t/rt_88228_sqlite_3_8_0_crash.t
|
t/rt_88228_sqlite_3_8_0_crash.t
|
||||||
t/rt_96878_fts_contentless_table.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
|
typemap
|
||||||
util/getsqlite.pl
|
util/getsqlite.pl
|
||||||
xt/meta.t
|
xt/meta.t
|
||||||
|
|
|
||||||
|
|
@ -367,6 +367,9 @@ WriteMakefile(
|
||||||
clean => {
|
clean => {
|
||||||
FILES => 'SQLite.xsi config.h tv.log *.old',
|
FILES => 'SQLite.xsi config.h tv.log *.old',
|
||||||
},
|
},
|
||||||
|
test => {
|
||||||
|
TESTS => 't/*.t t/**/*.t',
|
||||||
|
},
|
||||||
PL_FILES => {},
|
PL_FILES => {},
|
||||||
EXE_FILES => [],
|
EXE_FILES => [],
|
||||||
|
|
||||||
|
|
|
||||||
15
SQLite.xs
15
SQLite.xs
|
|
@ -283,6 +283,21 @@ db_status(dbh, reset = 0)
|
||||||
RETVAL
|
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
|
MODULE = DBD::SQLite PACKAGE = DBD::SQLite::st
|
||||||
|
|
||||||
PROTOTYPES: DISABLE
|
PROTOTYPES: DISABLE
|
||||||
|
|
|
||||||
822
dbdimp.c
822
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 PERL_NO_GET_CONTEXT
|
||||||
|
|
||||||
#define NEED_newSVpvn_flags
|
#define NEED_newSVpvn_flags
|
||||||
|
|
@ -27,8 +36,7 @@ DBISTATE_DECLARE;
|
||||||
/*-----------------------------------------------------*
|
/*-----------------------------------------------------*
|
||||||
* Globals
|
* Globals
|
||||||
*-----------------------------------------------------*/
|
*-----------------------------------------------------*/
|
||||||
imp_dbh_t *last_executed_dbh; /* needed by perl_tokenizer
|
imp_dbh_t *last_prepared_dbh; /* see _last_dbh_is_unicode() */
|
||||||
to know if unicode is on/off */
|
|
||||||
|
|
||||||
|
|
||||||
/*-----------------------------------------------------*
|
/*-----------------------------------------------------*
|
||||||
|
|
@ -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 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')
|
#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
|
static void
|
||||||
_sqlite_trace(pTHX_ char *file, int line, SV *h, imp_xxh_t *imp_xxh, const char *what)
|
_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
|
static void
|
||||||
sqlite_set_result(pTHX_ sqlite3_context *context, SV *result, int is_error)
|
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;
|
const char *extra;
|
||||||
D_imp_dbh_from_sth;
|
D_imp_dbh_from_sth;
|
||||||
|
|
||||||
|
last_prepared_dbh = imp_dbh;
|
||||||
|
|
||||||
if (!DBIc_ACTIVE(imp_dbh)) {
|
if (!DBIc_ACTIVE(imp_dbh)) {
|
||||||
sqlite_error(sth, -2, "attempt to prepare on inactive database handle");
|
sqlite_error(sth, -2, "attempt to prepare on inactive database handle");
|
||||||
return FALSE; /* -> undef in lib/DBD/SQLite.pm */
|
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_db_is_null();
|
||||||
croak_if_stmt_is_null();
|
croak_if_stmt_is_null();
|
||||||
|
|
||||||
last_executed_dbh = imp_dbh;
|
|
||||||
|
|
||||||
/* COMPAT: sqlite3_sql is only available for 3006000 or newer */
|
/* COMPAT: sqlite3_sql is only available for 3006000 or newer */
|
||||||
sqlite_trace(sth, imp_sth, 3, form("executing %s", sqlite3_sql(imp_sth->stmt)));
|
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);
|
PUSHMARK(SP);
|
||||||
for ( i=0; i < argc; i++ ) {
|
for ( i=0; i < argc; i++ ) {
|
||||||
|
/* TODO: XPUSHs(stacked_sv_from_sqlite3_value(aTHX_ value[i], is_unicode)); */
|
||||||
|
|
||||||
SV *arg;
|
SV *arg;
|
||||||
STRLEN len;
|
STRLEN len;
|
||||||
int type = sqlite3_value_type(value[i]);
|
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);
|
XPUSHs(arg);
|
||||||
|
|
||||||
}
|
}
|
||||||
PUTBACK;
|
PUTBACK;
|
||||||
|
|
||||||
|
|
@ -1705,9 +1775,14 @@ sqlite_db_aggr_step_dispatcher(sqlite3_context *context,
|
||||||
if ( aggr->err || !aggr->aggr_inst )
|
if ( aggr->err || !aggr->aggr_inst )
|
||||||
goto cleanup;
|
goto cleanup;
|
||||||
|
|
||||||
|
int is_unicode = 0; /* TODO : find out from db handle */
|
||||||
|
|
||||||
|
|
||||||
PUSHMARK(SP);
|
PUSHMARK(SP);
|
||||||
XPUSHs( sv_2mortal( newSVsv( aggr->aggr_inst ) ));
|
XPUSHs( sv_2mortal( newSVsv( aggr->aggr_inst ) ));
|
||||||
for ( i=0; i < argc; i++ ) {
|
for ( i=0; i < argc; i++ ) {
|
||||||
|
/* TODO: XPUSHs(stacked_sv_from_sqlite3_value(aTHX_ value[i], is_unicode)); */
|
||||||
|
|
||||||
SV *arg;
|
SV *arg;
|
||||||
int len = sqlite3_value_bytes(value[i]);
|
int len = sqlite3_value_bytes(value[i]);
|
||||||
int type = sqlite3_value_type(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 */
|
flags = SVs_TEMP; /* will call sv_2mortal */
|
||||||
|
|
||||||
/* special handling if working with utf8 strings */
|
/* 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 */
|
/* data to keep track of byte offsets */
|
||||||
c->lastByteOffset = c->pInput = pInput;
|
c->lastByteOffset = c->pInput = pInput;
|
||||||
|
|
@ -2769,4 +2844,741 @@ int sqlite_db_register_fts3_perl_tokenizer(pTHX_ SV *dbh)
|
||||||
return sqlite3_finalize(pStmt);
|
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 */
|
/* end */
|
||||||
|
|
|
||||||
3
dbdimp.h
3
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_table_column_metadata(pTHX_ SV *dbh, SV *dbname, SV *tablename, SV *columnname);
|
||||||
HV* _sqlite_db_status(pTHX_ SV *dbh, int reset);
|
HV* _sqlite_db_status(pTHX_ SV *dbh, int reset);
|
||||||
SV* sqlite_db_filename(pTHX_ SV *dbh);
|
SV* sqlite_db_filename(pTHX_ SV *dbh);
|
||||||
|
|
||||||
int sqlite_db_register_fts3_perl_tokenizer(pTHX_ SV *dbh);
|
int sqlite_db_register_fts3_perl_tokenizer(pTHX_ SV *dbh);
|
||||||
HV* _sqlite_status(int reset);
|
HV* _sqlite_status(int reset);
|
||||||
HV* _sqlite_st_status(pTHX_ SV *sth, 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
|
#ifdef SvUTF8_on
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -56,6 +56,7 @@ sub driver {
|
||||||
DBD::SQLite::db->install_method('sqlite_db_filename', { O => 0x0004 });
|
DBD::SQLite::db->install_method('sqlite_db_filename', { O => 0x0004 });
|
||||||
DBD::SQLite::db->install_method('sqlite_db_status', { O => 0x0004 });
|
DBD::SQLite::db->install_method('sqlite_db_status', { O => 0x0004 });
|
||||||
DBD::SQLite::st->install_method('sqlite_st_status', { O => 0x0004 });
|
DBD::SQLite::st->install_method('sqlite_st_status', { O => 0x0004 });
|
||||||
|
DBD::SQLite::db->install_method('sqlite_create_module');
|
||||||
|
|
||||||
$methods_are_installed++;
|
$methods_are_installed++;
|
||||||
}
|
}
|
||||||
|
|
|
||||||
272
lib/DBD/SQLite/VirtualTable.pm
Normal file
272
lib/DBD/SQLite/VirtualTable.pm
Normal 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
208
lib/DBD/SQLite/VirtualTable/Filesys.pm
Normal 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
135
t/virtual_table/00_base.t
Normal 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
81
t/virtual_table/01_destroy.t
Normal 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
65
t/virtual_table/10_filesys.t
Normal 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
100
t/virtual_table/11_fulltext_search.t
Normal 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");
|
||||||
|
}
|
||||||
|
|
||||||
Loading…
Add table
Reference in a new issue