DBD-DB2
view release on metacpan or search on metacpan
SV * dbh
SV **svp = hv_fetch((HV*)SvRV(dbh), "CachedKids", 10, 0);
CODE:
D_imp_dbh(dbh);
if ( !DBIc_ACTIVE(imp_dbh) ) {
XSRETURN_YES;
}
/* pre-disconnect checks and tidy-ups */
if (svp && SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVHV) {
hv_clear((HV*)SvRV(dbh));
}
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) && !PL_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) ? &PL_sv_yes : &PL_sv_no;
/* The connection will not be deactivated if there is an invalid */
/* transaction state, this is handled in dbd_db_disconnect */
/*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) = &PL_sv_yes;
if (!dbd_db_STORE_attrib(dbh, imp_dbh, keysv, valuesv))
if (!DBIS->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 = DBIS->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) = &PL_sv_yes;
if (!DBIc_IMPSET(imp_dbh)) { /* was never fully set up */
STRLEN lna;
if (DBIc_WARN(imp_dbh) && !PL_dirty && DBIS->debug >= 2)
PerlIO_printf(DBILOGFP,
" DESTROY for %s ignored - handle not initialised\n",
SvPV(dbh,lna));
}
else {
/* pre-disconnect checks and tidy-ups */
SV **svp = hv_fetch((HV*)SvRV(dbh), "CachedKids", 10, 0);
if (svp && SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVHV) {
hv_clear((HV*)SvRV(dbh));
}
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_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) && (!PL_dirty || DBIS->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);
}
void
_do( dbh, stmt )
SV * dbh
SV * stmt
CODE:
{
STRLEN lna;
char *pstmt = SvOK(stmt) ? SvPV(stmt,lna) : "";
ST(0) = sv_2mortal(
newSViv( (IV)dbd_db_do( dbh, pstmt ) ) );
}
void
_ping( dbh )
SV * dbh
CODE:
{
CODE:
D_imp_sth(sth);
int retval;
if (items > 1) {
/* Handle binding supplied values to placeholders */
int i;
SV *idx;
if (items-1 != DBIc_NUM_PARAMS(imp_sth)
#ifdef DBIc_NUM_PARAMS_AT_EXECUTE /* added sometime between DBI 0.93 and 1.08 */
&& DBIc_NUM_PARAMS(imp_sth) != DBIc_NUM_PARAMS_AT_EXECUTE
#endif
) {
char errmsg[99];
sprintf(errmsg,"execute called with %ld bind variables when %d are needed",
items-1, DBIc_NUM_PARAMS(imp_sth));
sv_setpv(DBIc_ERRSTR(imp_sth), errmsg);
sv_setiv(DBIc_ERR(imp_sth), (IV)-1);
XSRETURN_UNDEF;
}
idx = sv_2mortal(newSViv(0));
for(i=1; i < items ; ++i) {
SV* value = ST(i);
if (SvGMAGICAL(value))
mg_get(value); /* trigger magic to FETCH the value */
sv_setiv(idx, i);
if (!dbd_bind_ph(sth, imp_sth, idx, value, 0, Nullsv, FALSE, 0)) {
XSRETURN_UNDEF; /* dbd_bind_ph already registered error */
}
}
}
#ifdef DBIc_ROW_COUNT /* added sometime between DBI 0.93 and 1.08 */
if (DBIc_ROW_COUNT(imp_sth) > 0) /* reset for re-execute */
DBIc_ROW_COUNT(imp_sth) = 0;
#endif
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 */
void
fetchrow_arrayref(sth)
SV * sth
ALIAS:
fetch = 1
CODE:
D_imp_sth(sth);
AV *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 = dbd_st_fetch(sth, imp_sth);
if (av) {
int num_fields = AvFILL(av)+1;
int i;
EXTEND(sp, num_fields);
for(i=0; i < num_fields; ++i) {
PUSHs(AvARRAY(av)[i]);
}
}
void
cancel(sth)
SV * sth
CODE:
D_imp_sth(sth);
ST(0) = dbd_st_cancel(sth,imp_sth) ? &PL_sv_yes : &PL_sv_no;
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;
}
ST(0) = dbd_st_finish(sth, imp_sth) ? &PL_sv_yes : &PL_sv_no;
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 (!DBIS->set_attr(sth, keysv, valuesv))
ST(0) = &PL_sv_no;
void
FETCH(sth, keysv)
SV * sth
SV * keysv
CODE:
D_imp_sth(sth);
SV *valuesv = dbd_st_FETCH_attrib( sth, imp_sth, keysv );
if (!valuesv)
valuesv = DBIS->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) = &PL_sv_yes;
if (!DBIc_IMPSET(imp_sth)) { /* was never fully set up */
STRLEN lna;
if (DBIc_WARN(imp_sth) && !PL_dirty && DBIS->debug >= 2)
PerlIO_printf(DBILOGFP,
"Statement handle %s DESTROY ignored - never set up\n",
SvPV(sth,lna));
}
else {
if (DBIc_IADESTROY(imp_sth)) { /* want's ineffective destroy */
DBIc_ACTIVE_off(imp_sth);
}
if (DBIc_ACTIVE(imp_sth)) {
D_imp_dbh_from_sth;
if (DBIc_ACTIVE(imp_dbh)) {
dbd_st_finish(sth, imp_sth);
}
else {
DBIc_ACTIVE_off(imp_sth);
}
}
dbd_st_destroy(sth, imp_sth);
}
void
_table_info( sth, attribs=Nullsv )
SV * sth
SV * attribs
CODE:
{
D_imp_sth(sth);
DBD_ATTRIBS_CHECK( "_table_info", sth, attribs );
ST(0) = dbd_st_table_info( sth, imp_sth, attribs )
? &PL_sv_yes : &PL_sv_no;
}
void
_primary_key_info( sth, catalog=NULL, schema=NULL, table=NULL )
SV *sth
char *catalog
char *schema
char *table
CODE:
{
D_imp_sth(sth);
ST(0) = dbd_st_primary_key_info( sth,
imp_sth,
catalog,
schema,
table )
? &PL_sv_yes : &PL_sv_no;
}
void
_foreign_key_info( sth, pkCat=NULL, pkSchema=NULL, pkTable=NULL, fkCat=NULL, fkSchema=NULL, fkTable=NULL )
SV *sth
( run in 0.723 second using v1.01-cache-2.11-cpan-71847e10f99 )