[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / sun4-solaris / auto / DBI / Driver.xst

#  $Id: Driver.xst,v 10.19 2001/05/29 23:25:55 timbo Exp $
#  Copyright (c) 1994,1995,1996,1997,1998  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.


MODULE = DBD::~DRIVER~	PACKAGE = DBD::~DRIVER~

REQUIRE:    1.929
PROTOTYPES: DISABLE

BOOT:
    items = 0;  /* avoid 'unused variable' warning */
    DBISTATE_INIT;
    /* XXX this interface will change: */
    DBI_IMP_SIZE("DBD::~DRIVER~::dr::imp_data_size", sizeof(imp_drh_t));
    DBI_IMP_SIZE("DBD::~DRIVER~::db::imp_data_size", sizeof(imp_dbh_t));
    DBI_IMP_SIZE("DBD::~DRIVER~::st::imp_data_size", sizeof(imp_sth_t));
    dbd_init(DBIS);


# ------------------------------------------------------------
# driver level interface
# ------------------------------------------------------------
MODULE = DBD::~DRIVER~	PACKAGE = DBD::~DRIVER~::dr

# disconnect_all renamed and ALIAS'd to avoid length clash on VMS :-(
void
discon_all_(drh)
    SV *	drh
    ALIAS:
	disconnect_all = 1
    CODE:
    D_imp_drh(drh);
    if (0) ix = ix;	/* avoid unused variable warning */
    ST(0) = dbd_discon_all(drh, imp_drh) ? &sv_yes : &sv_no;


# ------------------------------------------------------------
# database level interface
# ------------------------------------------------------------
MODULE = DBD::~DRIVER~    PACKAGE = DBD::~DRIVER~::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) : "";
#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
    }


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));      /* 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 */


void
STORE(dbh, keysv, valuesv)
    SV *	dbh
    SV *	keysv
    SV *	valuesv
    CODE:
    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;

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	*/
	STRLEN lna;
	if (DBIc_WARN(imp_dbh) && !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 */
	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) && (!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);
    }


# -- end of DBD::~DRIVER~::db


# ------------------------------------------------------------
# statement interface
# ------------------------------------------------------------
MODULE = DBD::~DRIVER~    PACKAGE = DBD::~DRIVER~::st


void
_prepare(sth, statement, attribs=Nullsv)
    SV *	sth
    char *	statement
    SV *	attribs
    CODE:
    {
    D_imp_sth(sth);
    DBD_ATTRIBS_CHECK("_prepare", sth, attribs);
    ST(0) = dbd_st_prepare(sth, imp_sth, statement, attribs) ? &sv_yes : &sv_no;
    }


#ifdef dbd_st_rows

void
rows(sth)
    SV *	sth
    CODE:
    D_imp_sth(sth);
    XST_mIV(0, dbd_st_rows(sth, imp_sth));

#endif


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 (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;
    }


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);
    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;
    }


void
execute(sth, ...)
    SV *	sth
    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)
	    && DBIc_NUM_PARAMS(imp_sth) != DBIc_NUM_PARAMS_AT_EXECUTE
	) {
	    char errmsg[99];
	    sprintf(errmsg,"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	*/
	    }
	}
    }
    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	*/


void
fetchrow_arrayref(sth)
    SV *	sth
    ALIAS:
	fetch = 1
    CODE:
    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;


void
fetchrow_array(sth)
    SV *	sth
    ALIAS:
	fetchrow = 1
    PPCODE:
    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]);
	}
    }

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;
    }
#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


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) = &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) = &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 ALIAS'd 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;
    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	*/


void
DESTROY(sth)
    SV *	sth
    PPCODE:
    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)
	     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)) {
#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);
    }


# end of ~DRIVER~.xh
Commit	Line	Data
86530b38 AT	1	# $Id: Driver.xst,v 10.19 2001/05/29 23:25:55 timbo Exp $
	2	# Copyright (c) 1994,1995,1996,1997,1998 Tim Bunce
	3	#
	4	# You may distribute under the terms of either the GNU General Public
	5	# License or the Artistic License, as specified in the Perl README file.
	6
	7
	8	MODULE = DBD::~DRIVER~ PACKAGE = DBD::~DRIVER~
	9
	10	REQUIRE: 1.929
	11	PROTOTYPES: DISABLE
	12
	13	BOOT:
	14	items = 0; /* avoid 'unused variable' warning */
	15	DBISTATE_INIT;
	16	/* XXX this interface will change: */
	17	DBI_IMP_SIZE("DBD::~DRIVER~::dr::imp_data_size", sizeof(imp_drh_t));
	18	DBI_IMP_SIZE("DBD::~DRIVER~::db::imp_data_size", sizeof(imp_dbh_t));
	19	DBI_IMP_SIZE("DBD::~DRIVER~::st::imp_data_size", sizeof(imp_sth_t));
	20	dbd_init(DBIS);
	21
	22
	23
	24	# ------------------------------------------------------------
	25	# driver level interface
	26	# ------------------------------------------------------------
	27	MODULE = DBD::~DRIVER~ PACKAGE = DBD::~DRIVER~::dr
	28
	29	# disconnect_all renamed and ALIAS'd to avoid length clash on VMS :-(
	30	void
	31	discon_all_(drh)
	32	SV * drh
	33	ALIAS:
	34	disconnect_all = 1
	35	CODE:
	36	D_imp_drh(drh);
	37	if (0) ix = ix; /* avoid unused variable warning */
	38	ST(0) = dbd_discon_all(drh, imp_drh) ? &sv_yes : &sv_no;
	39
	40
	41
	42	# ------------------------------------------------------------
	43	# database level interface
	44	# ------------------------------------------------------------
	45	MODULE = DBD::~DRIVER~ PACKAGE = DBD::~DRIVER~::db
	46
	47	void
	48	_login(dbh, dbname, username, password, attribs=Nullsv)
	49	SV * dbh
	50	char * dbname
	51	SV * username
	52	SV * password
	53	SV * attribs
	54	CODE:
	55	{
	56	STRLEN lna;
	57	D_imp_dbh(dbh);
	58	char *u = (SvOK(username)) ? SvPV(username,lna) : "";
	59	char *p = (SvOK(password)) ? SvPV(password,lna) : "";
	60	#ifdef dbd_db_login6
	61	ST(0) = dbd_db_login6(dbh, imp_dbh, dbname, u, p, attribs) ? &sv_yes : &sv_no;
	62	#else
	63	ST(0) = dbd_db_login( dbh, imp_dbh, dbname, u, p) ? &sv_yes : &sv_no;
	64	#endif
65	}
66
67
68	void
69	commit(dbh)
70	SV * dbh
71	CODE:
72	D_imp_dbh(dbh);
73	if (DBIc_has(imp_dbh,DBIcf_AutoCommit))
74	warn("commit ineffective with AutoCommit enabled");
75	ST(0) = dbd_db_commit(dbh, imp_dbh) ? &sv_yes : &sv_no;
76
77	void
78	rollback(dbh)
79	SV * dbh
80	CODE:
81	D_imp_dbh(dbh);
82	if (DBIc_has(imp_dbh,DBIcf_AutoCommit))
83	warn("rollback ineffective with AutoCommit enabled");
84	ST(0) = dbd_db_rollback(dbh, imp_dbh) ? &sv_yes : &sv_no;
85
86	void
87	disconnect(dbh)
88	SV * dbh
89	CODE:
90	D_imp_dbh(dbh);
91	if ( !DBIc_ACTIVE(imp_dbh) ) {
92	XSRETURN_YES;
93	}
94	/* pre-disconnect checks and tidy-ups */
95	if (DBIc_CACHED_KIDS(imp_dbh)) {
96	SvREFCNT_dec(DBIc_CACHED_KIDS(imp_dbh)); /* cast them to the winds */
97	DBIc_CACHED_KIDS(imp_dbh) = Nullhv;
98	}
99	/* Check for disconnect() being called whilst refs to cursors */
100	/* still exists. This possibly needs some more thought. */
101	if (DBIc_ACTIVE_KIDS(imp_dbh) && DBIc_WARN(imp_dbh) && !dirty) {
102	STRLEN lna;
103	char *plural = (DBIc_ACTIVE_KIDS(imp_dbh)==1) ? "" : "s";
104	warn("%s->disconnect invalidates %d active statement handle%s %s",
105	SvPV(dbh,lna), (int)DBIc_ACTIVE_KIDS(imp_dbh), plural,
106	"(either destroy statement handles or call finish on them before disconnecting)");
107	}
108	ST(0) = dbd_db_disconnect(dbh, imp_dbh) ? &sv_yes : &sv_no;
109	DBIc_ACTIVE_off(imp_dbh); /* ensure it's off, regardless */
110
111
112	void
113	STORE(dbh, keysv, valuesv)
114	SV * dbh
115	SV * keysv
116	SV * valuesv
117	CODE:
118	D_imp_dbh(dbh);
119	if (SvGMAGICAL(valuesv))
120	mg_get(valuesv);
121	ST(0) = &sv_yes;
122	if (!dbd_db_STORE_attrib(dbh, imp_dbh, keysv, valuesv))
123	if (!DBIS->set_attr(dbh, keysv, valuesv))
124	ST(0) = &sv_no;
125
126	void
127	FETCH(dbh, keysv)
128	SV * dbh
129	SV * keysv
130	CODE:
131	D_imp_dbh(dbh);
132	SV *valuesv = dbd_db_FETCH_attrib(dbh, imp_dbh, keysv);
133	if (!valuesv)
134	valuesv = DBIS->get_attr(dbh, keysv);
135	ST(0) = valuesv; /* dbd_db_FETCH_attrib did sv_2mortal */
136
137
138	void
139	DESTROY(dbh)
140	SV * dbh
141	PPCODE:
142	D_imp_dbh(dbh);
143	ST(0) = &sv_yes;
144	if (!DBIc_IMPSET(imp_dbh)) { /* was never fully set up */
145	STRLEN lna;
146	if (DBIc_WARN(imp_dbh) && !dirty && DBIS->debug >= 2)
147	PerlIO_printf(DBILOGFP,
148	" DESTROY for %s ignored - handle not initialised\n",
149	SvPV(dbh,lna));
150	}
151	else {
152	/* pre-disconnect checks and tidy-ups */
153	if (DBIc_CACHED_KIDS(imp_dbh)) {
154	SvREFCNT_dec(DBIc_CACHED_KIDS(imp_dbh)); /* cast them to the winds */
155	DBIc_CACHED_KIDS(imp_dbh) = Nullhv;
156	}
157	if (DBIc_IADESTROY(imp_dbh)) { /* want's ineffective destroy */
158	DBIc_ACTIVE_off(imp_dbh);
159	}
160	if (DBIc_ACTIVE(imp_dbh)) {
161	/* The application has not explicitly disconnected. That's bad. */
162	/* To ensure integrity we must issue a rollback. This will be */
163	/* harmless if the application has issued a commit. If it hasn't */
164	/* then it'll ensure integrity. Consider a Ctrl-C killing perl */
165	/* between two statements that must be executed as a transaction. */
166	/* Perl will call DESTROY on the dbh and, if we don't rollback, */
167	/* the server may automatically commit! Bham! Corrupt database! */
168	if (!DBIc_has(imp_dbh,DBIcf_AutoCommit)) {
169	if (DBIc_WARN(imp_dbh) && (!dirty \|\| DBIS->debug >= 3))
170	warn("Issuing rollback() for database handle being DESTROY'd without explicit disconnect()");
171	dbd_db_rollback(dbh, imp_dbh); /* ROLLBACK! */
172	}
173	dbd_db_disconnect(dbh, imp_dbh);
174	DBIc_ACTIVE_off(imp_dbh); /* ensure it's off, regardless */
175	}
176	dbd_db_destroy(dbh, imp_dbh);
177	}
178
179
180	# -- end of DBD::~DRIVER~::db
181
182
183	# ------------------------------------------------------------
184	# statement interface
185	# ------------------------------------------------------------
186	MODULE = DBD::~DRIVER~ PACKAGE = DBD::~DRIVER~::st
187
188
189	void
190	_prepare(sth, statement, attribs=Nullsv)
191	SV * sth
192	char * statement
193	SV * attribs
194	CODE:
195	{
196	D_imp_sth(sth);
197	DBD_ATTRIBS_CHECK("_prepare", sth, attribs);
198	ST(0) = dbd_st_prepare(sth, imp_sth, statement, attribs) ? &sv_yes : &sv_no;
199	}
200
201
202	#ifdef dbd_st_rows
203
204	void
205	rows(sth)
206	SV * sth
207	CODE:
208	D_imp_sth(sth);
209	XST_mIV(0, dbd_st_rows(sth, imp_sth));
210
211	#endif
212
213
214	void
215	bind_param(sth, param, value, attribs=Nullsv)
216	SV * sth
217	SV * param
218	SV * value
219	SV * attribs
220	CODE:
221	{
222	IV sql_type = 0;
223	D_imp_sth(sth);
224	if (SvGMAGICAL(value))
225	mg_get(value);
226	if (attribs) {
227	if (SvNIOK(attribs)) {
228	sql_type = SvIV(attribs);
229	attribs = Nullsv;
230	}
231	else {
232	SV **svp;
233	DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
234	/* XXX we should perhaps complain if TYPE is not SvNIOK */
235	DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
236	}
237	}
238	ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, FALSE, 0)
239	? &sv_yes : &sv_no;
240	}
241
242
243	void
244	bind_param_inout(sth, param, value_ref, maxlen, attribs=Nullsv)
245	SV * sth
246	SV * param
247	SV * value_ref
248	IV maxlen
249	SV * attribs
250	CODE:
251	{
252	IV sql_type = 0;
253	D_imp_sth(sth);
254	SV *value;
255	if (!SvROK(value_ref) \|\| SvTYPE(SvRV(value_ref)) > SVt_PVMG)
256	croak("bind_param_inout needs a reference to a scalar value");
257	value = SvRV(value_ref);
258	if (SvREADONLY(value))
259	croak("Modification of a read-only value attempted");
260	if (SvGMAGICAL(value))
261	mg_get(value);
262	if (attribs) {
263	if (SvNIOK(attribs)) {
264	sql_type = SvIV(attribs);
265	attribs = Nullsv;
266	}
267	else {
268	SV **svp;
269	DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
270	DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
271	}
272	}
273	ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, TRUE, maxlen)
274	? &sv_yes : &sv_no;
275	}
276
277
278	void
279	execute(sth, ...)
280	SV * sth
281	CODE:
282	D_imp_sth(sth);
283	int retval;
284	if (items > 1) {
285	/* Handle binding supplied values to placeholders */
286	int i;
287	SV *idx;
288	if (items-1 != DBIc_NUM_PARAMS(imp_sth)
289	&& DBIc_NUM_PARAMS(imp_sth) != DBIc_NUM_PARAMS_AT_EXECUTE
290	) {
291	char errmsg[99];
292	sprintf(errmsg,"called with %ld bind variables when %d are needed",
293	items-1, DBIc_NUM_PARAMS(imp_sth));
294	sv_setpv(DBIc_ERRSTR(imp_sth), errmsg);
295	sv_setiv(DBIc_ERR(imp_sth), (IV)-1);
296	XSRETURN_UNDEF;
297	}
298	idx = sv_2mortal(newSViv(0));
299	for(i=1; i < items ; ++i) {
300	SV* value = ST(i);
301	if (SvGMAGICAL(value))
302	mg_get(value); /* trigger magic to FETCH the value */
303	sv_setiv(idx, i);
304	if (!dbd_bind_ph(sth, imp_sth, idx, value, 0, Nullsv, FALSE, 0)) {
305	XSRETURN_UNDEF; /* dbd_bind_ph already registered error */
306	}
307	}
308	}
309	if (DBIc_ROW_COUNT(imp_sth) > 0) /* reset for re-execute */
310	DBIc_ROW_COUNT(imp_sth) = 0;
311	retval = dbd_st_execute(sth, imp_sth);
312	/* remember that dbd_st_execute must return <= -2 for error */
313	if (retval == 0) /* ok with no rows affected */
314	XST_mPV(0, "0E0"); /* (true but zero) */
315	else if (retval < -1) /* -1 == unknown number of rows */
316	XST_mUNDEF(0); /* <= -2 means error */
317	else
318	XST_mIV(0, retval); /* typically 1, rowcount or -1 */
319
320
321	void
322	fetchrow_arrayref(sth)
323	SV * sth
324	ALIAS:
325	fetch = 1
326	CODE:
327	D_imp_sth(sth);
328	AV *av;
329	if (0) ix = ix; /* avoid unused variable warning */
330	av = dbd_st_fetch(sth, imp_sth);
331	ST(0) = (av) ? sv_2mortal(newRV((SV *)av)) : &sv_undef;
332
333
334	void
335	fetchrow_array(sth)
336	SV * sth
337	ALIAS:
338	fetchrow = 1
339	PPCODE:
340	D_imp_sth(sth);
341	AV *av;
342	if (0) ix = ix; /* avoid unused variable warning */
343	av = dbd_st_fetch(sth, imp_sth);
344	if (av) {
345	int num_fields = AvFILL(av)+1;
346	int i;
347	EXTEND(sp, num_fields);
348	for(i=0; i < num_fields; ++i) {
349	PUSHs(AvARRAY(av)[i]);
350	}
351	}
352
353	void
354	finish(sth)
355	SV * sth
356	CODE:
357	D_imp_sth(sth);
358	D_imp_dbh_from_sth;
359	if (!DBIc_ACTIVE(imp_sth)) {
360	/* No active statement to finish */
361	XSRETURN_YES;
362	}
363	if (!DBIc_ACTIVE(imp_dbh)) {
364	/* Either an explicit disconnect() or global destruction */
365	/* has disconnected us from the database. Finish is meaningless */
366	DBIc_ACTIVE_off(imp_sth);
367	XSRETURN_YES;
368	}
369	#ifdef dbd_db_finish3
370	ST(0) = dbd_st_finish3(sth, imp_sth, 0) ? &sv_yes : &sv_no;
371	#else
372	ST(0) = dbd_st_finish(sth, imp_sth) ? &sv_yes : &sv_no;
373	#endif
374
375
376	void
377	blob_read(sth, field, offset, len, destrv=Nullsv, destoffset=0)
378	SV * sth
379	int field
380	long offset
381	long len
382	SV * destrv
383	long destoffset
384	CODE:
385	{
386	D_imp_sth(sth);
387	if (!destrv)
388	destrv = sv_2mortal(newRV(sv_2mortal(newSV(0))));
389	if (dbd_st_blob_read(sth, imp_sth, field, offset, len, destrv, destoffset))
390	ST(0) = SvRV(destrv);
391	else ST(0) = &sv_undef;
392	}
393
394
395	void
396	STORE(sth, keysv, valuesv)
397	SV * sth
398	SV * keysv
399	SV * valuesv
400	CODE:
401	D_imp_sth(sth);
402	if (SvGMAGICAL(valuesv))
403	mg_get(valuesv);
404	ST(0) = &sv_yes;
405	if (!dbd_st_STORE_attrib(sth, imp_sth, keysv, valuesv))
406	if (!DBIS->set_attr(sth, keysv, valuesv))
407	ST(0) = &sv_no;
408
409
410	# FETCH renamed and ALIAS'd to avoid case clash on VMS :-(
411	void
412	FETCH_attrib(sth, keysv)
413	SV * sth
414	SV * keysv
415	ALIAS:
416	FETCH = 1
417	CODE:
418	D_imp_sth(sth);
419	SV *valuesv;
420	if (0) ix = ix; /* avoid unused variable warning */
421	valuesv = dbd_st_FETCH_attrib(sth, imp_sth, keysv);
422	if (!valuesv)
423	valuesv = DBIS->get_attr(sth, keysv);
424	ST(0) = valuesv; /* dbd_st_FETCH_attrib did sv_2mortal */
425
426
427	void
428	DESTROY(sth)
429	SV * sth
430	PPCODE:
431	D_imp_sth(sth);
432	ST(0) = &sv_yes;
433	if (!DBIc_IMPSET(imp_sth)) { /* was never fully set up */
434	STRLEN lna;
435	if (DBIc_WARN(imp_sth) && !dirty && DBIS->debug >= 2)
436	PerlIO_printf(DBILOGFP,
437	"Statement handle %s DESTROY ignored - never set up\n",
438	SvPV(sth,lna));
439	}
440	else {
441	if (DBIc_IADESTROY(imp_sth)) { /* want's ineffective destroy */
442	DBIc_ACTIVE_off(imp_sth);
443	}
444	if (DBIc_ACTIVE(imp_sth)) {
445	D_imp_dbh_from_sth;
446	if (DBIc_ACTIVE(imp_dbh)) {
447	#ifdef dbd_db_finish3
448	dbd_st_finish3(sth, imp_sth, 1);
449	#else
450	dbd_st_finish(sth, imp_sth);
451	#endif
452	}
453	else {
454	DBIc_ACTIVE_off(imp_sth);
455	}
456	}
457	dbd_st_destroy(sth, imp_sth);
458	}
459
460
461
462	# end of ~DRIVER~.xh