DBI
view release on metacpan or search on metacpan
SQL_UDT = SQL_UDT
SQL_UDT_LOCATOR = SQL_UDT_LOCATOR
SQL_UNKNOWN_TYPE = SQL_UNKNOWN_TYPE
SQL_VARBINARY = SQL_VARBINARY
SQL_VARCHAR = SQL_VARCHAR
SQL_WCHAR = SQL_WCHAR
SQL_WLONGVARCHAR = SQL_WLONGVARCHAR
SQL_WVARCHAR = SQL_WVARCHAR
SQL_CURSOR_FORWARD_ONLY = SQL_CURSOR_FORWARD_ONLY
SQL_CURSOR_KEYSET_DRIVEN = SQL_CURSOR_KEYSET_DRIVEN
SQL_CURSOR_DYNAMIC = SQL_CURSOR_DYNAMIC
SQL_CURSOR_STATIC = SQL_CURSOR_STATIC
SQL_CURSOR_TYPE_DEFAULT = SQL_CURSOR_TYPE_DEFAULT
DBIpp_cm_cs = DBIpp_cm_cs
DBIpp_cm_hs = DBIpp_cm_hs
DBIpp_cm_dd = DBIpp_cm_dd
DBIpp_cm_dw = DBIpp_cm_dw
DBIpp_cm_br = DBIpp_cm_br
DBIpp_cm_XX = DBIpp_cm_XX
DBIpp_ph_qm = DBIpp_ph_qm
DBIpp_ph_cn = DBIpp_ph_cn
DBIpp_ph_cs = DBIpp_ph_cs
DBIpp_ph_sp = DBIpp_ph_sp
DBIpp_ph_XX = DBIpp_ph_XX
DBIpp_st_qq = DBIpp_st_qq
DBIpp_st_bs = DBIpp_st_bs
DBIpp_st_XX = DBIpp_st_XX
DBIstcf_DISCARD_STRING = DBIstcf_DISCARD_STRING
DBIstcf_STRICT = DBIstcf_STRICT
DBIf_TRACE_SQL = DBIf_TRACE_SQL
DBIf_TRACE_CON = DBIf_TRACE_CON
DBIf_TRACE_ENC = DBIf_TRACE_ENC
DBIf_TRACE_DBD = DBIf_TRACE_DBD
DBIf_TRACE_TXN = DBIf_TRACE_TXN
CODE:
RETVAL = ix;
OUTPUT:
RETVAL
void
_clone_dbis()
CODE:
dMY_CXT;
dbistate_t * parent_dbis = DBIS;
(void)cv;
{
MY_CXT_CLONE;
}
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);
}
(void)hv_stores((HV*)SvRV(attr_ref), "ImplementorClass", SvREFCNT_inc(imp_class));
/* make attr into inner handle by blessing it into class */
sv_bless(attr_ref, class_stash);
/* tie new outer hash to inner handle */
outer = newHV(); /* create new hash to be outer handle */
outer_ref = newRV_noinc((SV*)outer);
/* make outer hash into a handle by blessing it into class */
sv_bless(outer_ref, class_stash);
/* tie outer handle to inner handle */
sv_magic((SV*)outer, attr_ref, PERL_MAGIC_tied, Nullch, 0);
dbih_setup_handle(aTHX_ outer_ref, SvPV_nolen(imp_class), parent, SvOK(imp_datasv) ? imp_datasv : Nullsv);
/* return outer handle, plus inner handle if not in scalar context */
sv_2mortal(outer_ref);
EXTEND(SP, 2);
PUSHs(outer_ref);
if (GIMME_V != G_SCALAR) {
PUSHs(attr_ref);
}
void
_setup_handle(sv, imp_class, parent, imp_datasv)
SV * sv
char * imp_class
SV * parent
SV * imp_datasv
CODE:
(void)cv;
dbih_setup_handle(aTHX_ sv, imp_class, parent, SvOK(imp_datasv) ? imp_datasv : Nullsv);
ST(0) = &PL_sv_undef;
void
_get_imp_data(sv)
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);
}
void
neat(sv, maxlen=0)
SV * sv
U32 maxlen
CODE:
ST(0) = sv_2mortal(newSVpv(neatsvpv(sv, maxlen), 0));
(void)cv;
I32
hash(key, type=0)
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
PUSHs(&PL_sv_no);
}
void
_install_method(dbi_class, meth_name, file, attribs=Nullsv)
const char * dbi_class
char * meth_name
char * file
SV * attribs
CODE:
{
dMY_CXT;
/* install another method name/interface for the DBI dispatcher */
SV *trace_msg = (DBIS_TRACE_LEVEL >= 10) ? sv_2mortal(newSVpvs("")) : Nullsv;
CV *cv;
SV **svp;
dbi_ima_t *ima;
MAGIC *mg;
(void)dbi_class;
if (strnNE(meth_name, "DBI::", 5)) /* XXX m/^DBI::\w+::\w+$/ */
croak("install_method %s: invalid class", meth_name);
if (trace_msg)
sv_catpvf(trace_msg, "install_method %-21s", meth_name);
Newxz(ima, 1, dbi_ima_t);
if (attribs && SvOK(attribs)) {
/* convert and store method attributes in a fast access form */
if (SvTYPE(SvRV(attribs)) != SVt_PVHV)
croak("install_method %s: bad attribs", meth_name);
DBD_ATTRIB_GET_IV(attribs, "O",1, svp, ima->flags);
DBD_ATTRIB_GET_UV(attribs, "T",1, svp, ima->method_trace);
DBD_ATTRIB_GET_IV(attribs, "H",1, svp, ima->hidearg);
if (trace_msg) {
if (ima->flags) sv_catpvf(trace_msg, ", flags 0x%04x", (unsigned)ima->flags);
if (ima->method_trace)sv_catpvf(trace_msg, ", T 0x%08lx", (unsigned long)ima->method_trace);
if (ima->hidearg) sv_catpvf(trace_msg, ", H %u", (unsigned)ima->hidearg);
}
if ( (svp=DBD_ATTRIB_GET_SVP(attribs, "U",1)) != NULL) {
AV *av = (AV*)SvRV(*svp);
ima->minargs = (U8)SvIV(*av_fetch(av, 0, 1));
ima->maxargs = (U8)SvIV(*av_fetch(av, 1, 1));
svp = av_fetch(av, 2, 0);
ima->usage_msg = (svp) ? savepv_using_sv(SvPV_nolen(*svp)) : "";
ima->flags |= IMA_HAS_USAGE;
CODE:
D_imp_sth(sth);
int i;
AV *src_av;
AV *dst_av = dbih_get_fbav(imp_sth);
int dst_fields = AvFILL(dst_av)+1;
int src_fields;
(void)cv;
if (!SvROK(src_rv) || SvTYPE(SvRV(src_rv)) != SVt_PVAV)
croak("_set_fbav(%s): not an array ref", neatsvpv(src_rv,0));
src_av = (AV*)SvRV(src_rv);
src_fields = AvFILL(src_av)+1;
if (src_fields != dst_fields) {
warn("_set_fbav(%s): array has %d elements, the statement handle row buffer has %d (and NUM_OF_FIELDS is %d)",
neatsvpv(src_rv,0), src_fields, dst_fields, DBIc_NUM_FIELDS(imp_sth));
SvREADONLY_off(dst_av);
if (src_fields < dst_fields) {
/* shrink the array - sadly this looses column bindings for the lost columns */
av_fill(dst_av, src_fields-1);
dst_fields = src_fields;
}
else {
av_fill(dst_av, src_fields-1);
/* av_fill pads with immutable undefs which we need to change */
for(i=dst_fields-1; i < src_fields; ++i) {
sv_setsv(AvARRAY(dst_av)[i], newSV(0));
}
}
SvREADONLY_on(dst_av);
}
for(i=0; i < dst_fields; ++i) { /* copy over the row */
/* If we're given the values, then taint them if required */
if (DBIc_is(imp_sth, DBIcf_TaintOut))
SvTAINT(AvARRAY(src_av)[i]);
sv_setsv(AvARRAY(dst_av)[i], AvARRAY(src_av)[i]);
}
ST(0) = sv_2mortal(newRV_inc((SV*)dst_av));
void
bind_col(sth, col, ref, attribs=Nullsv)
SV * sth
SV * col
SV * ref
SV * attribs
PREINIT:
SV *ret;
CODE:
DBD_ATTRIBS_CHECK("bind_col", sth, attribs);
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 */
SPAGAIN;
retsv = POPs;
PUTBACK;
if (SvROK(retsv) && SvTYPE(SvRV(retsv)) == SVt_PVAV) {
D_imp_sth(sth);
int num_fields, i;
AV *bound_av;
AV *av = (AV*)SvRV(retsv);
num_fields = AvFILL(av)+1;
EXTEND(sp, num_fields+1);
/* We now check for bind_col() having been called but fetch */
/* not returning the fields_svav array. Probably because the */
/* driver is implemented in perl. XXX This logic may change later. */
bound_av = DBIc_FIELDS_AV(imp_sth); /* bind_col() called ? */
if (bound_av && av != bound_av) {
/* let dbih_get_fbav know what's going on */
bound_av = dbih_get_fbav(imp_sth);
if (DBIc_TRACE_LEVEL(imp_sth) >= 3) {
PerlIO_printf(DBIc_LOGPIO(imp_sth),
"fetchrow: updating fbav 0x%lx from 0x%lx\n",
(long)bound_av, (long)av);
}
for(i=0; i < num_fields; ++i) { /* copy over the row */
sv_setsv(AvARRAY(bound_av)[i], AvARRAY(av)[i]);
}
}
for(i=0; i < num_fields; ++i) {
PUSHs(AvARRAY(av)[i]);
}
}
SV *
fetchrow_hashref(sth, keyattrib=Nullch)
SV * sth
const char *keyattrib
PREINIT:
SV *rowavr;
SV *ka_rv;
D_imp_sth(sth);
CODE:
(void)cv;
PUSHMARK(sp);
XPUSHs(sth);
PUTBACK;
if (!keyattrib || !*keyattrib) {
SV *kn = DBIc_FetchHashKeyName(imp_sth);
if (kn && SvOK(kn))
keyattrib = SvPVX(kn);
SvREFCNT_dec(ka_rv); /* since we created it */
OUTPUT:
RETVAL
void
fetch(sth)
SV * sth
ALIAS:
fetchrow_arrayref = 1
CODE:
int num_fields;
if (CvDEPTH(cv) == 99) {
PERL_UNUSED_VAR(ix);
croak("Deep recursion. Probably fetch-fetchrow-fetch loop.");
}
PUSHMARK(sp);
XPUSHs(sth);
PUTBACK;
num_fields = call_method("fetchrow", G_LIST); /* XXX change the name later */
SPAGAIN;
if (num_fields == 0) {
ST(0) = &PL_sv_undef;
} else {
D_imp_sth(sth);
AV *av = dbih_get_fbav(imp_sth);
if (num_fields != AvFILL(av)+1)
croak("fetchrow returned %d fields, expected %d",
num_fields, (int)AvFILL(av)+1);
SPAGAIN;
while(--num_fields >= 0)
sv_setsv(AvARRAY(av)[num_fields], POPs);
PUTBACK;
ST(0) = sv_2mortal(newRV_inc((SV*)av));
}
void
rows(sth)
SV * sth
CODE:
D_imp_sth(sth);
const IV rows = DBIc_ROW_COUNT(imp_sth);
ST(0) = sv_2mortal(newSViv(rows));
(void)cv;
void
finish(sth)
SV * sth
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)) {
D_imp_dbh_from_sth;
if (!PL_dirty && DBIc_ACTIVE(imp_dbh)) {
dSP;
PUSHMARK(sp);
XPUSHs(sth);
PUTBACK;
call_method("finish", G_SCALAR);
SPAGAIN;
PUTBACK;
}
else {
DBIc_ACTIVE_off(imp_sth);
}
}
MODULE = DBI PACKAGE = DBI::st
void
TIEHASH(class, inner_ref)
SV * class
SV * inner_ref
CODE:
HV *stash = gv_stashsv(class, GV_ADDWARN); /* a new hash is supplied to us, we just need to bless and apply tie magic */
sv_bless(inner_ref, stash);
ST(0) = inner_ref;
MODULE = DBI PACKAGE = DBD::_::common
void
DESTROY(h)
SV * h
CODE:
/* DESTROY defined here just to avoid AUTOLOAD */
(void)cv;
(void)h;
ST(0) = &PL_sv_undef;
void
STORE(h, keysv, valuesv)
SV * h
SV * keysv
SV * valuesv
CODE:
ST(0) = &PL_sv_yes;
if (!dbih_set_attr_k(h, keysv, 0, valuesv))
ST(0) = &PL_sv_no;
(void)cv;
CODE:
/* only private_* keys can be deleted, for others DELETE acts like FETCH */
/* because the DBI internals rely on certain handle attributes existing */
if (strnEQ(SvPV_nolen(keysv),"private_",8))
ret = hv_delete_ent((HV*)SvRV(h), keysv, 0, 0);
else
ret = dbih_get_attr_k(h, keysv, 0);
ST(0) = ret;
(void)cv;
void
private_data(h)
SV * h
CODE:
D_imp_xxh(h);
(void)cv;
ST(0) = sv_mortalcopy(DBIc_IMP_DATA(imp_xxh));
void
err(h)
SV * h
CODE:
D_imp_xxh(h);
SV *errsv = DBIc_ERR(imp_xxh);
(void)cv;
ST(0) = sv_mortalcopy(errsv);
void
state(h)
SV * h
CODE:
D_imp_xxh(h);
SV *state = DBIc_STATE(imp_xxh);
(void)cv;
ST(0) = DBIc_STATE_adjust(imp_xxh, state);
void
errstr(h)
SV * h
CODE:
D_imp_xxh(h);
SV *errstr = DBIc_ERRSTR(imp_xxh);
SV *err;
/* If there's no errstr but there is an err then use err */
(void)cv;
if (!SvTRUE(errstr) && (err=DBIc_ERR(imp_xxh)) && SvTRUE(err))
errstr = err;
ST(0) = sv_mortalcopy(errstr);
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, */
/* don't set "dbi_set_err_method", return an empty list */
}
else {
/* store provided method name so handler code can find it */
sem_svp = hv_fetchs((HV*)SvRV(h), "dbi_set_err_method", 1);
if (SvOK(method)) {
sv_setpv(*sem_svp, SvPV_nolen(method));
}
else
(void)SvOK_off(*sem_svp);
XPUSHs( result ? result : &PL_sv_undef );
}
/* We don't check RaiseError and call die here because that must be */
/* done by returning through dispatch and letting the DBI handle it */
}
int
trace(h, level=&PL_sv_undef, file=Nullsv)
SV *h
SV *level
SV *file
ALIAS:
debug = 1
CODE:
RETVAL = set_trace(h, level, file);
(void)cv; /* Unused variables */
(void)ix;
OUTPUT:
RETVAL
void
trace_msg(sv, msg, this_trace=1)
SV *sv
const char *msg
int this_trace
PREINIT:
int current_trace;
PerlIO *pio;
CODE:
{
dMY_CXT;
(void)cv;
if (SvROK(sv)) {
D_imp_xxh(sv);
current_trace = DBIc_TRACE_LEVEL(imp_xxh);
pio = DBIc_LOGPIO(imp_xxh);
}
else { /* called as a static method */
( run in 0.567 second using v1.01-cache-2.11-cpan-71847e10f99 )