diff options
Diffstat (limited to 'install/5.005/DBD-Pg-1.22-fixvercmp/Pg.xs')
| -rw-r--r-- | install/5.005/DBD-Pg-1.22-fixvercmp/Pg.xs | 644 |
1 files changed, 644 insertions, 0 deletions
diff --git a/install/5.005/DBD-Pg-1.22-fixvercmp/Pg.xs b/install/5.005/DBD-Pg-1.22-fixvercmp/Pg.xs new file mode 100644 index 0000000..e5e4362 --- /dev/null +++ b/install/5.005/DBD-Pg-1.22-fixvercmp/Pg.xs @@ -0,0 +1,644 @@ +/* + $Id: Pg.xs,v 1.1 2004-04-29 09:21:28 ivan Exp $ + + Copyright (c) 1997,1998,1999,2000 Edmund Mergl + Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce + + You may distribute under the terms of either the GNU General Public + License or the Artistic License, as specified in the Perl README file. + +*/ + + +#include "Pg.h" + + +#ifdef _MSC_VER +#define strncasecmp(a,b,c) _strnicmp((a),(b),(c)) +#endif + + + +DBISTATE_DECLARE; + + +MODULE = DBD::Pg PACKAGE = DBD::Pg + +I32 +constant(name=Nullch) + char *name + PROTOTYPE: + ALIAS: + PG_BOOL = 16 + PG_BYTEA = 17 + PG_CHAR = 18 + PG_INT8 = 20 + PG_INT2 = 21 + PG_INT4 = 23 + PG_TEXT = 25 + PG_OID = 26 + PG_FLOAT4 = 700 + PG_FLOAT8 = 701 + PG_ABSTIME = 702 + PG_RELTIME = 703 + PG_TINTERVAL = 704 + PG_BPCHAR = 1042 + PG_VARCHAR = 1043 + PG_DATE = 1082 + PG_TIME = 1083 + PG_DATETIME = 1184 + PG_TIMESPAN = 1186 + PG_TIMESTAMP = 1296 + CODE: + if (!ix) { + if (!name) name = GvNAME(CvGV(cv)); + croak("Unknown DBD::Pg constant '%s'", name); + } + else RETVAL = ix; + OUTPUT: + RETVAL + +PROTOTYPES: DISABLE + +BOOT: + items = 0; /* avoid 'unused variable' warning */ + DBISTATE_INIT; + /* XXX this interface will change: */ + DBI_IMP_SIZE("DBD::Pg::dr::imp_data_size", sizeof(imp_drh_t)); + DBI_IMP_SIZE("DBD::Pg::db::imp_data_size", sizeof(imp_dbh_t)); + DBI_IMP_SIZE("DBD::Pg::st::imp_data_size", sizeof(imp_sth_t)); + dbd_init(DBIS); + + +# ------------------------------------------------------------ +# driver level interface +# ------------------------------------------------------------ +MODULE = DBD::Pg PACKAGE = DBD::Pg::dr + +# disconnect_all renamed and ALIASed to avoid length clash on VMS :-( +void +discon_all_(drh) + SV * drh + ALIAS: + disconnect_all = 1 + CODE: + D_imp_drh(drh); + ST(0) = dbd_discon_all(drh, imp_drh) ? &sv_yes : &sv_no; + + + +# ------------------------------------------------------------ +# database level interface +# ------------------------------------------------------------ +MODULE = DBD::Pg PACKAGE = DBD::Pg::db + +void +_login(dbh, dbname, username, pwd) + SV * dbh + char * dbname + char * username + char * pwd + CODE: + D_imp_dbh(dbh); + ST(0) = pg_db_login(dbh, imp_dbh, dbname, username, pwd) ? &sv_yes : &sv_no; + + +int +_ping(dbh) + SV * dbh + CODE: + int ret; + ret = dbd_db_ping(dbh); + if (ret == 0) { + XST_mUNDEF(0); + } + else { + XST_mIV(0, ret); + } + +void +getfd(dbh) + SV * dbh + CODE: + int ret; + D_imp_dbh(dbh); + + ret = dbd_db_getfd(dbh, imp_dbh); + ST(0) = sv_2mortal( newSViv( ret ) ); + +void +pg_notifies(dbh) + SV * dbh + CODE: + D_imp_dbh(dbh); + + ST(0) = dbd_db_pg_notifies(dbh, imp_dbh); + +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) ? &sv_yes : &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) ? &sv_yes : &sv_no; + + +void +disconnect(dbh) + SV * dbh + CODE: + 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)); + 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) { + char *plural = (DBIc_ACTIVE_KIDS(imp_dbh)==1) ? "" : "s"; + warn("disconnect(%s) invalidates %d active statement%s. %s", + SvPV(dbh,na), (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; + + +void +STORE(dbh, keysv, valuesv) + SV * dbh + SV * keysv + SV * valuesv + CODE: + D_imp_dbh(dbh); + 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; + } + } + + +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) = &sv_yes; + if (!DBIc_IMPSET(imp_dbh)) { /* was never fully set up */ + if (DBIc_WARN(imp_dbh) && !dirty && dbis->debug >= 2) { + warn("Database handle %s DESTROY ignored - never set up", SvPV(dbh,na)); + } + } + else { + /* pre-disconnect checks and tidy-ups */ + if (DBIc_CACHED_KIDS(imp_dbh)) { + SvREFCNT_dec(DBIc_CACHED_KIDS(imp_dbh)); + 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)) { + if (DBIc_WARN(imp_dbh) && (!dirty || dbis->debug >= 3)) { + warn("Database handle destroyed without explicit disconnect"); + } + /* 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)) { + dbd_db_rollback(dbh, imp_dbh); /* ROLLBACK! */ + } + dbd_db_disconnect(dbh, imp_dbh); + } + dbd_db_destroy(dbh, imp_dbh); + } + + +# driver specific functions + + +void +lo_open(dbh, lobjId, mode) + SV * dbh + unsigned int lobjId + int mode + CODE: + int ret = pg_db_lo_open(dbh, lobjId, mode); + ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef; + +void +lo_close(dbh, fd) + SV * dbh + int fd + CODE: + ST(0) = (-1 != pg_db_lo_close(dbh, fd)) ? &sv_yes : &sv_no; + + +void +lo_read(dbh, fd, buf, len) + SV * dbh + int fd + char * buf + int len + PREINIT: + SV *bufsv = SvROK(ST(2)) ? SvRV(ST(2)) : ST(2); + int ret; + CODE: + buf = SvGROW(bufsv, len + 1); + ret = pg_db_lo_read(dbh, fd, buf, len); + if (ret > 0) { + SvCUR_set(bufsv, ret); + *SvEND(bufsv) = '\0'; + sv_setpvn(ST(2), buf, ret); + SvSETMAGIC(ST(2)); + } + ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef; + + +void +lo_write(dbh, fd, buf, len) + SV * dbh + int fd + char * buf + int len + CODE: + int ret = pg_db_lo_write(dbh, fd, buf, len); + ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef; + + +void +lo_lseek(dbh, fd, offset, whence) + SV * dbh + int fd + int offset + int whence + CODE: + int ret = pg_db_lo_lseek(dbh, fd, offset, whence); + ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef; + + +void +lo_creat(dbh, mode) + SV * dbh + int mode + CODE: + int ret = pg_db_lo_creat(dbh, mode); + ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef; + + +void +lo_tell(dbh, fd) + SV * dbh + int fd + CODE: + int ret = pg_db_lo_tell(dbh, fd); + ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef; + + +void +lo_unlink(dbh, lobjId) + SV * dbh + unsigned int lobjId + CODE: + ST(0) = (-1 != pg_db_lo_unlink(dbh, lobjId)) ? &sv_yes : &sv_no; + + +void +lo_import(dbh, filename) + SV * dbh + char * filename + CODE: + unsigned int ret = pg_db_lo_import(dbh, filename); + ST(0) = (ret) ? sv_2mortal(newSViv(ret)) : &sv_undef; + + +void +lo_export(dbh, lobjId, filename) + SV * dbh + unsigned int lobjId + char * filename + CODE: + ST(0) = (-1 != pg_db_lo_export(dbh, lobjId, filename)) ? &sv_yes : &sv_no; + + +void +putline(dbh, buf) + SV * dbh + char * buf + CODE: + int ret = pg_db_putline(dbh, buf); + ST(0) = (-1 != ret) ? &sv_yes : &sv_no; + + +void +getline(dbh, buf, len) + PREINIT: + SV *bufsv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1); + INPUT: + SV * dbh + int len + char * buf = sv_grow(bufsv, len); + CODE: + int ret = pg_db_getline(dbh, buf, len); + if (*buf == '\\' && *(buf+1) == '.') { + ret = -1; + } + sv_setpv((SV*)ST(1), buf); + SvSETMAGIC(ST(1)); + ST(0) = (-1 != ret) ? &sv_yes : &sv_no; + + +void +endcopy(dbh) + SV * dbh + CODE: + ST(0) = (-1 != pg_db_endcopy(dbh)) ? &sv_yes : &sv_no; + + +# -- end of DBD::Pg::db + + +# ------------------------------------------------------------ +# statement interface +# ------------------------------------------------------------ +MODULE = DBD::Pg PACKAGE = DBD::Pg::st + +void +_prepare(sth, statement, attribs=Nullsv) + SV * sth + char * statement + SV * attribs + CODE: + { + D_imp_sth(sth); + D_imp_dbh_from_sth; + DBD_ATTRIBS_CHECK("_prepare", sth, attribs); + if (!strncasecmp(statement, "begin", 5) || + !strncasecmp(statement, "end", 4) || + !strncasecmp(statement, "commit", 6) || + !strncasecmp(statement, "abort", 5) || + !strncasecmp(statement, "rollback", 8) ) { + warn("please use DBI functions for transaction handling"); + ST(0) = &sv_no; + } else { + ST(0) = dbd_st_prepare(sth, imp_sth, statement, attribs) ? &sv_yes : &sv_no; + } + } + + +void +rows(sth) + SV * sth + CODE: + D_imp_sth(sth); + XST_mIV(0, dbd_st_rows(sth, imp_sth)); + + +void +bind_param(sth, param, value, attribs=Nullsv) + SV * sth + SV * param + SV * value + SV * attribs + CODE: + { + IV sql_type = 0; + D_imp_sth(sth); + 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; + } + + +void +bind_param_inout(sth, param, value_ref, maxlen, attribs=Nullsv) + SV * sth + SV * param + SV * value_ref + IV maxlen + SV * attribs + CODE: + { + IV sql_type = 0; + D_imp_sth(sth); + if (!SvROK(value_ref) || SvTYPE(SvRV(value_ref)) > SVt_PVMG) { + croak("bind_param_inout needs a reference to a scalar value"); + } + if (SvREADONLY(SvRV(value_ref))) { + croak(no_modify); + } + 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, SvRV(value_ref), sql_type, attribs, TRUE, maxlen) ? &sv_yes : &sv_no; + } + + +void +execute(sth, ...) + SV * sth + CODE: + D_imp_sth(sth); + int ret; + if (items > 1) { + /* Handle binding supplied values to placeholders */ + int i; + SV *idx; + imp_sth->all_params_len = 0; /* used for malloc of statement string in case we have placeholders */ + if (items-1 != DBIc_NUM_PARAMS(imp_sth)) { + croak("execute called with %ld bind variables, %d needed", items-1, DBIc_NUM_PARAMS(imp_sth)); + XSRETURN_UNDEF; + } + idx = sv_2mortal(newSViv(0)); + for(i=1; i < items ; ++i) { + sv_setiv(idx, i); + if (!dbd_bind_ph(sth, imp_sth, idx, ST(i), 0, Nullsv, FALSE, 0)) { + XSRETURN_UNDEF; /* dbd_bind_ph already registered error */ + } + } + } + ret = dbd_st_execute(sth, imp_sth); + /* remember that dbd_st_execute must return <= -2 for error */ + if (ret == 0) { /* ok with no rows affected */ + XST_mPV(0, "0E0"); /* (true but zero) */ + } + else if (ret < -1) { /* -1 == unknown number of rows */ + XST_mUNDEF(0); /* <= -2 means error */ + } + else { + XST_mIV(0, ret); /* 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_inc((SV *)av)) : &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 num_fields = AvFILL(av)+1; + int i; + EXTEND(sp, num_fields); + for(i=0; i < num_fields; ++i) { + PUSHs(AvARRAY(av)[i]); + } + } + + +void +finish(sth) + SV * sth + CODE: + D_imp_sth(sth); + D_imp_dbh_from_sth; + if (!DBIc_ACTIVE(imp_dbh)) { + /* Either an explicit disconnect() or global destruction */ + /* has disconnected us from the database. Finish is meaningless */ + /* XXX warn */ + XSRETURN_YES; + } + if (!DBIc_ACTIVE(imp_sth)) { + /* No active statement to finish */ + XSRETURN_YES; + } + ST(0) = dbd_st_finish(sth, imp_sth) ? &sv_yes : &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_inc(sv_2mortal(newSViv(0)))); + } + ST(0) = dbd_st_blob_read(sth, imp_sth, field, offset, len, destrv, destoffset) ? SvRV(destrv) : &sv_undef; + } + +void +STORE(sth, keysv, valuesv) + SV * sth + SV * keysv + SV * valuesv + CODE: + D_imp_sth(sth); + 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; + } + } + + +# FETCH renamed and ALIASed to avoid case clash on VMS :-( +void +FETCH_attrib(sth, keysv) + SV * sth + SV * keysv + ALIAS: + FETCH = 1 + 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) = &sv_yes; + if (!DBIc_IMPSET(imp_sth)) { /* was never fully set up */ + if (DBIc_WARN(imp_sth) && !dirty && dbis->debug >= 2) { + warn("Statement handle %s DESTROY ignored - never set up", SvPV(sth,na)); + } + } + else { + if (DBIc_IADESTROY(imp_sth)) { /* want's ineffective destroy */ + DBIc_ACTIVE_off(imp_sth); + } + if (DBIc_ACTIVE(imp_sth)) { + dbd_st_finish(sth, imp_sth); + } + dbd_st_destroy(sth, imp_sth); + } + + +# end of Pg.xs |