# $Id: Driver.xst,v 11.14 2003/08/22 21:23:39 timbo Exp $
# 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"
MODULE = DBD::~DRIVER~ PACKAGE = DBD::~DRIVER~
REQUIRE: 1.929
PROTOTYPES: DISABLE
BOOT:
items = 0; /* avoid 'unused variable' warning */
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
#ifdef dbd_discon_all
# disconnect_all renamed and ALIAS'd to avoid length clash on VMS :-(
void
discon_all_(drh)
SV * drh
ALIAS:
disconnect_all = 1
CODE:
D_imp_drh(drh);
if (0) ix = ix; /* avoid unused variable warning */
ST(0) = dbd_discon_all(drh, imp_drh) ? &sv_yes : &sv_no;
#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
void
_login(dbh, dbname, username, password, attribs=Nullsv)
SV * dbh
char * dbname
SV * username
SV * password
SV * attribs
CODE:
{
STRLEN lna;
D_imp_dbh(dbh);
char *u = (SvOK(username)) ? SvPV(username,lna) : "";
char *p = (SvOK(password)) ? SvPV(password,lna) : "";
#ifdef dbd_db_login6
ST(0) = dbd_db_login6(dbh, imp_dbh, dbname, u, p, attribs) ? &sv_yes : &sv_no;
#else
ST(0) = dbd_db_login( dbh, imp_dbh, dbname, u, p) ? &sv_yes : &sv_no;
#endif
}
void
selectall_arrayref(...)
PREINIT:
SV *sth;
SV **maxrows_svp;
SV **tmp_svp;
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 */
ST(0) = dbixst_bounce_method("DBD::~DRIVER~::db::SUPER::selectall_arrayref", items);
XSRETURN(1);
}
}
/* --- prepare --- */
if (SvROK(ST(1))) {
sth = ST(1);
}
else {
sth = dbixst_bounce_method("prepare", 3);
if (!SvROK(sth))
XSRETURN_UNDEF;
}
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);
ST(0) = dbdxst_fetchall_arrayref(sth, &PL_sv_undef, (maxrows_svp) ? *maxrows_svp : &PL_sv_undef);
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))) {
sth = ST(1);
}
else {
/* --- prepare --- */
sth = dbixst_bounce_method("prepare", 3);
if (!SvROK(sth)) {
if (is_selectrow_array) { XSRETURN_EMPTY; } else { XSRETURN_UNDEF; }
}
}
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
#ifdef dbd_db_do4 /* deebeedee-deebee-doo, deebee-doobee-dah? */
void
do(dbh, statement, params = Nullsv)
SV * dbh
char * statement
SV * params
CODE:
{
D_imp_dbh(dbh);
IV retval;
retval = dbd_db_do4(dbh, imp_dbh, statement, params);
/* remember that dbd_db_do4 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, schema, table, field, attr=Nullsv)
SV * dbh
SV * catalog
SV * schema
SV * table
SV * field
SV * attr
CODE:
{
D_imp_dbh(dbh);
ST(0) = dbd_db_last_insert_id(dbh, imp_dbh, catalog, schema, table, field, attr);
}
#endif
void
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");
ST(0) = dbd_db_commit(dbh, imp_dbh) ? &sv_yes : &sv_no;
void
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");
ST(0) = dbd_db_rollback(dbh, imp_dbh) ? &sv_yes : &sv_no;
void
disconnect(dbh)
SV * dbh
CODE:
D_imp_dbh(dbh);
if ( !DBIc_ACTIVE(imp_dbh) ) {
XSRETURN_YES;
}
/* pre-disconnect checks and tidy-ups */
if (DBIc_CACHED_KIDS(imp_dbh)) {
SvREFCNT_dec(DBIc_CACHED_KIDS(imp_dbh)); /* cast them to the winds */
DBIc_CACHED_KIDS(imp_dbh) = Nullhv;
}
/* 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) && !dirty) {
STRLEN lna;
char *plural = (DBIc_ACTIVE_KIDS(imp_dbh)==1) ? "" : "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)");
}
ST(0) = dbd_db_disconnect(dbh, imp_dbh) ? &sv_yes : &sv_no;
DBIc_ACTIVE_off(imp_dbh); /* ensure it's off, regardless */
void
STORE(dbh, keysv, valuesv)
SV * dbh
SV * keysv
SV * valuesv
CODE:
D_imp_dbh(dbh);
if (SvGMAGICAL(valuesv))
mg_get(valuesv);
ST(0) = &sv_yes;
if (!dbd_db_STORE_attrib(dbh, imp_dbh, keysv, valuesv))
if (!DBIc_DBISTATE(imp_dbh)->set_attr(dbh, keysv, valuesv))
ST(0) = &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:
D_imp_dbh(dbh);
ST(0) = &sv_yes;
if (!DBIc_IMPSET(imp_dbh)) { /* was never fully set up */
STRLEN lna;
if (DBIc_WARN(imp_dbh) && !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 {
/* pre-disconnect checks and tidy-ups */
if (DBIc_CACHED_KIDS(imp_dbh)) {
SvREFCNT_dec(DBIc_CACHED_KIDS(imp_dbh)); /* cast them to the winds */
DBIc_CACHED_KIDS(imp_dbh) = Nullhv;
}
if (DBIc_IADESTROY(imp_dbh)) { /* want's 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)) {
/* The application has not explicitly disconnected. That's bad. */
/* To ensure integrity we *must* issue a rollback. This will be */
/* harmless if the application has issued a commit. If it hasn't */
/* then it'll ensure integrity. Consider a Ctrl-C killing perl */
/* between two statements that must be executed as a transaction. */
/* Perl will call DESTROY on the dbh and, if we don't rollback, */
/* the server may automatically commit! Bham! Corrupt database! */
if (!DBIc_has(imp_dbh,DBIcf_AutoCommit)) {
if (DBIc_WARN(imp_dbh)
&& DBIc_is(imp_dbh, DBIcf_Executed)
&& (!dirty || DBIc_DBISTATE(imp_dbh)->debug >= 3)
)
warn("Issuing rollback() for database handle being DESTROY'd without explicit disconnect()");
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);
ST(0) = (SvOK(sv) && !SvTRUE(sv))
? dbixst_bounce_method("DBD::~DRIVER~::db::SUPER::take_imp_data", items)
: 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
void
_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
ST(0) = dbd_st_prepare_sv(sth, imp_sth, statement, attribs) ? &sv_yes : &sv_no;
#else
ST(0) = dbd_st_prepare(sth, imp_sth, SvPV_nolen(statement), attribs) ? &sv_yes : &sv_no;
#endif
}
#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
void
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: ST(0) = &sv_yes; /* job done completely */
break;
case 1: /* fallback to DBI default */
ST(0) = (DBIc_DBISTATE(imp_sth)->bind_col(sth, col, ref, attribs))
? &sv_yes : &sv_no;
break;
default: ST(0) = &sv_no; /* dbd_st_bind_col has called set_err */
break;
}
}
#endif /* dbd_st_bind_col */
void
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);
}
}
ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, FALSE, 0)
? &sv_yes : &sv_no;
}
void
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);
}
}
ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, TRUE, maxlen)
? &sv_yes : &sv_no;
}
void
execute(sth, ...)
SV * sth
CODE:
D_imp_sth(sth);
int 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 */
if (DBIc_ROW_COUNT(imp_sth) > 0) /* reset for re-execute */
DBIc_ROW_COUNT(imp_sth) = 0;
retval = dbd_st_execute(sth, imp_sth);
/* 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);
ST(0) = dbd_st_execute_for_fetch(sth, imp_sth, fetch_tuple_sub, tuple_status);
}
#endif
void
fetchrow_arrayref(sth)
SV * sth
ALIAS:
fetch = 1
CODE:
D_imp_sth(sth);
AV *av;
if (0) ix = ix; /* avoid unused variable warning */
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]);
}
if (0) ix = ix; /* avoid unused variable warning */
}
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 */
ST(0) = dbixst_bounce_method("DBD::~DRIVER~::st::SUPER::fetchall_arrayref", 3);
}
else {
ST(0) = dbdxst_fetchall_arrayref(sth, slice, batch_row_count);
}
void
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
ST(0) = dbd_st_finish3(sth, imp_sth, 0) ? &sv_yes : &sv_no;
#else
ST(0) = dbd_st_finish(sth, imp_sth) ? &sv_yes : &sv_no;
#endif
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) = &sv_yes;
if (!dbd_st_STORE_attrib(sth, imp_sth, keysv, valuesv))
if (!DBIc_DBISTATE(imp_sth)->set_attr(sth, keysv, valuesv))
ST(0) = &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;
if (0) ix = ix; /* avoid unused variable warning */
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:
D_imp_sth(sth);
ST(0) = &sv_yes;
if (!DBIc_IMPSET(imp_sth)) { /* was never fully set up */
STRLEN lna;
if (DBIc_WARN(imp_sth) && !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)) { /* want's 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 (!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