| Current File : //proc/thread-self/root/usr/lib/x86_64-linux-gnu/perl5/5.38/auto/DBI/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