File Coverage

Oracle.xsi

Criterion	Covered	Total	%
statement	13	196	6.6
branch			n/a
condition			n/a
subroutine			n/a
pod			n/a
total	13	196	6.6

line	stmt	code
1		# $Id: Driver.xst 9153 2007-02-22 02:36:14Z timbo $
2		# Copyright (c) 1997-2002 Tim Bunce Ireland
3		# Copyright (c) 2002 Jonathan Leffler
4		#
5		# You may distribute under the terms of either the GNU General Public
6		# License or the Artistic License, as specified in the Perl README file.
7
8
9		#include "Driver_xst.h"
10
11
12		MODULE = DBD::Oracle PACKAGE = DBD::Oracle
13
14		REQUIRE: 1.929
15		PROTOTYPES: DISABLE
16
17		BOOT:
18		items = 0; /* avoid 'unused variable' warning */
19	20	DBISTATE_INIT;
20		/* XXX this interface will change: */
21	20	DBI_IMP_SIZE("DBD::Oracle::dr::imp_data_size", sizeof(imp_drh_t));
22	20	DBI_IMP_SIZE("DBD::Oracle::db::imp_data_size", sizeof(imp_dbh_t));
23	20	DBI_IMP_SIZE("DBD::Oracle::st::imp_data_size", sizeof(imp_sth_t));
24	20	dbd_init(DBIS);
25
26
27		# ------------------------------------------------------------
28		# driver level interface
29		# ------------------------------------------------------------
30		MODULE = DBD::Oracle PACKAGE = DBD::Oracle::dr
31
32
33		#ifdef dbd_discon_all
34
35		# disconnect_all renamed and ALIAS'd to avoid length clash on VMS :-(
36		void
37		discon_all_(drh)
38		SV * drh
39		ALIAS:
40		disconnect_all = 1
41		CODE:
42		D_imp_drh(drh);
43		if (0) ix = ix; /* avoid unused variable warning */
44		ST(0) = dbd_discon_all(drh, imp_drh) ? &sv_yes : &sv_no;
45
46		#endif /* dbd_discon_all */
47
48
49		#ifdef dbd_dr_data_sources
50
51		void
52		data_sources(drh, attr = Nullsv)
53		SV *drh
54		SV *attr
55		PPCODE:
56		{
57		D_imp_drh(drh);
58		AV *av = dbd_dr_data_sources(drh, imp_drh, attr);
59		if (av) {
60		int i;
61		int n = AvFILL(av)+1;
62		EXTEND(sp, n);
63		for (i = 0; i < n; ++i) {
64		PUSHs(AvARRAY(av)[i]);
65		}
66		}
67		}
68
69		#endif
70
71
72		# ------------------------------------------------------------
73		# database level interface
74		# ------------------------------------------------------------
75		MODULE = DBD::Oracle PACKAGE = DBD::Oracle::db
76
77
78		void
79		_login(dbh, dbname, username, password, attribs=Nullsv)
80		SV * dbh
81		char * dbname
82		SV * username
83		SV * password
84		SV * attribs
85		CODE:
86		{
87		STRLEN lna;
88	18	D_imp_dbh(dbh);
89	18	char *u = (SvOK(username)) ? SvPV(username,lna) : "";
90	18	char *p = (SvOK(password)) ? SvPV(password,lna) : "";
91		#ifdef dbd_db_login6
92	18	ST(0) = dbd_db_login6(dbh, imp_dbh, dbname, u, p, attribs) ? &sv_yes : &sv_no;
93		#else
94		ST(0) = dbd_db_login( dbh, imp_dbh, dbname, u, p) ? &sv_yes : &sv_no;
95		#endif
96		}
97
98
99		void
100		selectall_arrayref(...)
101		PREINIT:
102		SV *sth;
103		SV **maxrows_svp;
104		SV **tmp_svp;
105		SV *attr = &PL_sv_undef;
106		imp_sth_t *imp_sth;
107		CODE:
108	0	if (items > 2) {
109	0	attr = ST(2);
110	0	if (SvROK(attr) &&
111	0	(DBD_ATTRIB_TRUE(attr,"Slice",5,tmp_svp) \|\| DBD_ATTRIB_TRUE(attr,"Columns",7,tmp_svp))
112		) {
113		/* fallback to perl implementation */
114	0	ST(0) = dbixst_bounce_method("DBD::Oracle::db::SUPER::selectall_arrayref", items);
115	0	XSRETURN(1);
116		}
117		}
118		/* --- prepare --- */
119	0	if (SvROK(ST(1))) {
120		sth = ST(1);
121		}
122		else {
123	0	sth = dbixst_bounce_method("prepare", 3);
124	0	if (!SvROK(sth))
125	0	XSRETURN_UNDEF;
126		}
127	0	imp_sth = (imp_sth_t*)(DBIh_COM(sth));
128		/* --- bind_param --- */
129	0	if (items > 3) { /* need to bind params before execute */
130	0	if (!dbdxst_bind_params(sth, imp_sth, items-2, ax+2) ) {
131	0	XSRETURN_UNDEF;
132		}
133		}
134		/* --- execute --- */
135	0	DBIc_ROW_COUNT(imp_sth) = 0;
136	0	if ( dbd_st_execute(sth, imp_sth) <= -2 ) { /* -2 == error */
137	0	XSRETURN_UNDEF;
138		}
139		/* --- fetchall --- */
140	0	maxrows_svp = DBD_ATTRIB_GET_SVP(attr, "MaxRows", 7);
141	0	ST(0) = dbdxst_fetchall_arrayref(sth, &PL_sv_undef, (maxrows_svp) ? *maxrows_svp : &PL_sv_undef);
142
143
144		void
145		selectrow_arrayref(...)
146		ALIAS:
147		selectrow_array = 1
148		PREINIT:
149	0	int is_selectrow_array = (ix == 1);
150		imp_sth_t *imp_sth;
151		SV *sth;
152		AV *row_av;
153		PPCODE:
154	0	if (SvROK(ST(1))) {
155		sth = ST(1);
156		}
157		else {
158		/* --- prepare --- */
159	0	sth = dbixst_bounce_method("prepare", 3);
160	0	if (!SvROK(sth)) {
161	0	if (is_selectrow_array) { XSRETURN_EMPTY; } else { XSRETURN_UNDEF; }
162		}
163		}
164	0	imp_sth = (imp_sth_t*)(DBIh_COM(sth));
165		/* --- bind_param --- */
166	0	if (items > 3) { /* need to bind params before execute */
167	0	if (!dbdxst_bind_params(sth, imp_sth, items-2, ax+2) ) {
168	0	if (is_selectrow_array) { XSRETURN_EMPTY; } else { XSRETURN_UNDEF; }
169		}
170		}
171		/* --- execute --- */
172	0	DBIc_ROW_COUNT(imp_sth) = 0;
173	0	if ( dbd_st_execute(sth, imp_sth) <= -2 ) { /* -2 == error */
174	0	if (is_selectrow_array) { XSRETURN_EMPTY; } else { XSRETURN_UNDEF; }
175		}
176		/* --- fetchrow_arrayref --- */
177	0	row_av = dbd_st_fetch(sth, imp_sth);
178	0	if (!row_av) {
179	0	if (GIMME == G_SCALAR)
180	0	PUSHs(&PL_sv_undef);
181		}
182	0	else if (is_selectrow_array) {
183		int i;
184	0	int num_fields = AvFILL(row_av)+1;
185	0	if (GIMME == G_SCALAR)
186		num_fields = 1; /* return just first field */
187	0	EXTEND(sp, num_fields);
188	0	for(i=0; i < num_fields; ++i) {
189	0	PUSHs(AvARRAY(row_av)[i]);
190		}
191		}
192		else {
193	0	PUSHs( sv_2mortal(newRV((SV *)row_av)) );
194		}
195		/* --- finish --- */
196		#ifdef dbd_st_finish3
197		dbd_st_finish3(sth, imp_sth, 0);
198		#else
199	0	dbd_st_finish(sth, imp_sth);
200		#endif
201
202
203		#ifdef dbd_db_do4 /* deebeedee-deebee-doo, deebee-doobee-dah? */
204
205		void
206		do(dbh, statement, params = Nullsv)
207		SV * dbh
208		char * statement
209		SV * params
210		CODE:
211		{
212		D_imp_dbh(dbh);
213		IV retval;
214		retval = dbd_db_do4(dbh, imp_dbh, statement, params);
215		/* remember that dbd_db_do4 must return <= -2 for error */
216		if (retval == 0) /* ok with no rows affected */
217		XST_mPV(0, "0E0"); /* (true but zero) */
218		else if (retval < -1) /* -1 == unknown number of rows */
219		XST_mUNDEF(0); /* <= -2 means error */
220		else
221		XST_mIV(0, retval); /* typically 1, rowcount or -1 */
222		}
223
224		#endif
225
226
227		#ifdef dbd_db_last_insert_id
228
229		void
230		last_insert_id(dbh, catalog, schema, table, field, attr=Nullsv)
231		SV * dbh
232		SV * catalog
233		SV * schema
234		SV * table
235		SV * field
236		SV * attr
237		CODE:
238		{
239		D_imp_dbh(dbh);
240		ST(0) = dbd_db_last_insert_id(dbh, imp_dbh, catalog, schema, table, field, attr);
241		}
242
243		#endif
244
245
246		void
247		commit(dbh)
248		SV * dbh
249		CODE:
250	0	D_imp_dbh(dbh);
251	0	if (DBIc_has(imp_dbh,DBIcf_AutoCommit) && DBIc_WARN(imp_dbh))
252	0	warn("commit ineffective with AutoCommit enabled");
253	0	ST(0) = dbd_db_commit(dbh, imp_dbh) ? &sv_yes : &sv_no;
254
255
256		void
257		rollback(dbh)
258		SV * dbh
259		CODE:
260	0	D_imp_dbh(dbh);
261	0	if (DBIc_has(imp_dbh,DBIcf_AutoCommit) && DBIc_WARN(imp_dbh))
262	0	warn("rollback ineffective with AutoCommit enabled");
263	0	ST(0) = dbd_db_rollback(dbh, imp_dbh) ? &sv_yes : &sv_no;
264
265
266		void
267		disconnect(dbh)
268		SV * dbh
269		CODE:
270	0	D_imp_dbh(dbh);
271	0	if ( !DBIc_ACTIVE(imp_dbh) ) {
272	0	XSRETURN_YES;
273		}
274		/* pre-disconnect checks and tidy-ups */
275	0	if (DBIc_CACHED_KIDS(imp_dbh)) {
276	0	SvREFCNT_dec(DBIc_CACHED_KIDS(imp_dbh)); /* cast them to the winds */
277	0	DBIc_CACHED_KIDS(imp_dbh) = Nullhv;
278		}
279		/* Check for disconnect() being called whilst refs to cursors */
280		/* still exists. This possibly needs some more thought. */
281	0	if (DBIc_ACTIVE_KIDS(imp_dbh) && DBIc_WARN(imp_dbh) && !dirty) {
282		STRLEN lna;
283	0	char *plural = (DBIc_ACTIVE_KIDS(imp_dbh)==1) ? "" : "s";
284	0	warn("%s->disconnect invalidates %d active statement handle%s %s",
285		SvPV(dbh,lna), (int)DBIc_ACTIVE_KIDS(imp_dbh), plural,
286		"(either destroy statement handles or call finish on them before disconnecting)");
287		}
288	0	ST(0) = dbd_db_disconnect(dbh, imp_dbh) ? &sv_yes : &sv_no;
289	0	DBIc_ACTIVE_off(imp_dbh); /* ensure it's off, regardless */
290
291
292		void
293		STORE(dbh, keysv, valuesv)
294		SV * dbh
295		SV * keysv
296		SV * valuesv
297		CODE:
298	0	D_imp_dbh(dbh);
299	0	if (SvGMAGICAL(valuesv))
300	0	mg_get(valuesv);
301	0	ST(0) = &sv_yes;
302	0	if (!dbd_db_STORE_attrib(dbh, imp_dbh, keysv, valuesv))
303	0	if (!DBIc_DBISTATE(imp_dbh)->set_attr(dbh, keysv, valuesv))
304	0	ST(0) = &sv_no;
305
306
307		void
308		FETCH(dbh, keysv)
309		SV * dbh
310		SV * keysv
311		CODE:
312	0	D_imp_dbh(dbh);
313	0	SV *valuesv = dbd_db_FETCH_attrib(dbh, imp_dbh, keysv);
314	0	if (!valuesv)
315	0	valuesv = DBIc_DBISTATE(imp_dbh)->get_attr(dbh, keysv);
316	0	ST(0) = valuesv; /* dbd_db_FETCH_attrib did sv_2mortal */
317
318
319		void
320		DESTROY(dbh)
321		SV * dbh
322		PPCODE:
323		/* keep in sync with default DESTROY in DBI.xs */
324	18	D_imp_dbh(dbh);
325	18	ST(0) = &sv_yes;
326	18	if (!DBIc_IMPSET(imp_dbh)) { /* was never fully set up */
327		STRLEN lna;
328	18	if (DBIc_WARN(imp_dbh) && !dirty && DBIc_DBISTATE(imp_dbh)->debug >= 2)
329	0	PerlIO_printf(DBIc_LOGPIO(imp_dbh),
330		" DESTROY for %s ignored - handle not initialised\n",
331		SvPV(dbh,lna));
332		}
333		else {
334		/* pre-disconnect checks and tidy-ups */
335	0	if (DBIc_CACHED_KIDS(imp_dbh)) {
336	0	SvREFCNT_dec(DBIc_CACHED_KIDS(imp_dbh)); /* cast them to the winds */
337	0	DBIc_CACHED_KIDS(imp_dbh) = Nullhv;
338		}
339	0	if (DBIc_IADESTROY(imp_dbh)) { /* want's ineffective destroy */
340	0	DBIc_ACTIVE_off(imp_dbh);
341	0	if (DBIc_DBISTATE(imp_dbh)->debug)
342	0	PerlIO_printf(DBIc_LOGPIO(imp_dbh), " DESTROY %s skipped due to InactiveDestroy\n", SvPV_nolen(dbh));
343		}
344	0	if (DBIc_ACTIVE(imp_dbh)) {
345	0	if (!DBIc_has(imp_dbh,DBIcf_AutoCommit)) {
346		/* Application is using transactions and hasn't explicitly disconnected.
347		Some databases will automatically commit on graceful disconnect.
348		Since we're about to gracefully disconnect as part of the DESTROY
349		we want to be sure we're not about to implicitly commit changes
350		that are incomplete and should be rolled back. (The DESTROY may
351		be due to a RaiseError, for example.) So we rollback here.
352		This will be harmless if the application has issued a commit,
353		XXX Could add an attribute flag to indicate that the driver
354		doesn't have this problem. Patches welcome.
355		XXX or could just move the DBIc_is(imp_dbh, DBIcf_Executed) test
356		to cover the rollback as well. That just needs sanity checking
357		that DBIcf_Executed is set by any/all possible way to execute a
358		statement that might start a transaction.
359		*/
360	0	if (DBIc_WARN(imp_dbh)
361		&& DBIc_is(imp_dbh, DBIcf_Executed) /* has not just called commit/rollback */
362		&& (!dirty \|\| DBIc_DBISTATE(imp_dbh)->debug >= 3)
363		)
364	0	warn("Issuing rollback() for database handle being DESTROY'd without explicit disconnect()");
365	0	dbd_db_rollback(dbh, imp_dbh); /* ROLLBACK! */
366		}
367	0	dbd_db_disconnect(dbh, imp_dbh);
368	0	DBIc_ACTIVE_off(imp_dbh); /* ensure it's off, regardless */
369		}
370	0	dbd_db_destroy(dbh, imp_dbh);
371		}
372
373
374		#ifdef dbd_take_imp_data
375
376		void
377		take_imp_data(h)
378		SV * h
379		CODE:
380		D_imp_xxh(h);
381		/* dbd_take_imp_data() returns &sv_no (or other defined but false value)
382		* to indicate "preparations complete, now call SUPER::take_imp_data" for me.
383		* Anything else is returned to the caller via sv_2mortal(sv), typically that
384		* would be &sv_undef for error or an SV holding the imp_data.
385		*/
386		SV *sv = dbd_take_imp_data(h, imp_xxh, NULL);
387		ST(0) = (SvOK(sv) && !SvTRUE(sv))
388		? dbixst_bounce_method("DBD::Oracle::db::SUPER::take_imp_data", items)
389		: sv_2mortal(sv);
390
391		#endif
392
393		#ifdef dbd_db_data_sources
394
395		void
396		data_sources(dbh, attr = Nullsv)
397		SV *dbh
398		SV *attr
399		PPCODE:
400		{
401		D_imp_dbh(dbh);
402		AV *av = dbd_db_data_sources(dbh, imp_dbh, attr);
403		if (av) {
404		int i;
405		int n = AvFILL(av)+1;
406		EXTEND(sp, n);
407		for (i = 0; i < n; ++i) {
408		PUSHs(AvARRAY(av)[i]);
409		}
410		}
411		}
412
413		#endif
414
415		# -- end of DBD::Oracle::db
416
417		# ------------------------------------------------------------
418		# statement interface
419		# ------------------------------------------------------------
420		MODULE = DBD::Oracle PACKAGE = DBD::Oracle::st
421
422
423		void
424		_prepare(sth, statement, attribs=Nullsv)
425		SV * sth
426		SV * statement
427		SV * attribs
428		CODE:
429		{
430	0	D_imp_sth(sth);
431	0	DBD_ATTRIBS_CHECK("_prepare", sth, attribs);
432		#ifdef dbd_st_prepare_sv
433		ST(0) = dbd_st_prepare_sv(sth, imp_sth, statement, attribs) ? &sv_yes : &sv_no;
434		#else
435	0	ST(0) = dbd_st_prepare(sth, imp_sth, SvPV_nolen(statement), attribs) ? &sv_yes : &sv_no;
436		#endif
437		}
438
439
440		#ifdef dbd_st_rows
441
442		void
443		rows(sth)
444		SV * sth
445		CODE:
446	0	D_imp_sth(sth);
447	0	XST_mIV(0, dbd_st_rows(sth, imp_sth));
448
449		#endif /* dbd_st_rows */
450
451
452		#ifdef dbd_st_bind_col
453
454		void
455		bind_col(sth, col, ref, attribs=Nullsv)
456		SV * sth
457		SV * col
458		SV * ref
459		SV * attribs
460		CODE:
461		{
462		IV sql_type = 0;
463		D_imp_sth(sth);
464		if (SvGMAGICAL(ref))
465		mg_get(ref);
466		if (attribs) {
467		if (SvNIOK(attribs)) {
468		sql_type = SvIV(attribs);
469		attribs = Nullsv;
470		}
471		else {
472		SV **svp;
473		DBD_ATTRIBS_CHECK("bind_col", sth, attribs);
474		/* XXX we should perhaps complain if TYPE is not SvNIOK */
475		DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
476		}
477		}
478		switch(dbd_st_bind_col(sth, imp_sth, col, ref, sql_type, attribs)) {
479		case 2: ST(0) = &sv_yes; /* job done completely */
480		break;
481		case 1: /* fallback to DBI default */
482		ST(0) = (DBIc_DBISTATE(imp_sth)->bind_col(sth, col, ref, attribs))
483		? &sv_yes : &sv_no;
484		break;
485		default: ST(0) = &sv_no; /* dbd_st_bind_col has called set_err */
486		break;
487		}
488		}
489
490		#endif /* dbd_st_bind_col */
491
492		void
493		bind_param(sth, param, value, attribs=Nullsv)
494		SV * sth
495		SV * param
496		SV * value
497		SV * attribs
498		CODE:
499		{
500		IV sql_type = 0;
501	0	D_imp_sth(sth);
502	0	if (SvGMAGICAL(value))
503	0	mg_get(value);
504	0	if (attribs) {
505	0	if (SvNIOK(attribs)) {
506	0	sql_type = SvIV(attribs);
507		attribs = Nullsv;
508		}
509		else {
510		SV **svp;
511	0	DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
512		/* XXX we should perhaps complain if TYPE is not SvNIOK */
513	0	DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
514		}
515		}
516	0	ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, FALSE, 0)
517		? &sv_yes : &sv_no;
518		}
519
520
521		void
522		bind_param_inout(sth, param, value_ref, maxlen, attribs=Nullsv)
523		SV * sth
524		SV * param
525		SV * value_ref
526		IV maxlen
527		SV * attribs
528		CODE:
529		{
530		IV sql_type = 0;
531	0	D_imp_sth(sth);
532		SV *value;
533	0	if (!SvROK(value_ref) \|\| SvTYPE(SvRV(value_ref)) > SVt_PVMG)
534	0	croak("bind_param_inout needs a reference to a scalar value");
535		value = SvRV(value_ref);
536	0	if (SvREADONLY(value))
537	0	croak("Modification of a read-only value attempted");
538	0	if (SvGMAGICAL(value))
539	0	mg_get(value);
540	0	if (attribs) {
541	0	if (SvNIOK(attribs)) {
542	0	sql_type = SvIV(attribs);
543		attribs = Nullsv;
544		}
545		else {
546		SV **svp;
547	0	DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
548	0	DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
549		}
550		}
551	0	ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, TRUE, maxlen)
552		? &sv_yes : &sv_no;
553		}
554
555
556		void
557		execute(sth, ...)
558		SV * sth
559		CODE:
560	0	D_imp_sth(sth);
561		int retval;
562	0	if (items > 1) { /* need to bind params */
563	0	if (!dbdxst_bind_params(sth, imp_sth, items, ax) ) {
564	0	XSRETURN_UNDEF;
565		}
566		}
567		/* XXX this code is duplicated in selectrow_arrayref above */
568	0	if (DBIc_ROW_COUNT(imp_sth) > 0) /* reset for re-execute */
569	0	DBIc_ROW_COUNT(imp_sth) = 0;
570	0	retval = dbd_st_execute(sth, imp_sth);
571		/* remember that dbd_st_execute must return <= -2 for error */
572	0	if (retval == 0) /* ok with no rows affected */
573	0	XST_mPV(0, "0E0"); /* (true but zero) */
574	0	else if (retval < -1) /* -1 == unknown number of rows */
575	0	XST_mUNDEF(0); /* <= -2 means error */
576		else
577	0	XST_mIV(0, retval); /* typically 1, rowcount or -1 */
578
579
580		#ifdef dbd_st_execute_for_fetch
581
582		void
583		execute_for_fetch(sth, fetch_tuple_sub, tuple_status = Nullsv)
584		SV * sth
585		SV * fetch_tuple_sub
586		SV * tuple_status
587		CODE:
588		{
589		D_imp_sth(sth);
590		ST(0) = dbd_st_execute_for_fetch(sth, imp_sth, fetch_tuple_sub, tuple_status);
591		}
592
593		#endif
594
595
596
597		void
598		fetchrow_arrayref(sth)
599		SV * sth
600		ALIAS:
601		fetch = 1
602		CODE:
603	0	D_imp_sth(sth);
604		AV *av;
605		if (0) ix = ix; /* avoid unused variable warning */
606	0	av = dbd_st_fetch(sth, imp_sth);
607	0	ST(0) = (av) ? sv_2mortal(newRV((SV *)av)) : &PL_sv_undef;
608
609
610		void
611		fetchrow_array(sth)
612		SV * sth
613		ALIAS:
614		fetchrow = 1
615		PPCODE:
616	0	D_imp_sth(sth);
617		AV *av;
618	0	av = dbd_st_fetch(sth, imp_sth);
619	0	if (av) {
620		int i;
621	0	int num_fields = AvFILL(av)+1;
622	0	EXTEND(sp, num_fields);
623	0	for(i=0; i < num_fields; ++i) {
624	0	PUSHs(AvARRAY(av)[i]);
625		}
626		if (0) ix = ix; /* avoid unused variable warning */
627		}
628
629
630		void
631		fetchall_arrayref(sth, slice=&PL_sv_undef, batch_row_count=&PL_sv_undef)
632		SV * sth
633		SV * slice
634		SV * batch_row_count
635		CODE:
636	0	if (SvOK(slice)) { /* fallback to perl implementation */
637	0	ST(0) = dbixst_bounce_method("DBD::Oracle::st::SUPER::fetchall_arrayref", 3);
638		}
639		else {
640	0	ST(0) = dbdxst_fetchall_arrayref(sth, slice, batch_row_count);
641		}
642
643
644		void
645		finish(sth)
646		SV * sth
647		CODE:
648	0	D_imp_sth(sth);
649	0	D_imp_dbh_from_sth;
650	0	if (!DBIc_ACTIVE(imp_sth)) {
651		/* No active statement to finish */
652	0	XSRETURN_YES;
653		}
654	0	if (!DBIc_ACTIVE(imp_dbh)) {
655		/* Either an explicit disconnect() or global destruction */
656		/* has disconnected us from the database. Finish is meaningless */
657	0	DBIc_ACTIVE_off(imp_sth);
658	0	XSRETURN_YES;
659		}
660		#ifdef dbd_st_finish3
661		ST(0) = dbd_st_finish3(sth, imp_sth, 0) ? &sv_yes : &sv_no;
662		#else
663	0	ST(0) = dbd_st_finish(sth, imp_sth) ? &sv_yes : &sv_no;
664		#endif
665
666
667		void
668		blob_read(sth, field, offset, len, destrv=Nullsv, destoffset=0)
669		SV * sth
670		int field
671		long offset
672		long len
673		SV * destrv
674		long destoffset
675		CODE:
676		{
677	0	D_imp_sth(sth);
678	0	if (!destrv)
679	0	destrv = sv_2mortal(newRV(sv_2mortal(newSV(0))));
680	0	if (dbd_st_blob_read(sth, imp_sth, field, offset, len, destrv, destoffset))
681	0	ST(0) = SvRV(destrv);
682	0	else ST(0) = &PL_sv_undef;
683		}
684
685
686		void
687		STORE(sth, keysv, valuesv)
688		SV * sth
689		SV * keysv
690		SV * valuesv
691		CODE:
692	0	D_imp_sth(sth);
693	0	if (SvGMAGICAL(valuesv))
694	0	mg_get(valuesv);
695	0	ST(0) = &sv_yes;
696	0	if (!dbd_st_STORE_attrib(sth, imp_sth, keysv, valuesv))
697	0	if (!DBIc_DBISTATE(imp_sth)->set_attr(sth, keysv, valuesv))
698	0	ST(0) = &sv_no;
699
700
701		# FETCH renamed and ALIAS'd to avoid case clash on VMS :-(
702		void
703		FETCH_attrib(sth, keysv)
704		SV * sth
705		SV * keysv
706		ALIAS:
707		FETCH = 1
708		CODE:
709	0	D_imp_sth(sth);
710		SV *valuesv;
711		if (0) ix = ix; /* avoid unused variable warning */
712	0	valuesv = dbd_st_FETCH_attrib(sth, imp_sth, keysv);
713	0	if (!valuesv)
714	0	valuesv = DBIc_DBISTATE(imp_sth)->get_attr(sth, keysv);
715	0	ST(0) = valuesv; /* dbd_st_FETCH_attrib did sv_2mortal */
716
717
718		void
719		DESTROY(sth)
720		SV * sth
721		PPCODE:
722		/* keep in sync with default DESTROY in DBI.xs */
723	0	D_imp_sth(sth);
724	0	ST(0) = &sv_yes;
725	0	if (!DBIc_IMPSET(imp_sth)) { /* was never fully set up */
726		STRLEN lna;
727	0	if (DBIc_WARN(imp_sth) && !dirty && DBIc_DBISTATE(imp_sth)->debug >= 2)
728	0	PerlIO_printf(DBIc_LOGPIO(imp_sth),
729		" DESTROY for %s ignored - handle not initialised\n",
730		SvPV(sth,lna));
731		}
732		else {
733	0	if (DBIc_IADESTROY(imp_sth)) { /* want's ineffective destroy */
734	0	DBIc_ACTIVE_off(imp_sth);
735	0	if (DBIc_DBISTATE(imp_sth)->debug)
736	0	PerlIO_printf(DBIc_LOGPIO(imp_sth), " DESTROY %s skipped due to InactiveDestroy\n", SvPV_nolen(sth));
737		}
738	0	if (DBIc_ACTIVE(imp_sth)) {
739	0	D_imp_dbh_from_sth;
740	0	if (!dirty && DBIc_ACTIVE(imp_dbh)) {
741		#ifdef dbd_st_finish3
742		dbd_st_finish3(sth, imp_sth, 1);
743		#else
744	0	dbd_st_finish(sth, imp_sth);
745		#endif
746		}
747		else {
748	0	DBIc_ACTIVE_off(imp_sth);
749		}
750		}
751	0	dbd_st_destroy(sth, imp_sth);
752		}
753
754		# end of Oracle.xst
755