Initial Commit
This commit is contained in:
851
database/perl/vendor/lib/auto/DBI/Driver.xst
vendored
Normal file
851
database/perl/vendor/lib/auto/DBI/Driver.xst
vendored
Normal file
@@ -0,0 +1,851 @@
|
||||
# $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
|
||||
Reference in New Issue
Block a user