2 $Id: Pg.xs,v 1.1.2.1 2004-04-29 09:40:07 ivan Exp $
4 Copyright (c) 1997,1998,1999,2000 Edmund Mergl
5 Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce
7 You may distribute under the terms of either the GNU General Public
8 License or the Artistic License, as specified in the Perl README file.
17 #define strncasecmp(a,b,c) _strnicmp((a),(b),(c))
25 MODULE = DBD::Pg PACKAGE = DBD::Pg
54 if (!name) name = GvNAME(CvGV(cv));
55 croak("Unknown DBD::Pg constant '%s'", name);
64 items = 0; /* avoid 'unused variable' warning */
66 /* XXX this interface will change: */
67 DBI_IMP_SIZE("DBD::Pg::dr::imp_data_size", sizeof(imp_drh_t));
68 DBI_IMP_SIZE("DBD::Pg::db::imp_data_size", sizeof(imp_dbh_t));
69 DBI_IMP_SIZE("DBD::Pg::st::imp_data_size", sizeof(imp_sth_t));
73 # ------------------------------------------------------------
74 # driver level interface
75 # ------------------------------------------------------------
76 MODULE = DBD::Pg PACKAGE = DBD::Pg::dr
78 # disconnect_all renamed and ALIASed to avoid length clash on VMS :-(
86 ST(0) = dbd_discon_all(drh, imp_drh) ? &sv_yes : &sv_no;
90 # ------------------------------------------------------------
91 # database level interface
92 # ------------------------------------------------------------
93 MODULE = DBD::Pg PACKAGE = DBD::Pg::db
96 _login(dbh, dbname, username, pwd)
103 ST(0) = pg_db_login(dbh, imp_dbh, dbname, username, pwd) ? &sv_yes : &sv_no;
111 ret = dbd_db_ping(dbh);
126 ret = dbd_db_getfd(dbh, imp_dbh);
127 ST(0) = sv_2mortal( newSViv( ret ) );
135 ST(0) = dbd_db_pg_notifies(dbh, imp_dbh);
142 if (DBIc_has(imp_dbh, DBIcf_AutoCommit)) {
143 warn("commit ineffective with AutoCommit enabled");
145 ST(0) = dbd_db_commit(dbh, imp_dbh) ? &sv_yes : &sv_no;
153 if (DBIc_has(imp_dbh, DBIcf_AutoCommit)) {
154 warn("rollback ineffective with AutoCommit enabled");
156 ST(0) = dbd_db_rollback(dbh, imp_dbh) ? &sv_yes : &sv_no;
164 if ( !DBIc_ACTIVE(imp_dbh) ) {
167 /* pre-disconnect checks and tidy-ups */
168 if (DBIc_CACHED_KIDS(imp_dbh)) {
169 SvREFCNT_dec(DBIc_CACHED_KIDS(imp_dbh));
170 DBIc_CACHED_KIDS(imp_dbh) = Nullhv;
172 /* Check for disconnect() being called whilst refs to cursors */
173 /* still exists. This possibly needs some more thought. */
174 if (DBIc_ACTIVE_KIDS(imp_dbh) && DBIc_WARN(imp_dbh) && !dirty) {
175 char *plural = (DBIc_ACTIVE_KIDS(imp_dbh)==1) ? "" : "s";
176 warn("disconnect(%s) invalidates %d active statement%s. %s",
177 SvPV(dbh,na), (int)DBIc_ACTIVE_KIDS(imp_dbh), plural,
178 "Either destroy statement handles or call finish on them before disconnecting.");
180 ST(0) = dbd_db_disconnect(dbh, imp_dbh) ? &sv_yes : &sv_no;
184 STORE(dbh, keysv, valuesv)
191 if (!dbd_db_STORE_attrib(dbh, imp_dbh, keysv, valuesv)) {
192 if (!DBIS->set_attr(dbh, keysv, valuesv)) {
204 SV *valuesv = dbd_db_FETCH_attrib(dbh, imp_dbh, keysv);
206 valuesv = DBIS->get_attr(dbh, keysv);
208 ST(0) = valuesv; /* dbd_db_FETCH_attrib did sv_2mortal */
217 if (!DBIc_IMPSET(imp_dbh)) { /* was never fully set up */
218 if (DBIc_WARN(imp_dbh) && !dirty && dbis->debug >= 2) {
219 warn("Database handle %s DESTROY ignored - never set up", SvPV(dbh,na));
223 /* pre-disconnect checks and tidy-ups */
224 if (DBIc_CACHED_KIDS(imp_dbh)) {
225 SvREFCNT_dec(DBIc_CACHED_KIDS(imp_dbh));
226 DBIc_CACHED_KIDS(imp_dbh) = Nullhv;
228 if (DBIc_IADESTROY(imp_dbh)) { /* want's ineffective destroy */
229 DBIc_ACTIVE_off(imp_dbh);
231 if (DBIc_ACTIVE(imp_dbh)) {
232 if (DBIc_WARN(imp_dbh) && (!dirty || dbis->debug >= 3)) {
233 warn("Database handle destroyed without explicit disconnect");
235 /* The application has not explicitly disconnected. That's bad. */
236 /* To ensure integrity we *must* issue a rollback. This will be */
237 /* harmless if the application has issued a commit. If it hasn't */
238 /* then it'll ensure integrity. Consider a Ctrl-C killing perl */
239 /* between two statements that must be executed as a transaction. */
240 /* Perl will call DESTROY on the dbh and, if we don't rollback, */
241 /* the server will automatically commit! Bham! Corrupt database! */
242 if (!DBIc_has(imp_dbh,DBIcf_AutoCommit)) {
243 dbd_db_rollback(dbh, imp_dbh); /* ROLLBACK! */
245 dbd_db_disconnect(dbh, imp_dbh);
247 dbd_db_destroy(dbh, imp_dbh);
251 # driver specific functions
255 lo_open(dbh, lobjId, mode)
260 int ret = pg_db_lo_open(dbh, lobjId, mode);
261 ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
268 ST(0) = (-1 != pg_db_lo_close(dbh, fd)) ? &sv_yes : &sv_no;
272 lo_read(dbh, fd, buf, len)
278 SV *bufsv = SvROK(ST(2)) ? SvRV(ST(2)) : ST(2);
281 buf = SvGROW(bufsv, len + 1);
282 ret = pg_db_lo_read(dbh, fd, buf, len);
284 SvCUR_set(bufsv, ret);
285 *SvEND(bufsv) = '\0';
286 sv_setpvn(ST(2), buf, ret);
289 ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
293 lo_write(dbh, fd, buf, len)
299 int ret = pg_db_lo_write(dbh, fd, buf, len);
300 ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
304 lo_lseek(dbh, fd, offset, whence)
310 int ret = pg_db_lo_lseek(dbh, fd, offset, whence);
311 ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
319 int ret = pg_db_lo_creat(dbh, mode);
320 ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
328 int ret = pg_db_lo_tell(dbh, fd);
329 ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
333 lo_unlink(dbh, lobjId)
337 ST(0) = (-1 != pg_db_lo_unlink(dbh, lobjId)) ? &sv_yes : &sv_no;
341 lo_import(dbh, filename)
345 unsigned int ret = pg_db_lo_import(dbh, filename);
346 ST(0) = (ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
350 lo_export(dbh, lobjId, filename)
355 ST(0) = (-1 != pg_db_lo_export(dbh, lobjId, filename)) ? &sv_yes : &sv_no;
363 int ret = pg_db_putline(dbh, buf);
364 ST(0) = (-1 != ret) ? &sv_yes : &sv_no;
368 getline(dbh, buf, len)
370 SV *bufsv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
374 char * buf = sv_grow(bufsv, len);
376 int ret = pg_db_getline(dbh, buf, len);
377 if (*buf == '\\' && *(buf+1) == '.') {
380 sv_setpv((SV*)ST(1), buf);
382 ST(0) = (-1 != ret) ? &sv_yes : &sv_no;
389 ST(0) = (-1 != pg_db_endcopy(dbh)) ? &sv_yes : &sv_no;
392 # -- end of DBD::Pg::db
395 # ------------------------------------------------------------
396 # statement interface
397 # ------------------------------------------------------------
398 MODULE = DBD::Pg PACKAGE = DBD::Pg::st
401 _prepare(sth, statement, attribs=Nullsv)
409 DBD_ATTRIBS_CHECK("_prepare", sth, attribs);
410 if (!strncasecmp(statement, "begin", 5) ||
411 !strncasecmp(statement, "end", 4) ||
412 !strncasecmp(statement, "commit", 6) ||
413 !strncasecmp(statement, "abort", 5) ||
414 !strncasecmp(statement, "rollback", 8) ) {
415 warn("please use DBI functions for transaction handling");
418 ST(0) = dbd_st_prepare(sth, imp_sth, statement, attribs) ? &sv_yes : &sv_no;
428 XST_mIV(0, dbd_st_rows(sth, imp_sth));
432 bind_param(sth, param, value, attribs=Nullsv)
442 if (SvNIOK(attribs)) {
443 sql_type = SvIV(attribs);
448 DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
449 /* XXX we should perhaps complain if TYPE is not SvNIOK */
450 DBD_ATTRIB_GET_IV(attribs, "TYPE", 4, svp, sql_type);
453 ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, FALSE, 0) ? &sv_yes : &sv_no;
458 bind_param_inout(sth, param, value_ref, maxlen, attribs=Nullsv)
468 if (!SvROK(value_ref) || SvTYPE(SvRV(value_ref)) > SVt_PVMG) {
469 croak("bind_param_inout needs a reference to a scalar value");
471 if (SvREADONLY(SvRV(value_ref))) {
475 if (SvNIOK(attribs)) {
476 sql_type = SvIV(attribs);
481 DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
482 DBD_ATTRIB_GET_IV(attribs, "TYPE", 4, svp, sql_type);
485 ST(0) = dbd_bind_ph(sth, imp_sth, param, SvRV(value_ref), sql_type, attribs, TRUE, maxlen) ? &sv_yes : &sv_no;
496 /* Handle binding supplied values to placeholders */
499 imp_sth->all_params_len = 0; /* used for malloc of statement string in case we have placeholders */
500 if (items-1 != DBIc_NUM_PARAMS(imp_sth)) {
501 croak("execute called with %ld bind variables, %d needed", items-1, DBIc_NUM_PARAMS(imp_sth));
504 idx = sv_2mortal(newSViv(0));
505 for(i=1; i < items ; ++i) {
507 if (!dbd_bind_ph(sth, imp_sth, idx, ST(i), 0, Nullsv, FALSE, 0)) {
508 XSRETURN_UNDEF; /* dbd_bind_ph already registered error */
512 ret = dbd_st_execute(sth, imp_sth);
513 /* remember that dbd_st_execute must return <= -2 for error */
514 if (ret == 0) { /* ok with no rows affected */
515 XST_mPV(0, "0E0"); /* (true but zero) */
517 else if (ret < -1) { /* -1 == unknown number of rows */
518 XST_mUNDEF(0); /* <= -2 means error */
521 XST_mIV(0, ret); /* typically 1, rowcount or -1 */
526 fetchrow_arrayref(sth)
532 AV *av = dbd_st_fetch(sth, imp_sth);
533 ST(0) = (av) ? sv_2mortal(newRV_inc((SV *)av)) : &sv_undef;
544 av = dbd_st_fetch(sth, imp_sth);
546 int num_fields = AvFILL(av)+1;
548 EXTEND(sp, num_fields);
549 for(i=0; i < num_fields; ++i) {
550 PUSHs(AvARRAY(av)[i]);
561 if (!DBIc_ACTIVE(imp_dbh)) {
562 /* Either an explicit disconnect() or global destruction */
563 /* has disconnected us from the database. Finish is meaningless */
567 if (!DBIc_ACTIVE(imp_sth)) {
568 /* No active statement to finish */
571 ST(0) = dbd_st_finish(sth, imp_sth) ? &sv_yes : &sv_no;
575 blob_read(sth, field, offset, len, destrv=Nullsv, destoffset=0)
586 destrv = sv_2mortal(newRV_inc(sv_2mortal(newSViv(0))));
588 ST(0) = dbd_st_blob_read(sth, imp_sth, field, offset, len, destrv, destoffset) ? SvRV(destrv) : &sv_undef;
592 STORE(sth, keysv, valuesv)
599 if (!dbd_st_STORE_attrib(sth, imp_sth, keysv, valuesv)) {
600 if (!DBIS->set_attr(sth, keysv, valuesv)) {
606 # FETCH renamed and ALIASed to avoid case clash on VMS :-(
608 FETCH_attrib(sth, keysv)
615 SV *valuesv = dbd_st_FETCH_attrib(sth, imp_sth, keysv);
617 valuesv = DBIS->get_attr(sth, keysv);
619 ST(0) = valuesv; /* dbd_st_FETCH_attrib did sv_2mortal */
628 if (!DBIc_IMPSET(imp_sth)) { /* was never fully set up */
629 if (DBIc_WARN(imp_sth) && !dirty && dbis->debug >= 2) {
630 warn("Statement handle %s DESTROY ignored - never set up", SvPV(sth,na));
634 if (DBIc_IADESTROY(imp_sth)) { /* want's ineffective destroy */
635 DBIc_ACTIVE_off(imp_sth);
637 if (DBIc_ACTIVE(imp_sth)) {
638 dbd_st_finish(sth, imp_sth);
640 dbd_st_destroy(sth, imp_sth);