DBD-SQLcipher

 view release on metacpan or  search on metacpan

dbdimp.c  view on Meta::CPAN

    }

    return TRUE;
#else
    sqlite_error(dbh, SQLITE_ERROR, form("backup feature requires SQLcipher 3.6.11 and newer"));
    return FALSE;
#endif
}

/* Accesses the SQLcipher Online Backup API, and copies the currently loaded
 * database into the passed filename.
 * Usual usage of this would be when you're operating on the :memory:
 * special database connection, and want to back it up to an on-disk file.
 */
int
sqlite_db_backup_to_file(pTHX_ SV *dbh, char *filename)
{
    D_imp_dbh(dbh);

#if SQLITE_VERSION_NUMBER >= 3006011
    int rc;
    sqlite3 *pTo;
    sqlite3_backup *pBackup;

    if (!DBIc_ACTIVE(imp_dbh)) {
        sqlite_error(dbh, -2, "attempt to backup to file on inactive database handle");
        return FALSE;
    }

    croak_if_db_is_null();

    rc = sqlite_open(filename, &pTo);
    if ( rc != SQLITE_OK ) {
        return FALSE;
    }

    /* COMPAT: sqlite3_backup_* are only available for 3006011 or newer */
    pBackup = sqlite3_backup_init(pTo, "main", imp_dbh->db, "main");
    if (pBackup) {
        (void)sqlite3_backup_step(pBackup, -1);
        (void)sqlite3_backup_finish(pBackup);
    }
    rc = sqlite3_errcode(pTo);
    (void)sqlite3_close(pTo);

    if ( rc != SQLITE_OK ) {
        sqlite_error(dbh, rc, form("sqlite_backup_to_file failed with error %s", sqlite3_errmsg(imp_dbh->db)));
        return FALSE;
    }

    return TRUE;
#else
    sqlite_error(dbh, SQLITE_ERROR, form("backup feature requires SQLcipher 3.6.11 and newer"));
    return FALSE;
#endif
}

typedef struct perl_tokenizer {
    sqlite3_tokenizer base;
    SV *coderef;                 /* the perl tokenizer is a coderef that takes
                                    a string and returns a cursor coderef */
} perl_tokenizer;

typedef struct perl_tokenizer_cursor {
    sqlite3_tokenizer_cursor base;
    SV *coderef;                 /* ref to the closure that returns terms */
    char *pToken;                /* storage for a copy of the last token */
    int nTokenAllocated;         /* space allocated to pToken buffer */

    /* members below are only used if the input string is in utf8 */
    const char *pInput;          /* input we are tokenizing */
    const char *lastByteOffset;  /* offset into pInput */
    int lastCharOffset;          /* char offset corresponding to lastByteOffset */
} perl_tokenizer_cursor;

/*
** Create a new tokenizer instance.
** Will be called whenever a FTS3 table is created with
**   CREATE .. USING fts3( ... , tokenize=perl qualified::function::name)
** where qualified::function::name is a fully qualified perl function
*/
static int perl_tokenizer_Create(
    int argc, const char * const *argv,
    sqlite3_tokenizer **ppTokenizer
){
    dTHX;
    dSP;
    int n_retval;
    SV *retval;
    perl_tokenizer *t;

    if (!argc) {
        return SQLITE_ERROR;
    }

    t = (perl_tokenizer *) sqlite3_malloc(sizeof(*t));
    if( t==NULL ) return SQLITE_NOMEM;
    memset(t, 0, sizeof(*t));

    ENTER;
    SAVETMPS;

    /* call the qualified::function::name */
    PUSHMARK(SP);
    PUTBACK;
    n_retval = call_pv(argv[0], G_SCALAR);
    SPAGAIN;

    /* store a copy of the returned coderef into the tokenizer structure */
    if (n_retval != 1) {
        warn("tokenizer_Create returned %d arguments", n_retval);
    }
    retval = POPs;
    t->coderef   = newSVsv(retval);
    *ppTokenizer = &t->base;

    PUTBACK;
    FREETMPS;
    LEAVE;

    return SQLITE_OK;
}

/*
** Destroy a tokenizer
*/
static int perl_tokenizer_Destroy(sqlite3_tokenizer *pTokenizer){
    dTHX;
    perl_tokenizer *t = (perl_tokenizer *) pTokenizer;
    sv_free(t->coderef);
    sqlite3_free(t);
    return SQLITE_OK;
}

/*
** Prepare to begin tokenizing a particular string.  The input
** string to be tokenized is supposed to be pInput[0..nBytes-1] ..
** except that nBytes passed by fts3 is -1 (don't know why) !
** This is passed to the tokenizer instance, which then returns a
** closure implementing the cursor (so the cursor is again a coderef).
*/
static int perl_tokenizer_Open(
    sqlite3_tokenizer *pTokenizer,       /* Tokenizer object */
    const char *pInput, int nBytes,      /* Input buffer */
    sqlite3_tokenizer_cursor **ppCursor  /* OUT: Created tokenizer cursor */
){
    dTHX;
    dSP;
    dMY_CXT;
    U32 flags;
    SV *perl_string;
    int n_retval;

    perl_tokenizer *t = (perl_tokenizer *)pTokenizer;

    /* allocate and initialize the cursor struct */
    perl_tokenizer_cursor *c;
    c = (perl_tokenizer_cursor *) sqlite3_malloc(sizeof(*c));
    memset(c, 0, sizeof(*c));
    *ppCursor = &c->base;

    /* flags for creating the Perl SV containing the input string */
    flags = SVs_TEMP; /* will call sv_2mortal */

    /* special handling if working with utf8 strings */
    if (MY_CXT.last_dbh_is_unicode) {

        /* data to keep track of byte offsets */
        c->lastByteOffset = c->pInput = pInput;
        c->lastCharOffset = 0;

        /* string passed to Perl needs to be flagged as utf8 */
        flags |= SVf_UTF8;
    }

    ENTER;
    SAVETMPS;

    /* build a Perl copy of the input string */
    if (nBytes < 0) { /* we get -1 from fts3. Don't know why ! */
        nBytes = strlen(pInput);
    }
    perl_string = newSVpvn_flags(pInput, nBytes, flags);

    /* call the tokenizer coderef */
    PUSHMARK(SP);
    XPUSHs(perl_string);
    PUTBACK;
    n_retval = call_sv(t->coderef, G_SCALAR);
    SPAGAIN;

    /* store the cursor coderef returned by the tokenizer */
    if (n_retval != 1) {
        warn("tokenizer returned %d arguments", n_retval);
    }
    c->coderef = newSVsv(POPs);

    PUTBACK;
    FREETMPS;
    LEAVE;
    return SQLITE_OK;
}

/*
** Close a tokenization cursor previously opened by a call to
** perl_tokenizer_Open() above.
*/
static int perl_tokenizer_Close(sqlite3_tokenizer_cursor *pCursor){
    perl_tokenizer_cursor *c = (perl_tokenizer_cursor *) pCursor;

    dTHX;
    sv_free(c->coderef);
    if (c->pToken) sqlite3_free(c->pToken);
    sqlite3_free(c);
    return SQLITE_OK;
}

/*
** Extract the next token from a tokenization cursor.  The cursor must
** have been opened by a prior call to perl_tokenizer_Open().
*/
static int perl_tokenizer_Next(
    sqlite3_tokenizer_cursor *pCursor,  /* Cursor returned by perl_tokenizer_Open */
    const char **ppToken,               /* OUT: *ppToken is the token text */
    int *pnBytes,                       /* OUT: Number of bytes in token */
    int *piStartOffset,                 /* OUT: Starting offset of token */
    int *piEndOffset,                   /* OUT: Ending offset of token */
    int *piPosition                     /* OUT: Position integer of token */
){
    perl_tokenizer_cursor *c = (perl_tokenizer_cursor *) pCursor;
    int result;
    int n_retval;
    char *token;
    char *byteOffset;
    STRLEN n_a; /* this is required for older perls < 5.8.8 */
    I32 hop;

    dTHX;
    dSP;

    ENTER;
    SAVETMPS;

    /* call the cursor */
    PUSHMARK(SP);
    PUTBACK;
    n_retval = call_sv(c->coderef, G_ARRAY);
    SPAGAIN;

    /* if we get back an empty list, there is no more token */
    if (n_retval == 0) {
        result = SQLITE_DONE;
    }
    /* otherwise, get token details from the return list */
    else {
        if (n_retval != 5) {
            warn("tokenizer cursor returned %d arguments", n_retval);
        }
        *piPosition    = POPi;
        *piEndOffset   = POPi;
        *piStartOffset = POPi;
        *pnBytes       = POPi;
        token          = POPpx;

        if (c->pInput) { /* if working with utf8 data */

            /* recompute *pnBytes in bytes, not in chars */
            *pnBytes = strlen(token);

            /* recompute start/end offsets in bytes, not in chars */
            hop            = *piStartOffset - c->lastCharOffset;
            byteOffset     = (char*)utf8_hop((U8*)c->lastByteOffset, hop);
            hop            = *piEndOffset - *piStartOffset;
            *piStartOffset = byteOffset - c->pInput;
            byteOffset     = (char*)utf8_hop((U8*)byteOffset, hop);
            *piEndOffset   = byteOffset - c->pInput;

            /* remember where we are for next round */
            c->lastCharOffset = *piEndOffset,
            c->lastByteOffset = byteOffset;
        }

        /* make sure we have enough storage for copying the token */
        if (*pnBytes > c->nTokenAllocated ){
            char *pNew;
            c->nTokenAllocated = *pnBytes + 20;
            pNew = sqlite3_realloc(c->pToken, c->nTokenAllocated);
            if( !pNew ) return SQLITE_NOMEM;
            c->pToken = pNew;
        }

        /* need to copy the token into the C cursor before perl frees that
           memory */
        memcpy(c->pToken, token, *pnBytes);
        *ppToken  = c->pToken;

        result = SQLITE_OK;
    }

    PUTBACK;
    FREETMPS;
    LEAVE;

    return result;
}

/*
** The set of routines that implement the perl tokenizer
*/
sqlite3_tokenizer_module perl_tokenizer_Module = {
    0,
    perl_tokenizer_Create,
    perl_tokenizer_Destroy,
    perl_tokenizer_Open,
    perl_tokenizer_Close,
    perl_tokenizer_Next
};

/*
** Register the perl tokenizer with FTS3
*/
int sqlite_db_register_fts3_perl_tokenizer(pTHX_ SV *dbh)
{
    D_imp_dbh(dbh);

    int rc;
    sqlite3_stmt *pStmt;
    const char zSql[] = "SELECT fts3_tokenizer(?, ?)";
    sqlite3_tokenizer_module *p = &perl_tokenizer_Module;

    if (!DBIc_ACTIVE(imp_dbh)) {
        sqlite_error(dbh, -2, "attempt to register fts3 tokenizer on inactive database handle");
        return FALSE;
    }

    rc = sqlite3_prepare_v2(imp_dbh->db, zSql, -1, &pStmt, 0);
    if( rc!=SQLITE_OK ){
        return rc;
    }

    sqlite3_bind_text(pStmt, 1, "perl", -1, SQLITE_STATIC);
    sqlite3_bind_blob(pStmt, 2, &p, sizeof(p), SQLITE_STATIC);
    sqlite3_step(pStmt);

    return sqlite3_finalize(pStmt);
}



/*********************************************************************** 
** The set of routines that implement the perl "module" 
** (i.e support for virtual tables written in Perl)
************************************************************************/

typedef struct perl_vtab {
    sqlite3_vtab base;
    SV *perl_vtab_obj;
    HV *functions;
} perl_vtab;

typedef struct perl_vtab_cursor {
    sqlite3_vtab_cursor base;
    SV *perl_cursor_obj;
} perl_vtab_cursor;

typedef struct perl_vtab_init {
    SV *dbh;
    const char *perl_class;
} perl_vtab_init;



/* auxiliary routine for generalized method calls. Arg "i" may be unused */
static int _call_perl_vtab_method(sqlite3_vtab *pVTab, 
                                  const char *method, int i) {
    dTHX;
    dSP;
    int count;

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);
    XPUSHs(((perl_vtab *) pVTab)->perl_vtab_obj);
    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;
    int rc = SQLITE_ERROR;
    SV *perl_vtab_obj;
    SV *sql;

    /* allocate a perl_vtab structure */
    vt = (perl_vtab *) sqlite3_malloc(sizeof(*vt));
    if( vt==NULL ) return SQLITE_NOMEM;
    memset(vt, 0, sizeof(*vt));
    vt->functions = newHV();

    ENTER;
    SAVETMPS;

    /* call the ->CREATE/CONNECT() method */
    PUSHMARK(SP);
    XPUSHs(sv_2mortal(newSVpv(init_data->perl_class, 0)));

dbdimp.c  view on Meta::CPAN

    PUSHMARK(SP);
    XPUSHs( ((perl_vtab *) pVTab)->perl_vtab_obj);
    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);
    hashref = POPs;
    if (!(hashref && SvROK(hashref) && SvTYPE(SvRV(hashref)) == SVt_PVHV))
        croak("BEST_INDEX() method did not return a hashref");
    hv = (HV*)SvRV(hashref);
    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)) {
        STRLEN len;
        char *str = SvPVutf8(*val, len);
        pIdxInfo->idxStr = sqlite3_malloc(len+1);
        memcpy(pIdxInfo->idxStr, str, len);
        pIdxInfo->idxStr[len] = 0;
        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;
#if SQLITE_VERSION_NUMBER >= 3008002
    val = hv_fetch(hv, "estimatedRows", 13, FALSE);
    pIdxInfo->estimatedRows = (val && SvOK(*val)) ? SvIV(*val) : 0;
#endif

    /* 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++){
        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*)SvRV(*rv);
        val = hv_fetch(hv, "argvIndex", 9, FALSE);
        argvIndex = (val && SvOK(*val)) ? SvIV(*val) + 1: 0;

        pConsUsage = &pIdxInfo->aConstraintUsage[i];
        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;
    int count;
    int rc = SQLITE_ERROR;
    SV *perl_cursor;
    perl_vtab_cursor *cursor;

    ENTER;
    SAVETMPS;

    /* allocate a perl_vtab_cursor structure */
    cursor = (perl_vtab_cursor *) sqlite3_malloc(sizeof(*cursor));
    if( cursor==NULL ) return SQLITE_NOMEM;
    memset(cursor, 0, sizeof(*cursor));

    /* call the ->OPEN() method */
    PUSHMARK(SP);
    XPUSHs( ((perl_vtab *) pVTab)->perl_vtab_obj);
    PUTBACK;
    count = call_method ("OPEN", G_SCALAR);
    SPAGAIN;
    if (count != 1) {
        warn("vtab->OPEN() method returned %d vals instead of 1", count);
        SP -= count;
        goto cleanup;

    }
    perl_cursor = POPs;
    if ( !sv_isobject(perl_cursor) ) {
        warn("vtab->OPEN() method did not return a blessed cursor");
        goto cleanup;
    }

    /* everything went OK */
    rc = SQLITE_OK;

 cleanup:

    if (rc == SQLITE_OK) {
        cursor->perl_cursor_obj = SvREFCNT_inc(perl_cursor);
        *ppCursor = &cursor->base;
    }
    else {
        sqlite3_free(cursor);
    }

    PUTBACK;
    FREETMPS;
    LEAVE;

    return rc;
}

static int perl_vt_Close(sqlite3_vtab_cursor *pVtabCursor){
    dTHX;
    dSP;
    perl_vtab_cursor *perl_pVTabCursor;

    ENTER;
    SAVETMPS;

    /* Note : there is no explicit call to a CLOSE() method; if
       needed, the Perl class can implement a DESTROY() method */

    perl_pVTabCursor = (perl_vtab_cursor *) pVtabCursor;
    SvREFCNT_dec(perl_pVTabCursor->perl_cursor_obj);
    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;
    dMY_CXT;
    int i, count;
    int is_unicode = MY_CXT.last_dbh_is_unicode;

    ENTER;
    SAVETMPS;

    /* call the FILTER() method with ($idxNum, $idxStr, @args) */
    PUSHMARK(SP);
    XPUSHs(((perl_vtab_cursor *) pVtabCursor)->perl_cursor_obj);
    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;
    int count;

    ENTER;
    SAVETMPS;

    /* call the next() method */
    PUSHMARK(SP);
    XPUSHs(((perl_vtab_cursor *) pVtabCursor)->perl_cursor_obj);
    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;
    int count, eof;

    ENTER;
    SAVETMPS;

    /* call the eof() method */
    PUSHMARK(SP);
    XPUSHs(((perl_vtab_cursor *) pVtabCursor)->perl_cursor_obj);
    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;
    int count;
    int rc = SQLITE_ERROR;

    ENTER;
    SAVETMPS;

    /* call the column() method */
    PUSHMARK(SP);
    XPUSHs(((perl_vtab_cursor *) pVtabCursor)->perl_cursor_obj);
    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 );
        rc = SQLITE_OK;
    }

    PUTBACK;
    FREETMPS;
    LEAVE;

    return rc;
}

static int perl_vt_Rowid( sqlite3_vtab_cursor *pVtabCursor,
                          sqlite3_int64 *pRowid ){
    dTHX;
    dSP;
    int count;
    int rc = SQLITE_ERROR;

    ENTER;
    SAVETMPS;

    /* call the rowid() method */
    PUSHMARK(SP);
    XPUSHs(((perl_vtab_cursor *) pVtabCursor)->perl_cursor_obj);
    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;
        rc = SQLITE_OK;
    }

    PUTBACK;
    FREETMPS;
    LEAVE;

    return rc;
}

static int perl_vt_Update( sqlite3_vtab *pVTab, 
                           int argc, sqlite3_value **argv, 
                           sqlite3_int64 *pRowid ){
    dTHX;
    dSP;
    dMY_CXT;
    int count, i;
    int is_unicode = MY_CXT.last_dbh_is_unicode;
    int rc = SQLITE_ERROR;
    SV *rowidsv;

    ENTER;
    SAVETMPS;

    /* call the _SQLITE_UPDATE() method */
    PUSHMARK(SP);
    XPUSHs(((perl_vtab *) pVTab)->perl_vtab_obj);
    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*/
            rowidsv = POPs;
            if (!SvOK(rowidsv))
                *pRowid = 0;
            else if (SvUOK(rowidsv))
                *pRowid = SvUV(rowidsv);
            else if (SvIOK(rowidsv))
                *pRowid = SvIV(rowidsv);
            else
                *pRowid = (sqlite3_int64)SvNV(rowidsv);
        }
        rc = SQLITE_OK;
    }


    PUTBACK;
    FREETMPS;
    LEAVE;

    return rc;
}

static int perl_vt_Begin(sqlite3_vtab *pVTab){
  return _call_perl_vtab_method(pVTab, "BEGIN_TRANSACTION", 0);
}

static int perl_vt_Sync(sqlite3_vtab *pVTab){
  return _call_perl_vtab_method(pVTab, "SYNC_TRANSACTION", 0);
}

static int perl_vt_Commit(sqlite3_vtab *pVTab){
  return _call_perl_vtab_method(pVTab, "COMMIT_TRANSACTION", 0);
}

static int perl_vt_Rollback(sqlite3_vtab *pVTab){
  return _call_perl_vtab_method(pVTab, "ROLLBACK_TRANSACTION", 0);
}

static int perl_vt_FindFunction(sqlite3_vtab *pVTab, 
                       int nArg, const char *zName,
                       void (**pxFunc)(sqlite3_context*,int,sqlite3_value**),
                       void **ppArg){
    dTHX;
    dSP;
    dMY_CXT;
    int count;
    int is_overloaded = 0;
    char *func_name   = sqlite3_mprintf("%s\t%d", zName, nArg);
    STRLEN len        = strlen(func_name);
    HV *functions     = ((perl_vtab *) pVTab)->functions;
    SV* coderef       = NULL;
    SV** val;
    SV *result;

dbdimp.c  view on Meta::CPAN

    }

 cleanup:
    PUTBACK;
    FREETMPS;
    LEAVE;
    sqlite3_free(func_name);
    return is_overloaded;
}


static int perl_vt_Rename(sqlite3_vtab *pVTab, const char *zNew){
    dTHX;
    dSP;
    int count;
    int rc = SQLITE_ERROR;

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);
    XPUSHs(((perl_vtab *) pVTab)->perl_vtab_obj);
    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(pVTab, "SAVEPOINT", point);
}

static int perl_vt_Release(sqlite3_vtab *pVTab, int point){
    return _call_perl_vtab_method(pVTab, "RELEASE", point);
}

static int perl_vt_RollbackTo(sqlite3_vtab *pVTab, int point){
    return _call_perl_vtab_method(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_FindFunction, /* xFindFunction (optional) */
    perl_vt_Rename,       /* xRename */
#if SQLITE_VERSION_NUMBER >= 3007007
    perl_vt_Savepoint,    /* xSavepoint (optional) */
    perl_vt_Release,      /* xRelease (optional) */
    perl_vt_RollbackTo    /* xRollbackTo (optional) */
#endif
};


void
sqlite_db_destroy_module_data(void *pAux)
{
    dTHX;
    dSP;
    int count;
    int rc = SQLITE_ERROR;
    perl_vtab_init *init_data;

    ENTER;
    SAVETMPS;

    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)
{
    dSP;
    D_imp_dbh(dbh);
    int count, rc, retval = TRUE;
    char *module_ISA;
    char *loading_code;
    perl_vtab_init *init_data;



( run in 1.109 second using v1.01-cache-2.11-cpan-3c2a17b8caa )