path: root/install/5.005/DBD-Pg-1.22-fixvercmp/Pg.xs

/*
   $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