view release on metacpan or  search on metacpan

DB2.xs  view on Meta::CPAN

#endif

# ------------------------------------------------------------
# database level interface
# ------------------------------------------------------------
MODULE = DBD::DB2    PACKAGE = DBD::DB2::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) : "";
    ST(0) = dbd_db_login2(dbh, imp_dbh, dbname, u, p, attribs) ? &PL_sv_yes : &PL_sv_no;
    }


void
commit(dbh)
    SV *        dbh
    CODE:
    D_imp_dbh(dbh);
    if (DBIc_has(imp_dbh,DBIcf_AutoCommit))
        warn("commit ineffective with AutoCommit enabled");
    ST(0) = dbd_db_commit(dbh, imp_dbh) ? &PL_sv_yes : &PL_sv_no;

void
rollback(dbh)
    SV *        dbh
    CODE:
    D_imp_dbh(dbh);
    if (DBIc_has(imp_dbh,DBIcf_AutoCommit))
        warn("rollback ineffective with AutoCommit enabled");
    ST(0) = dbd_db_rollback(dbh, imp_dbh) ? &PL_sv_yes : &PL_sv_no;

void
disconnect(dbh)
    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)) {