/* * This file was generated automatically by xsubpp version 1.9507 from the * contents of Perl.xs. Do not edit this file, edit Perl.xs instead. * * ANY CHANGES MADE HERE WILL BE LOST! * */ #line 1 "Perl.xs" #include "DBIXS.h" #include "dbd_xsh.h" struct imp_drh_st { dbih_drc_t com; /* MUST be first element in structure */ }; struct imp_dbh_st { dbih_dbc_t com; /* MUST be first element in structure */ }; struct imp_sth_st { dbih_stc_t com; /* MUST be first element in structure */ }; DBISTATE_DECLARE; #line 27 "Perl.c" /* INCLUDE: Including 'Perl.xsi' from 'Perl.xs' */ XS(XS_DBD__Perl__dr_discon_all_) { dXSARGS; dXSI32; if (items != 1) croak("Usage: %s(drh)", GvNAME(CvGV(cv))); { SV * drh = ST(0); #line 36 "Perl.xsi" D_imp_drh(drh); if (0) ix = ix; /* avoid unused variable warning */ ST(0) = dbd_discon_all(drh, imp_drh) ? &sv_yes : &sv_no; #line 43 "Perl.c" } XSRETURN(1); } XS(XS_DBD__Perl__db__login) { dXSARGS; if (items < 4 || items > 5) croak("Usage: DBD::Perl::db::_login(dbh, dbname, username, password, attribs=Nullsv)"); { SV * dbh = ST(0); char * dbname = (char *)SvPV(ST(1),PL_na); SV * username = ST(2); SV * password = ST(3); SV * attribs; if (items < 5) attribs = Nullsv; else { attribs = ST(4); } #line 55 "Perl.xsi" { STRLEN lna; D_imp_dbh(dbh); char *u = (SvOK(username)) ? SvPV(username,lna) : ""; char *p = (SvOK(password)) ? SvPV(password,lna) : ""; #ifdef dbd_db_login6 ST(0) = dbd_db_login6(dbh, imp_dbh, dbname, u, p, attribs) ? &sv_yes : &sv_no; #else ST(0) = dbd_db_login( dbh, imp_dbh, dbname, u, p) ? &sv_yes : &sv_no; #endif } #line 77 "Perl.c" } XSRETURN(1); } XS(XS_DBD__Perl__db_commit) { dXSARGS; if (items != 1) croak("Usage: DBD::Perl::db::commit(dbh)"); { SV * dbh = ST(0); #line 72 "Perl.xsi" 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) ? &sv_yes : &sv_no; #line 94 "Perl.c" } XSRETURN(1); } XS(XS_DBD__Perl__db_rollback) { dXSARGS; if (items != 1) croak("Usage: DBD::Perl::db::rollback(dbh)"); { SV * dbh = ST(0); #line 81 "Perl.xsi" 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) ? &sv_yes : &sv_no; #line 111 "Perl.c" } XSRETURN(1); } XS(XS_DBD__Perl__db_disconnect) { dXSARGS; if (items != 1) croak("Usage: DBD::Perl::db::disconnect(dbh)"); { SV * dbh = ST(0); #line 90 "Perl.xsi" D_imp_dbh(dbh); if ( !DBIc_ACTIVE(imp_dbh) ) { XSRETURN_YES; } /* pre-disconnect checks and tidy-ups */ 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) && !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) ? &sv_yes : &sv_no; DBIc_ACTIVE_off(imp_dbh); /* ensure it's off, regardless */ #line 144 "Perl.c" } XSRETURN(1); } XS(XS_DBD__Perl__db_STORE) { dXSARGS; if (items != 3) croak("Usage: DBD::Perl::db::STORE(dbh, keysv, valuesv)"); { SV * dbh = ST(0); SV * keysv = ST(1); SV * valuesv = ST(2); #line 118 "Perl.xsi" D_imp_dbh(dbh); if (SvGMAGICAL(valuesv)) mg_get(valuesv); ST(0) = &sv_yes; if (!dbd_db_STORE_attrib(dbh, imp_dbh, keysv, valuesv)) if (!DBIS->set_attr(dbh, keysv, valuesv)) ST(0) = &sv_no; #line 166 "Perl.c" } XSRETURN(1); } XS(XS_DBD__Perl__db_FETCH) { dXSARGS; if (items != 2) croak("Usage: DBD::Perl::db::FETCH(dbh, keysv)"); { SV * dbh = ST(0); SV * keysv = ST(1); #line 131 "Perl.xsi" 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 */ #line 185 "Perl.c" } XSRETURN(1); } XS(XS_DBD__Perl__db_DESTROY) { dXSARGS; if (items != 1) croak("Usage: DBD::Perl::db::DESTROY(dbh)"); SP -= items; { SV * dbh = ST(0); #line 142 "Perl.xsi" D_imp_dbh(dbh); ST(0) = &sv_yes; if (!DBIc_IMPSET(imp_dbh)) { /* was never fully set up */ STRLEN lna; if (DBIc_WARN(imp_dbh) && !dirty && DBIS->debug >= 2) fprintf(DBILOGFP, " DESTROY for %s ignored - handle not initialised\n", SvPV(dbh,lna)); } else { /* pre-disconnect checks and tidy-ups */ 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 will automatically commit! Bham! Corrupt database! */ if (!DBIc_has(imp_dbh,DBIcf_AutoCommit)) { if (DBIc_WARN(imp_dbh) && (!dirty || DBIS->debug >= 3)) warn("Database handle destroyed without explicit disconnect"); if (DBIS->debug >= 2) fprintf(DBILOGFP, " IMPLICIT ROLLBACK ON DESTROY%s!\n", " of database handle that is still connected"); 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); } #line 238 "Perl.c" PUTBACK; return; } } XS(XS_DBD__Perl__st__prepare) { dXSARGS; if (items < 2 || items > 3) croak("Usage: DBD::Perl::st::_prepare(sth, statement, attribs=Nullsv)"); { SV * sth = ST(0); char * statement = (char *)SvPV(ST(1),PL_na); SV * attribs; if (items < 3) attribs = Nullsv; else { attribs = ST(2); } #line 198 "Perl.xsi" { D_imp_sth(sth); DBD_ATTRIBS_CHECK("_prepare", sth, attribs); ST(0) = dbd_st_prepare(sth, imp_sth, statement, attribs) ? &sv_yes : &sv_no; } #line 265 "Perl.c" } XSRETURN(1); } #ifdef dbd_st_rows #define XSubPPtmpAAAA 1 XS(XS_DBD__Perl__st_rows) { dXSARGS; if (items != 1) croak("Usage: DBD::Perl::st::rows(sth)"); { SV * sth = ST(0); #line 211 "Perl.xsi" D_imp_sth(sth); XST_mIV(0, dbd_st_rows(sth, imp_sth)); #line 283 "Perl.c" } XSRETURN(1); } #endif XS(XS_DBD__Perl__st_bind_param) { dXSARGS; if (items < 3 || items > 4) croak("Usage: DBD::Perl::st::bind_param(sth, param, value, attribs=Nullsv)"); { SV * sth = ST(0); SV * param = ST(1); SV * value = ST(2); SV * attribs; if (items < 4) attribs = Nullsv; else { attribs = ST(3); } #line 224 "Perl.xsi" { 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); } } ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, FALSE, 0) ? &sv_yes : &sv_no; } #line 326 "Perl.c" } XSRETURN(1); } XS(XS_DBD__Perl__st_bind_param_inout) { dXSARGS; if (items < 4 || items > 5) croak("Usage: DBD::Perl::st::bind_param_inout(sth, param, value_ref, maxlen, attribs=Nullsv)"); { SV * sth = ST(0); SV * param = ST(1); SV * value_ref = ST(2); IV maxlen = (IV)SvIV(ST(3)); SV * attribs; if (items < 5) attribs = Nullsv; else { attribs = ST(4); } #line 254 "Perl.xsi" { 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); } } ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, TRUE, maxlen) ? &sv_yes : &sv_no; } #line 374 "Perl.c" } XSRETURN(1); } XS(XS_DBD__Perl__st_execute) { dXSARGS; if (items < 1) croak("Usage: DBD::Perl::st::execute(sth, ...)"); { SV * sth = ST(0); #line 285 "Perl.xsi" 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) && DBIc_NUM_PARAMS(imp_sth) != DBIc_NUM_PARAMS_AT_EXECUTE ) { croak("execute called with %ld bind variables when %d are needed", items-1, DBIc_NUM_PARAMS(imp_sth)); 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 */ } } } if (DBIc_ROW_COUNT(imp_sth) > 0) /* reset for re-execute */ DBIc_ROW_COUNT(imp_sth) = 0; 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 */ #line 421 "Perl.c" } XSRETURN(1); } XS(XS_DBD__Perl__st_fetchrow_arrayref) { dXSARGS; dXSI32; if (items != 1) croak("Usage: %s(sth)", GvNAME(CvGV(cv))); { SV * sth = ST(0); #line 327 "Perl.xsi" D_imp_sth(sth); AV *av; if (0) ix = ix; /* avoid unused variable warning */ av = dbd_st_fetch(sth, imp_sth); ST(0) = (av) ? sv_2mortal(newRV((SV *)av)) : &sv_undef; #line 440 "Perl.c" } XSRETURN(1); } XS(XS_DBD__Perl__st_fetchrow_array) { dXSARGS; dXSI32; if (items != 1) croak("Usage: %s(sth)", GvNAME(CvGV(cv))); SP -= items; { SV * sth = ST(0); #line 340 "Perl.xsi" D_imp_sth(sth); AV *av; if (0) ix = ix; /* avoid unused variable warning */ 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]); } } #line 467 "Perl.c" PUTBACK; return; } } XS(XS_DBD__Perl__st_finish) { dXSARGS; if (items != 1) croak("Usage: DBD::Perl::st::finish(sth)"); { SV * sth = ST(0); #line 357 "Perl.xsi" 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_db_finish3 ST(0) = dbd_st_finish3(sth, imp_sth, 0) ? &sv_yes : &sv_no; #else ST(0) = dbd_st_finish(sth, imp_sth) ? &sv_yes : &sv_no; #endif #line 498 "Perl.c" } XSRETURN(1); } XS(XS_DBD__Perl__st_blob_read) { dXSARGS; if (items < 4 || items > 6) croak("Usage: DBD::Perl::st::blob_read(sth, field, offset, len, destrv=Nullsv, destoffset=0)"); { SV * sth = ST(0); int field = (int)SvIV(ST(1)); long offset = (long)SvIV(ST(2)); long len = (long)SvIV(ST(3)); SV * destrv; long destoffset; if (items < 5) destrv = Nullsv; else { destrv = ST(4); } if (items < 6) destoffset = 0; else { destoffset = (long)SvIV(ST(5)); } #line 385 "Perl.xsi" { 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) = &sv_undef; } #line 536 "Perl.c" } XSRETURN(1); } XS(XS_DBD__Perl__st_STORE) { dXSARGS; if (items != 3) croak("Usage: DBD::Perl::st::STORE(sth, keysv, valuesv)"); { SV * sth = ST(0); SV * keysv = ST(1); SV * valuesv = ST(2); #line 401 "Perl.xsi" D_imp_sth(sth); if (SvGMAGICAL(valuesv)) mg_get(valuesv); ST(0) = &sv_yes; if (!dbd_st_STORE_attrib(sth, imp_sth, keysv, valuesv)) if (!DBIS->set_attr(sth, keysv, valuesv)) ST(0) = &sv_no; #line 558 "Perl.c" } XSRETURN(1); } XS(XS_DBD__Perl__st_FETCH_attrib) { dXSARGS; dXSI32; if (items != 2) croak("Usage: %s(sth, keysv)", GvNAME(CvGV(cv))); { SV * sth = ST(0); SV * keysv = ST(1); #line 418 "Perl.xsi" D_imp_sth(sth); SV *valuesv; if (0) ix = ix; /* avoid unused variable warning */ 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 */ #line 580 "Perl.c" } XSRETURN(1); } XS(XS_DBD__Perl__st_DESTROY) { dXSARGS; if (items != 1) croak("Usage: DBD::Perl::st::DESTROY(sth)"); SP -= items; { SV * sth = ST(0); #line 431 "Perl.xsi" D_imp_sth(sth); ST(0) = &sv_yes; if (!DBIc_IMPSET(imp_sth)) { /* was never fully set up */ STRLEN lna; if (DBIc_WARN(imp_sth) && !dirty && DBIS->debug >= 2) fprintf(DBILOGFP, "Statement handle %s DESTROY ignored - never set up", 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)) { #ifdef dbd_db_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); } #line 622 "Perl.c" PUTBACK; return; } } /* INCLUDE: Returning to 'Perl.xs' from 'Perl.xsi' */ #ifdef __cplusplus extern "C" #endif XS(boot_DBD__Perl) { dXSARGS; char* file = __FILE__; XS_VERSION_BOOTCHECK ; { CV * cv ; cv = newXS("DBD::Perl::dr::disconnect_all", XS_DBD__Perl__dr_discon_all_, file); XSANY.any_i32 = 1 ; cv = newXS("DBD::Perl::dr::discon_all_", XS_DBD__Perl__dr_discon_all_, file); XSANY.any_i32 = 0 ; newXS("DBD::Perl::db::_login", XS_DBD__Perl__db__login, file); newXS("DBD::Perl::db::commit", XS_DBD__Perl__db_commit, file); newXS("DBD::Perl::db::rollback", XS_DBD__Perl__db_rollback, file); newXS("DBD::Perl::db::disconnect", XS_DBD__Perl__db_disconnect, file); newXS("DBD::Perl::db::STORE", XS_DBD__Perl__db_STORE, file); newXS("DBD::Perl::db::FETCH", XS_DBD__Perl__db_FETCH, file); newXS("DBD::Perl::db::DESTROY", XS_DBD__Perl__db_DESTROY, file); newXS("DBD::Perl::st::_prepare", XS_DBD__Perl__st__prepare, file); #if XSubPPtmpAAAA newXS("DBD::Perl::st::rows", XS_DBD__Perl__st_rows, file); #endif newXS("DBD::Perl::st::bind_param", XS_DBD__Perl__st_bind_param, file); newXS("DBD::Perl::st::bind_param_inout", XS_DBD__Perl__st_bind_param_inout, file); newXS("DBD::Perl::st::execute", XS_DBD__Perl__st_execute, file); cv = newXS("DBD::Perl::st::fetch", XS_DBD__Perl__st_fetchrow_arrayref, file); XSANY.any_i32 = 1 ; cv = newXS("DBD::Perl::st::fetchrow_arrayref", XS_DBD__Perl__st_fetchrow_arrayref, file); XSANY.any_i32 = 0 ; cv = newXS("DBD::Perl::st::fetchrow_array", XS_DBD__Perl__st_fetchrow_array, file); XSANY.any_i32 = 0 ; cv = newXS("DBD::Perl::st::fetchrow", XS_DBD__Perl__st_fetchrow_array, file); XSANY.any_i32 = 1 ; newXS("DBD::Perl::st::finish", XS_DBD__Perl__st_finish, file); newXS("DBD::Perl::st::blob_read", XS_DBD__Perl__st_blob_read, file); newXS("DBD::Perl::st::STORE", XS_DBD__Perl__st_STORE, file); cv = newXS("DBD::Perl::st::FETCH", XS_DBD__Perl__st_FETCH_attrib, file); XSANY.any_i32 = 1 ; cv = newXS("DBD::Perl::st::FETCH_attrib", XS_DBD__Perl__st_FETCH_attrib, file); XSANY.any_i32 = 0 ; newXS("DBD::Perl::st::DESTROY", XS_DBD__Perl__st_DESTROY, file); } /* Initialisation Section */ #line 14 "Perl.xsi" items = 0; /* avoid 'unused variable' warning */ DBISTATE_INIT; /* XXX this interface will change: */ DBI_IMP_SIZE("DBD::Perl::dr::imp_data_size", sizeof(imp_drh_t)); DBI_IMP_SIZE("DBD::Perl::db::imp_data_size", sizeof(imp_dbh_t)); DBI_IMP_SIZE("DBD::Perl::st::imp_data_size", sizeof(imp_sth_t)); dbd_init(DBIS); #if XSubPPtmpAAAA #endif #line 693 "Perl.c" /* End of Initialisation Section */ XSRETURN_YES; }

Simpan