JezK

Edit File: Driver.xst

#  $Id$
#  Copyright (c) 1997-2002  Tim Bunce  Ireland
#  Copyright (c) 2002       Jonathan Leffler
#
#  You may distribute under the terms of either the GNU General Public
#  License or the Artistic License, as specified in the Perl README file.

#include "Driver_xst.h"

# Historically dbd_db_do4, dbd_st_execute, and dbd_st_rows returned an 'int' type.
# That's only 32 bits (31+sign) so isn't sufficient for very large row counts
# So now instead of defining those macros, drivers can define dbd_db_do4_iv,
# dbd_st_execute_iv, and dbd_st_rows_iv to be the names of functions that
# return an 'IV' type. They could also set DBIc_ROW_COUNT(imp_sth).
#
# To save a mess of #ifdef's we arrange for dbd_st_execute (etc) to work
# as dbd_st_execute_iv if that's defined
#
#if defined(dbd_st_execute_iv)
#undef dbd_st_execute
#define dbd_st_execute dbd_st_execute_iv
#endif
#if defined(dbd_st_rows_iv)
#undef dbd_st_rows
#define dbd_st_rows dbd_st_rows_iv
#endif
#if defined(dbd_db_do4_iv)
#undef dbd_db_do4
#define dbd_db_do4 dbd_db_do4_iv
#endif

MODULE = DBD::~DRIVER~  PACKAGE = DBD::~DRIVER~

REQUIRE:    1.929
PROTOTYPES: DISABLE

BOOT:
    PERL_UNUSED_VAR(items);
    DBISTATE_INIT;
    /* XXX this interface will change: */
    DBI_IMP_SIZE("DBD::~DRIVER~::dr::imp_data_size", sizeof(imp_drh_t));
    DBI_IMP_SIZE("DBD::~DRIVER~::db::imp_data_size", sizeof(imp_dbh_t));
    DBI_IMP_SIZE("DBD::~DRIVER~::st::imp_data_size", sizeof(imp_sth_t));
    dbd_init(DBIS);

# ------------------------------------------------------------
# driver level interface
# ------------------------------------------------------------
MODULE = DBD::~DRIVER~  PACKAGE = DBD::~DRIVER~::dr

void
dbixs_revision(...)
    PPCODE:
    ST(0) = sv_2mortal(newSViv(DBIXS_REVISION));

#ifdef dbd_discon_all

# disconnect_all renamed and ALIAS'd to avoid length clash on VMS :-(
bool
discon_all_(drh)
    SV *        drh
    ALIAS:
        disconnect_all = 1
    CODE:
    D_imp_drh(drh);
    PERL_UNUSED_VAR(ix);
    RETVAL = dbd_discon_all(drh, imp_drh);
    OUTPUT:
    RETVAL

#endif /* dbd_discon_all */

#ifdef dbd_dr_data_sources

void
data_sources(drh, attr = Nullsv)
    SV *drh
    SV *attr
    PPCODE:
    {
        D_imp_drh(drh);
        AV *av = dbd_dr_data_sources(drh, imp_drh, attr);
        if (av) {
            int i;
            int n = AvFILL(av)+1;
            EXTEND(sp, n);
            for (i = 0; i < n; ++i) {
                PUSHs(AvARRAY(av)[i]);
            }
        }
    }

#endif

# ------------------------------------------------------------
# database level interface
# ------------------------------------------------------------
MODULE = DBD::~DRIVER~    PACKAGE = DBD::~DRIVER~::db

bool
_login(dbh, dbname, username, password, attribs=Nullsv)
    SV *        dbh
    SV *        dbname
    SV *        username
    SV *        password
    SV *        attribs
    CODE:
    {
    D_imp_dbh(dbh);
#if !defined(dbd_db_login6_sv)
    STRLEN lna;
    char *u = (SvOK(username)) ? SvPV(username,lna) : (char*)"";
    char *p = (SvOK(password)) ? SvPV(password,lna) : (char*)"";
#endif
#ifdef dbd_db_login6_sv
    RETVAL = dbd_db_login6_sv(dbh, imp_dbh, dbname, username, password, attribs);
#elif defined(dbd_db_login6)
    RETVAL = dbd_db_login6(dbh, imp_dbh, SvPV_nolen(dbname), u, p, attribs);
#else
    PERL_UNUSED_ARG(attribs);
    RETVAL = dbd_db_login( dbh, imp_dbh, SvPV_nolen(dbname), u, p);
#endif
    }
    OUTPUT:
    RETVAL

void
selectall_arrayref(...)
    PREINIT:
    SV *sth;
    SV **maxrows_svp;
    SV **tmp_svp;
    SV *tmp_sv;
    SV *attr = &PL_sv_undef;
    imp_sth_t *imp_sth;
    CODE:
    if (items > 2) {
        attr = ST(2);
        if (SvROK(attr) &&
                (DBD_ATTRIB_TRUE(attr,"Slice",5,tmp_svp) || DBD_ATTRIB_TRUE(attr,"Columns",7,tmp_svp))
        ) {
            /* fallback to perl implementation */
            SV *tmp =dbixst_bounce_method("DBD::~DRIVER~::db::SUPER::selectall_arrayref", items);
            SPAGAIN;
            ST(0) = tmp;
            XSRETURN(1);
        }
    }
    /* --- prepare --- */
    if (SvROK(ST(1))) {
        MAGIC *mg;
        sth = ST(1);
        /* switch to inner handle if not already */
        if ( (mg = mg_find(SvRV(sth),'P')) )
            sth = mg->mg_obj;
    }
    else {
        sth = dbixst_bounce_method("prepare", 3);
        SPAGAIN; SP -= items; /* because stack might have been realloc'd */
        if (!SvROK(sth))
            XSRETURN_UNDEF;
        /* switch to inner handle */
        sth = mg_find(SvRV(sth),'P')->mg_obj;
    }
    imp_sth = (imp_sth_t*)(DBIh_COM(sth));
    /* --- bind_param --- */
    if (items > 3) {    /* need to bind params before execute */
        if (!dbdxst_bind_params(sth, imp_sth, items-2, ax+2) ) {
            XSRETURN_UNDEF;
        }
    }
    /* --- execute --- */
    DBIc_ROW_COUNT(imp_sth) = 0;
    if ( dbd_st_execute(sth, imp_sth) <= -2 ) { /* -2 == error */
        XSRETURN_UNDEF;
    }
    /* --- fetchall --- */
    maxrows_svp = DBD_ATTRIB_GET_SVP(attr, "MaxRows", 7);
    tmp_sv = dbdxst_fetchall_arrayref(sth, &PL_sv_undef, (maxrows_svp) ? *maxrows_svp : &PL_sv_undef);
    SPAGAIN;
    ST(0) = tmp_sv;

void
selectrow_arrayref(...)
    ALIAS:
        selectrow_array = 1
    PREINIT:
    int is_selectrow_array = (ix == 1);
    imp_sth_t *imp_sth;
    SV *sth;
    AV *row_av;
    PPCODE:
    if (SvROK(ST(1))) {
        MAGIC *mg;
        sth = ST(1);
        /* switch to inner handle if not already */
        if ( (mg = mg_find(SvRV(sth),'P')) )
            sth = mg->mg_obj;
    }
    else {
        /* --- prepare --- */
        sth = dbixst_bounce_method("prepare", 3);
        SPAGAIN; SP -= items; /* because stack might have been realloc'd */
        if (!SvROK(sth)) {
            if (is_selectrow_array) { XSRETURN_EMPTY; } else { XSRETURN_UNDEF; }
        }
        /* switch to inner handle */
        sth = mg_find(SvRV(sth),'P')->mg_obj;
    }
    imp_sth = (imp_sth_t*)(DBIh_COM(sth));
    /* --- bind_param --- */
    if (items > 3) {    /* need to bind params before execute */
        if (!dbdxst_bind_params(sth, imp_sth, items-2, ax+2) ) {
            if (is_selectrow_array) { XSRETURN_EMPTY; } else { XSRETURN_UNDEF; }
        }
    }
    /* --- execute --- */
    DBIc_ROW_COUNT(imp_sth) = 0;
    if ( dbd_st_execute(sth, imp_sth) <= -2 ) { /* -2 == error */
        if (is_selectrow_array) { XSRETURN_EMPTY; } else { XSRETURN_UNDEF; }
    }
    /* --- fetchrow_arrayref --- */
    row_av = dbd_st_fetch(sth, imp_sth);
    if (!row_av) {
        if (GIMME == G_SCALAR)
            PUSHs(&PL_sv_undef);
    }
    else if (is_selectrow_array) {
        int i;
        int num_fields = AvFILL(row_av)+1;
        if (GIMME == G_SCALAR)
            num_fields = 1; /* return just first field */
        EXTEND(sp, num_fields);
        for(i=0; i < num_fields; ++i) {
            PUSHs(AvARRAY(row_av)[i]);
        }
    }
    else {
        PUSHs( sv_2mortal(newRV((SV *)row_av)) );
    }
    /* --- finish --- */
#ifdef dbd_st_finish3
    dbd_st_finish3(sth, imp_sth, 0);
#else
    dbd_st_finish(sth, imp_sth);
#endif

#if defined(dbd_db_do6) || defined(dbd_db_do4)

void
do(dbh, statement, params = Nullsv, ...)
    SV *        dbh
    SV *        statement
    SV *        params
    CODE:
    {
    D_imp_dbh(dbh);
    IV retval;
#ifdef dbd_db_do6
    /* items is a number of arguments passed to XSUB, supplied by xsubpp compiler */
    /* ax contains stack base offset used by ST() macro, supplied by xsubpp compiler */
    I32 offset = (items >= 3) ? 3 : items;
    retval = dbd_db_do6(dbh, imp_dbh, statement, params, items-offset, ax+offset);
#else
    if (items > 3)
        croak_xs_usage(cv,  "dbh, statement, params = Nullsv");
    retval = dbd_db_do4(dbh, imp_dbh, SvPV_nolen(statement), params); /* might be dbd_db_do4_iv via macro */
#endif
    /* remember that dbd_db_do* must return <= -2 for error     */
    if (retval == 0)            /* ok with no rows affected     */
        XST_mPV(0, "0E0");      /* (true but zero)              */
    else if (retval < -1)       /* -1 == unknown number of rows */
        XST_mUNDEF(0);          /* <= -2 means error            */
    else
        XST_mIV(0, retval);     /* typically 1, rowcount or -1  */
    }

#endif

#ifdef dbd_db_last_insert_id

void
last_insert_id(dbh, catalog=&PL_sv_undef, schema=&PL_sv_undef, table=&PL_sv_undef, field=&PL_sv_undef, attr=Nullsv)
    SV *        dbh
    SV *        catalog
    SV *        schema
    SV *        table
    SV *        field
    SV *        attr
    CODE:
    {
    D_imp_dbh(dbh);
    SV *ret = dbd_db_last_insert_id(dbh, imp_dbh, catalog, schema, table, field, attr);
    ST(0) = ret;
    }

#endif

bool
commit(dbh)
    SV *        dbh
    CODE:
    D_imp_dbh(dbh);
    if (DBIc_has(imp_dbh,DBIcf_AutoCommit) && DBIc_WARN(imp_dbh))
        warn("commit ineffective with AutoCommit enabled");
    RETVAL = dbd_db_commit(dbh, imp_dbh);
    OUTPUT:
    RETVAL

bool
rollback(dbh)
    SV *        dbh
    CODE:
    D_imp_dbh(dbh);
    if (DBIc_has(imp_dbh,DBIcf_AutoCommit) && DBIc_WARN(imp_dbh))
        warn("rollback ineffective with AutoCommit enabled");
    RETVAL = dbd_db_rollback(dbh, imp_dbh);
    OUTPUT:
    RETVAL

bool
disconnect(dbh)
    SV *        dbh
    CODE:
    D_imp_dbh(dbh);
    if ( !DBIc_ACTIVE(imp_dbh) ) {
        XSRETURN_YES;
    }
    /* Check for disconnect() being called whilst refs to cursors       */
    /* still exists. This possibly needs some more thought.             */
    if (DBIc_ACTIVE_KIDS(imp_dbh) && DBIc_WARN(imp_dbh) && !PL_dirty) {
        STRLEN lna;
        char *plural = (DBIc_ACTIVE_KIDS(imp_dbh)==1) ? (char*)"" : (char*)"s";
        warn("%s->disconnect invalidates %d active statement handle%s %s",
            SvPV(dbh,lna), (int)DBIc_ACTIVE_KIDS(imp_dbh), plural,
            "(either destroy statement handles or call finish on them before disconnecting)");
    }
    RETVAL = dbd_db_disconnect(dbh, imp_dbh);
    DBIc_ACTIVE_off(imp_dbh);   /* ensure it's off, regardless */
    OUTPUT:
    RETVAL

void
STORE(dbh, keysv, valuesv)
    SV *        dbh
    SV *        keysv
    SV *        valuesv
    CODE:
    D_imp_dbh(dbh);
    if (SvGMAGICAL(valuesv))
        mg_get(valuesv);
    ST(0) = &PL_sv_yes;
    if (!dbd_db_STORE_attrib(dbh, imp_dbh, keysv, valuesv))
        if (!DBIc_DBISTATE(imp_dbh)->set_attr(dbh, keysv, valuesv))
            ST(0) = &PL_sv_no;

void
FETCH(dbh, keysv)
    SV *        dbh
    SV *        keysv
    CODE:
    D_imp_dbh(dbh);
    SV *valuesv = dbd_db_FETCH_attrib(dbh, imp_dbh, keysv);
    if (!valuesv)
        valuesv = DBIc_DBISTATE(imp_dbh)->get_attr(dbh, keysv);
    ST(0) = valuesv;    /* dbd_db_FETCH_attrib did sv_2mortal   */

void
DESTROY(dbh)
    SV *        dbh
    PPCODE:
    /* keep in sync with default DESTROY in DBI.xs */
    D_imp_dbh(dbh);
    ST(0) = &PL_sv_yes;
    if (!DBIc_IMPSET(imp_dbh)) {        /* was never fully set up       */
        STRLEN lna;
        if (DBIc_WARN(imp_dbh) && !PL_dirty && DBIc_DBISTATE(imp_dbh)->debug >= 2)
             PerlIO_printf(DBIc_LOGPIO(imp_dbh),
                "         DESTROY for %s ignored - handle not initialised\n",
                    SvPV(dbh,lna));
    }
    else {
        if (DBIc_IADESTROY(imp_dbh)) {            /* wants ineffective destroy */
            DBIc_ACTIVE_off(imp_dbh);
            if (DBIc_DBISTATE(imp_dbh)->debug)
                 PerlIO_printf(DBIc_LOGPIO(imp_dbh), "         DESTROY %s skipped due to InactiveDestroy\n", SvPV_nolen(dbh));
        }
        if (DBIc_ACTIVE(imp_dbh)) {
            if (!DBIc_has(imp_dbh,DBIcf_AutoCommit)) {
                /* Application is using transactions and hasn't explicitly disconnected.
                    Some databases will automatically commit on graceful disconnect.
                    Since we're about to gracefully disconnect as part of the DESTROY
                    we want to be sure we're not about to implicitly commit changes
                    that are incomplete and should be rolled back. (The DESTROY may
                    be due to a RaiseError, for example.) So we rollback here.
                    This will be harmless if the application has issued a commit,
                    XXX Could add an attribute flag to indicate that the driver
                    doesn't have this problem. Patches welcome.
                */
                if (DBIc_WARN(imp_dbh) /* only warn if likely to be useful... */
                &&  DBIc_is(imp_dbh, DBIcf_Executed) /* has not just called commit/rollback */
            /*  && !DBIc_is(imp_dbh, DBIcf_ReadOnly) -- is not read only */
                && (!PL_dirty || DBIc_DBISTATE(imp_dbh)->debug >= 3)
                ) {
                    warn("Issuing rollback() due to DESTROY without explicit disconnect() of %s handle %s",
                        SvPV_nolen(*hv_fetch((HV*)SvRV(dbh), "ImplementorClass", 16, 1)),
                        SvPV_nolen(*hv_fetch((HV*)SvRV(dbh), "Name", 4, 1))
                    );
                }
                dbd_db_rollback(dbh, imp_dbh);                  /* ROLLBACK! */
            }
            dbd_db_disconnect(dbh, imp_dbh);
            DBIc_ACTIVE_off(imp_dbh);   /* ensure it's off, regardless */
        }
        dbd_db_destroy(dbh, imp_dbh);
    }

#ifdef dbd_take_imp_data

void
take_imp_data(h)
    SV * h
    CODE:
    D_imp_xxh(h);
    /* dbd_take_imp_data() returns &sv_no (or other defined but false value)
     * to indicate "preparations complete, now call SUPER::take_imp_data" for me.
     * Anything else is returned to the caller via sv_2mortal(sv), typically that
     * would be &sv_undef for error or an SV holding the imp_data.
     */
    SV *sv = dbd_take_imp_data(h, imp_xxh, NULL);
    if (SvOK(sv) && !SvTRUE(sv)) {
        SV *tmp = dbixst_bounce_method("DBD::~DRIVER~::db::SUPER::take_imp_data", items);
        SPAGAIN;
        ST(0) = tmp;
    } else {
        ST(0) = sv_2mortal(sv);
    }

#endif

#ifdef dbd_db_data_sources

void
data_sources(dbh, attr = Nullsv)
    SV *dbh
    SV *attr
    PPCODE:
    {
        D_imp_dbh(dbh);
        AV *av = dbd_db_data_sources(dbh, imp_dbh, attr);
        if (av) {
            int i;
            int n = AvFILL(av)+1;
            EXTEND(sp, n);
            for (i = 0; i < n; ++i) {
                PUSHs(AvARRAY(av)[i]);
            }
        }
    }

#endif

# -- end of DBD::~DRIVER~::db

# ------------------------------------------------------------
# statement interface
# ------------------------------------------------------------
MODULE = DBD::~DRIVER~    PACKAGE = DBD::~DRIVER~::st

bool
_prepare(sth, statement, attribs=Nullsv)
    SV *        sth
    SV *        statement
    SV *        attribs
    CODE:
    {
    D_imp_sth(sth);
    DBD_ATTRIBS_CHECK("_prepare", sth, attribs);
#ifdef dbd_st_prepare_sv
    RETVAL = dbd_st_prepare_sv(sth, imp_sth, statement, attribs);
#else
    RETVAL = dbd_st_prepare(sth, imp_sth, SvPV_nolen(statement), attribs);
#endif
    }
    OUTPUT:
    RETVAL

#ifdef dbd_st_rows

void
rows(sth)
    SV *        sth
    CODE:
    D_imp_sth(sth);
    XST_mIV(0, dbd_st_rows(sth, imp_sth));

#endif /* dbd_st_rows */

#ifdef dbd_st_bind_col

bool
bind_col(sth, col, ref, attribs=Nullsv)
    SV *        sth
    SV *        col
    SV *        ref
    SV *        attribs
    CODE:
    {
    IV sql_type = 0;
    D_imp_sth(sth);
    if (SvGMAGICAL(ref))
        mg_get(ref);
    if (attribs) {
        if (SvNIOK(attribs)) {
            sql_type = SvIV(attribs);
            attribs = Nullsv;
        }
        else {
            SV **svp;
            DBD_ATTRIBS_CHECK("bind_col", sth, attribs);
            /* XXX we should perhaps complain if TYPE is not SvNIOK */
            DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
        }
    }
    switch(dbd_st_bind_col(sth, imp_sth, col, ref, sql_type, attribs)) {
    case 2:     RETVAL = TRUE;              /* job done completely */
                break;
    case 1:     /* fallback to DBI default */
                RETVAL = DBIc_DBISTATE(imp_sth)->bind_col(sth, col, ref, attribs);
                break;
    default:    RETVAL = FALSE;             /* dbd_st_bind_col has called set_err */
                break;
    }
    }
    OUTPUT:
    RETVAL

#endif /* dbd_st_bind_col */

bool
bind_param(sth, param, value, attribs=Nullsv)
    SV *        sth
    SV *        param
    SV *        value
    SV *        attribs
    CODE:
    {
    IV sql_type = 0;
    D_imp_sth(sth);
    if (SvGMAGICAL(value))
        mg_get(value);
    if (attribs) {
        if (SvNIOK(attribs)) {
            sql_type = SvIV(attribs);
            attribs = Nullsv;
        }
        else {
            SV **svp;
            DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
            /* XXX we should perhaps complain if TYPE is not SvNIOK */
            DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
        }
    }
    RETVAL = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, FALSE, 0);
    }
    OUTPUT:
    RETVAL

bool
bind_param_inout(sth, param, value_ref, maxlen, attribs=Nullsv)
    SV *        sth
    SV *        param
    SV *        value_ref
    IV          maxlen
    SV *        attribs
    CODE:
    {
    IV sql_type = 0;
    D_imp_sth(sth);
    SV *value;
    if (!SvROK(value_ref) || SvTYPE(SvRV(value_ref)) > SVt_PVMG)
        croak("bind_param_inout needs a reference to a scalar value");
    value = SvRV(value_ref);
    if (SvREADONLY(value))
        croak("Modification of a read-only value attempted");
    if (SvGMAGICAL(value))
        mg_get(value);
    if (attribs) {
        if (SvNIOK(attribs)) {
            sql_type = SvIV(attribs);
            attribs = Nullsv;
        }
        else {
            SV **svp;
            DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
            DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
        }
    }
    RETVAL = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, TRUE, maxlen);
    }
    OUTPUT:
    RETVAL

void
execute(sth, ...)
    SV *        sth
    CODE:
    D_imp_sth(sth);
    IV retval;
    if (items > 1) {    /* need to bind params */
        if (!dbdxst_bind_params(sth, imp_sth, items, ax) ) {
            XSRETURN_UNDEF;
        }
    }
    /* XXX this code is duplicated in selectrow_arrayref above  */
    DBIc_ROW_COUNT(imp_sth) = 0;
    retval = dbd_st_execute(sth, imp_sth); /* might be dbd_st_execute_iv via macro */
    /* remember that dbd_st_execute must return <= -2 for error */
    if (retval == 0)            /* ok with no rows affected     */
        XST_mPV(0, "0E0");      /* (true but zero)              */
    else if (retval < -1)       /* -1 == unknown number of rows */
        XST_mUNDEF(0);          /* <= -2 means error            */
    else
        XST_mIV(0, retval);     /* typically 1, rowcount or -1  */

#ifdef dbd_st_execute_for_fetch

void
execute_for_fetch(sth, fetch_tuple_sub, tuple_status = Nullsv)
    SV *        sth
    SV *        fetch_tuple_sub
    SV *        tuple_status
    CODE:
    {
    D_imp_sth(sth);
    SV *ret = dbd_st_execute_for_fetch(sth, imp_sth, fetch_tuple_sub, tuple_status);
    ST(0) = ret;
    }

#endif

#ifdef dbd_st_last_insert_id

void
last_insert_id(sth, catalog=&PL_sv_undef, schema=&PL_sv_undef, table=&PL_sv_undef, field=&PL_sv_undef, attr=Nullsv)
    SV *        sth
    SV *        catalog
    SV *        schema
    SV *        table
    SV *        field
    SV *        attr
    CODE:
    {
    D_imp_sth(sth);
    SV *ret = dbd_st_last_insert_id(sth, imp_sth, catalog, schema, table, field, attr);
    ST(0) = ret;
    }

#endif

void
fetchrow_arrayref(sth)
    SV *        sth
    ALIAS:
        fetch = 1
    CODE:
    D_imp_sth(sth);
    AV *av;
    PERL_UNUSED_VAR(ix);
    av = dbd_st_fetch(sth, imp_sth);
    ST(0) = (av) ? sv_2mortal(newRV((SV *)av)) : &PL_sv_undef;

void
fetchrow_array(sth)
    SV *        sth
    ALIAS:
        fetchrow = 1
    PPCODE:
    D_imp_sth(sth);
    AV *av;
    av = dbd_st_fetch(sth, imp_sth);
    if (av) {
        int i;
        int num_fields = AvFILL(av)+1;
        EXTEND(sp, num_fields);
        for(i=0; i < num_fields; ++i) {
            PUSHs(AvARRAY(av)[i]);
        }
        PERL_UNUSED_VAR(ix);
    }

void
fetchall_arrayref(sth, slice=&PL_sv_undef, batch_row_count=&PL_sv_undef)
    SV *        sth
    SV *        slice
    SV *        batch_row_count
    CODE:
    if (SvOK(slice)) {  /* fallback to perl implementation */
        SV *tmp = dbixst_bounce_method("DBD::~DRIVER~::st::SUPER::fetchall_arrayref", 3);
        SPAGAIN;
        ST(0) = tmp;
    }
    else {
        SV *tmp = dbdxst_fetchall_arrayref(sth, slice, batch_row_count);
        SPAGAIN;
        ST(0) = tmp;
    }

bool
finish(sth)
    SV *        sth
    CODE:
    D_imp_sth(sth);
    D_imp_dbh_from_sth;
    if (!DBIc_ACTIVE(imp_sth)) {
        /* No active statement to finish        */
        XSRETURN_YES;
    }
    if (!DBIc_ACTIVE(imp_dbh)) {
        /* Either an explicit disconnect() or global destruction        */
        /* has disconnected us from the database. Finish is meaningless */
        DBIc_ACTIVE_off(imp_sth);
        XSRETURN_YES;
    }
#ifdef dbd_st_finish3
    RETVAL = dbd_st_finish3(sth, imp_sth, 0);
#else
    RETVAL = dbd_st_finish(sth, imp_sth);
#endif
    OUTPUT:
    RETVAL

void
blob_read(sth, field, offset, len, destrv=Nullsv, destoffset=0)
    SV *        sth
    int field
    long        offset
    long        len
    SV *        destrv
    long        destoffset
    CODE:
    {
    D_imp_sth(sth);
    if (!destrv)
        destrv = sv_2mortal(newRV(sv_2mortal(newSV(0))));
    if (dbd_st_blob_read(sth, imp_sth, field, offset, len, destrv, destoffset))
         ST(0) = SvRV(destrv);
    else ST(0) = &PL_sv_undef;
    }

void
STORE(sth, keysv, valuesv)
    SV *        sth
    SV *        keysv
    SV *        valuesv
    CODE:
    D_imp_sth(sth);
    if (SvGMAGICAL(valuesv))
        mg_get(valuesv);
    ST(0) = &PL_sv_yes;
    if (!dbd_st_STORE_attrib(sth, imp_sth, keysv, valuesv))
        if (!DBIc_DBISTATE(imp_sth)->set_attr(sth, keysv, valuesv))
            ST(0) = &PL_sv_no;

# FETCH renamed and ALIAS'd to avoid case clash on VMS :-(
void
FETCH_attrib(sth, keysv)
    SV *        sth
    SV *        keysv
    ALIAS:
    FETCH = 1
    CODE:
    D_imp_sth(sth);
    SV *valuesv;
    PERL_UNUSED_VAR(ix);
    valuesv = dbd_st_FETCH_attrib(sth, imp_sth, keysv);
    if (!valuesv)
        valuesv = DBIc_DBISTATE(imp_sth)->get_attr(sth, keysv);
    ST(0) = valuesv;    /* dbd_st_FETCH_attrib did sv_2mortal   */

void
DESTROY(sth)
    SV *        sth
    PPCODE:
    /* keep in sync with default DESTROY in DBI.xs */
    D_imp_sth(sth);
    ST(0) = &PL_sv_yes;
    if (!DBIc_IMPSET(imp_sth)) {        /* was never fully set up       */
        STRLEN lna;
        if (DBIc_WARN(imp_sth) && !PL_dirty && DBIc_DBISTATE(imp_sth)->debug >= 2)
             PerlIO_printf(DBIc_LOGPIO(imp_sth),
                "         DESTROY for %s ignored - handle not initialised\n",
                    SvPV(sth,lna));
    }
    else {
        if (DBIc_IADESTROY(imp_sth)) {  /* wants ineffective destroy    */
            DBIc_ACTIVE_off(imp_sth);
            if (DBIc_DBISTATE(imp_sth)->debug)
                 PerlIO_printf(DBIc_LOGPIO(imp_sth), "         DESTROY %s skipped due to InactiveDestroy\n", SvPV_nolen(sth));
        }
        if (DBIc_ACTIVE(imp_sth)) {
            D_imp_dbh_from_sth;
            if (!PL_dirty && DBIc_ACTIVE(imp_dbh)) {
#ifdef dbd_st_finish3
                dbd_st_finish3(sth, imp_sth, 1);
#else
                dbd_st_finish(sth, imp_sth);
#endif
            }
            else {
                DBIc_ACTIVE_off(imp_sth);
            }
        }
        dbd_st_destroy(sth, imp_sth);
    }

# end of ~DRIVER~.xst
# vim:ts=8:sw=4:et

JezK

Edit File: Driver.xst

FAIRNETZT