DBI
view release on metacpan or search on metacpan
dbi_bootinit(parent_dbis);
void
_new_handle(class, parent, attr_ref, imp_datasv, imp_class)
SV * class
SV * parent
SV * attr_ref
SV * imp_datasv
SV * imp_class
PPCODE:
dMY_CXT;
HV *outer;
SV *outer_ref;
HV *class_stash = gv_stashsv(class, GV_ADDWARN);
if (DBIS_TRACE_LEVEL >= 5) {
PerlIO_printf(DBILOGFP, " New %s (for %s, parent=%s, id=%s)\n",
neatsvpv(class,0), SvPV_nolen(imp_class), neatsvpv(parent,0), neatsvpv(imp_datasv,0));
PERL_UNUSED_VAR(cv);
}
SV * sv
CODE:
D_imp_xxh(sv);
(void)cv;
ST(0) = sv_mortalcopy(DBIc_IMP_DATA(imp_xxh)); /* okay if NULL */
void
_handles(sv)
SV * sv
PPCODE:
/* return the outer and inner handle for any given handle */
D_imp_xxh(sv);
SV *ih = sv_mortalcopy( dbih_inner(aTHX_ sv, "_handles") );
SV *oh = sv_2mortal(newRV_inc((SV*)DBIc_MY_H(imp_xxh))); /* XXX dangerous */
(void)cv;
EXTEND(SP, 2);
PUSHs(oh); /* returns outer handle then inner */
if (GIMME_V != G_SCALAR) {
PUSHs(ih);
}
const char *key
long type
CODE:
(void)cv;
RETVAL = dbi_hash(key, type);
OUTPUT:
RETVAL
void
looks_like_number(...)
PPCODE:
int i;
EXTEND(SP, items);
(void)cv;
for(i=0; i < items ; ++i) {
SV *sv = ST(i);
if (!SvOK(sv) || (SvPOK(sv) && SvCUR(sv)==0))
PUSHs(&PL_sv_undef);
else if ( looks_like_number(sv) )
PUSHs(&PL_sv_yes);
else
ret = boolSV(dbih_sth_bind_col(sth, col, ref, attribs));
ST(0) = ret;
(void)cv;
void
fetchrow_array(sth)
SV * sth
ALIAS:
fetchrow = 1
PPCODE:
SV *retsv;
if (CvDEPTH(cv) == 99) {
PERL_UNUSED_VAR(ix);
croak("Deep recursion, probably fetchrow-fetch-fetchrow loop");
}
PUSHMARK(sp);
XPUSHs(sth);
PUTBACK;
if (call_method("fetch", G_SCALAR) != 1)
croak("panic: DBI fetch"); /* should never happen */
CODE:
D_imp_sth(sth);
DBIc_ACTIVE_off(imp_sth);
ST(0) = &PL_sv_yes;
(void)cv;
void
DESTROY(sth)
SV * sth
PPCODE:
/* keep in sync with DESTROY in Driver.xst */
D_imp_sth(sth);
ST(0) = &PL_sv_yes;
/* we don't test IMPSET here because this code applies to pure-perl drivers */
if (DBIc_IADESTROY(imp_sth)) { /* want's ineffective destroy */
DBIc_ACTIVE_off(imp_sth);
if (DBIc_TRACE_LEVEL(imp_sth))
PerlIO_printf(DBIc_LOGPIO(imp_sth), " DESTROY %s skipped due to InactiveDestroy\n", SvPV_nolen(sth));
}
if (DBIc_ACTIVE(imp_sth)) {
void
set_err(h, err, errstr=&PL_sv_no, state=&PL_sv_undef, method=&PL_sv_undef, result=Nullsv)
SV * h
SV * err
SV * errstr
SV * state
SV * method
SV * result
PPCODE:
{
D_imp_xxh(h);
SV **sem_svp;
(void)cv;
if (DBIc_has(imp_xxh, DBIcf_HandleSetErr) && SvREADONLY(method))
method = sv_mortalcopy(method); /* HandleSetErr may want to change it */
if (!set_err_sv(h, imp_xxh, err, errstr, state, method)) {
/* set_err was canceled by HandleSetErr, */
# ------------------------------------------------------------
# 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:
#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]);
}
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);
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));
}
}
#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]);
}
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);
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));
}
( run in 1.889 second using v1.01-cache-2.11-cpan-71847e10f99 )