install/5.005/DBD-Pg-1.22-fixvercmp/Pg.xs

   1 /*
   2    $Id: Pg.xs,v 1.1 2004-04-29 09:21:28 ivan Exp $
   3
   4    Copyright (c) 1997,1998,1999,2000 Edmund Mergl
   5    Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce
   6
   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.
   9
  10 */
  11
  12
  13 #include "Pg.h"
  14
  15
  16 #ifdef _MSC_VER
  17 #define strncasecmp(a,b,c) _strnicmp((a),(b),(c))
  18 #endif
  19
  20
  21
  22 DBISTATE_DECLARE;
  23
  24
  25 MODULE = DBD::Pg        PACKAGE = DBD::Pg
  26
  27 I32
  28 constant(name=Nullch)
  29     char *name
  30     PROTOTYPE:
  31     ALIAS:
  32     PG_BOOL      = 16
  33     PG_BYTEA     = 17
  34     PG_CHAR      = 18
  35     PG_INT8      = 20
  36     PG_INT2      = 21
  37     PG_INT4      = 23
  38     PG_TEXT      = 25
  39     PG_OID       = 26
  40     PG_FLOAT4    = 700
  41     PG_FLOAT8    = 701
  42     PG_ABSTIME   = 702
  43     PG_RELTIME   = 703
  44     PG_TINTERVAL = 704
  45     PG_BPCHAR    = 1042
  46     PG_VARCHAR   = 1043
  47     PG_DATE      = 1082
  48     PG_TIME      = 1083
  49     PG_DATETIME  = 1184
  50     PG_TIMESPAN  = 1186
  51     PG_TIMESTAMP = 1296
  52     CODE:
  53     if (!ix) {
  54         if (!name) name = GvNAME(CvGV(cv));
  55         croak("Unknown DBD::Pg constant '%s'", name);
  56     }
  57     else RETVAL = ix;
  58     OUTPUT:
  59     RETVAL
  60
  61 PROTOTYPES: DISABLE
  62
  63 BOOT:
  64     items = 0;  /* avoid 'unused variable' warning */
  65     DBISTATE_INIT;
  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));
  70     dbd_init(DBIS);
  71
  72
  73 # ------------------------------------------------------------
  74 # driver level interface
  75 # ------------------------------------------------------------
  76 MODULE = DBD::Pg        PACKAGE = DBD::Pg::dr
  77
  78 # disconnect_all renamed and ALIASed to avoid length clash on VMS :-(
  79 void
  80 discon_all_(drh)
  81     SV *        drh
  82     ALIAS:
  83         disconnect_all = 1
  84     CODE:
  85     D_imp_drh(drh);
  86     ST(0) = dbd_discon_all(drh, imp_drh) ? &sv_yes : &sv_no;
  87
  88
  89
  90 # ------------------------------------------------------------
  91 # database level interface
  92 # ------------------------------------------------------------
  93 MODULE = DBD::Pg        PACKAGE = DBD::Pg::db
  94
  95 void
  96 _login(dbh, dbname, username, pwd)
  97     SV *        dbh
  98     char *      dbname
  99     char *      username
 100     char *      pwd
 101     CODE:
 102     D_imp_dbh(dbh);
 103     ST(0) = pg_db_login(dbh, imp_dbh, dbname, username, pwd) ? &sv_yes : &sv_no;
 104
 105
 106 int
 107 _ping(dbh)
 108     SV *        dbh
 109     CODE:
 110     int ret;
 111     ret = dbd_db_ping(dbh);
 112     if (ret == 0) {
 113         XST_mUNDEF(0);
 114     }
 115     else {
 116         XST_mIV(0, ret);
 117     }
 118
 119 void
 120 getfd(dbh)
 121     SV *        dbh
 122     CODE:
 123     int ret;
 124     D_imp_dbh(dbh);
 125
 126     ret = dbd_db_getfd(dbh, imp_dbh);
 127     ST(0) = sv_2mortal( newSViv( ret ) );
 128
 129 void
 130 pg_notifies(dbh)
 131     SV *        dbh
 132     CODE:
 133     D_imp_dbh(dbh);
 134
 135     ST(0) = dbd_db_pg_notifies(dbh, imp_dbh);
 136
 137 void
 138 commit(dbh)
 139     SV *        dbh
 140     CODE:
 141     D_imp_dbh(dbh);
 142     if (DBIc_has(imp_dbh, DBIcf_AutoCommit)) {
 143         warn("commit ineffective with AutoCommit enabled");
 144     }
 145     ST(0) = dbd_db_commit(dbh, imp_dbh) ? &sv_yes : &sv_no;
 146
 147
 148 void
 149 rollback(dbh)
 150     SV *        dbh
 151     CODE:
 152     D_imp_dbh(dbh);
 153     if (DBIc_has(imp_dbh, DBIcf_AutoCommit)) {
 154         warn("rollback ineffective with AutoCommit enabled");
 155     }
 156     ST(0) = dbd_db_rollback(dbh, imp_dbh) ? &sv_yes : &sv_no;
 157
 158
 159 void
 160 disconnect(dbh)
 161     SV *        dbh
 162     CODE:
 163     D_imp_dbh(dbh);
 164     if ( !DBIc_ACTIVE(imp_dbh) ) {
 165         XSRETURN_YES;
 166     }
 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;
 171     }
 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.");
 179     }
 180     ST(0) = dbd_db_disconnect(dbh, imp_dbh) ? &sv_yes : &sv_no;
 181
 182
 183 void
 184 STORE(dbh, keysv, valuesv)
 185     SV *        dbh
 186     SV *        keysv
 187     SV *        valuesv
 188     CODE:
 189     D_imp_dbh(dbh);
 190     ST(0) = &sv_yes;
 191     if (!dbd_db_STORE_attrib(dbh, imp_dbh, keysv, valuesv)) {
 192         if (!DBIS->set_attr(dbh, keysv, valuesv)) {
 193             ST(0) = &sv_no;
 194         }
 195     }
 196
 197
 198 void
 199 FETCH(dbh, keysv)
 200     SV *        dbh
 201     SV *        keysv
 202     CODE:
 203     D_imp_dbh(dbh);
 204     SV *valuesv = dbd_db_FETCH_attrib(dbh, imp_dbh, keysv);
 205     if (!valuesv) {
 206         valuesv = DBIS->get_attr(dbh, keysv);
 207     }
 208     ST(0) = valuesv;    /* dbd_db_FETCH_attrib did sv_2mortal   */
 209
 210
 211 void
 212 DESTROY(dbh)
 213     SV *        dbh
 214     PPCODE:
 215     D_imp_dbh(dbh);
 216     ST(0) = &sv_yes;
 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));
 220         }
 221     }
 222     else {
 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;
 227         }
 228         if (DBIc_IADESTROY(imp_dbh)) { /* want's ineffective destroy    */
 229             DBIc_ACTIVE_off(imp_dbh);
 230         }
 231         if (DBIc_ACTIVE(imp_dbh)) {
 232             if (DBIc_WARN(imp_dbh) && (!dirty || dbis->debug >= 3)) {
 233                 warn("Database handle destroyed without explicit disconnect");
 234             }
 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! */
 244             }
 245             dbd_db_disconnect(dbh, imp_dbh);
 246         }
 247         dbd_db_destroy(dbh, imp_dbh);
 248     }
 249
 250
 251 # driver specific functions
 252
 253
 254 void
 255 lo_open(dbh, lobjId, mode)
 256     SV *        dbh
 257     unsigned int        lobjId
 258     int mode
 259     CODE:
 260         int ret = pg_db_lo_open(dbh, lobjId, mode);
 261         ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
 262
 263 void
 264 lo_close(dbh, fd)
 265     SV *        dbh
 266     int fd
 267     CODE:
 268         ST(0) = (-1 != pg_db_lo_close(dbh, fd)) ? &sv_yes : &sv_no;
 269
 270
 271 void
 272 lo_read(dbh, fd, buf, len)
 273             SV *        dbh
 274             int fd
 275             char *      buf
 276             int len
 277         PREINIT:
 278             SV *bufsv = SvROK(ST(2)) ? SvRV(ST(2)) : ST(2);
 279             int ret;
 280         CODE:
 281             buf = SvGROW(bufsv, len + 1);
 282             ret = pg_db_lo_read(dbh, fd, buf, len);
 283             if (ret > 0) {
 284                 SvCUR_set(bufsv, ret);
 285                 *SvEND(bufsv) = '\0';
 286                 sv_setpvn(ST(2), buf, ret);
 287                 SvSETMAGIC(ST(2));
 288             }
 289             ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
 290
 291
 292 void
 293 lo_write(dbh, fd, buf, len)
 294     SV *        dbh
 295     int fd
 296     char *      buf
 297     int len
 298     CODE:
 299         int ret = pg_db_lo_write(dbh, fd, buf, len);
 300         ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
 301
 302
 303 void
 304 lo_lseek(dbh, fd, offset, whence)
 305     SV *        dbh
 306     int fd
 307     int offset
 308     int whence
 309     CODE:
 310         int ret = pg_db_lo_lseek(dbh, fd, offset, whence);
 311         ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
 312
 313
 314 void
 315 lo_creat(dbh, mode)
 316     SV *        dbh
 317     int mode
 318     CODE:
 319         int ret = pg_db_lo_creat(dbh, mode);
 320         ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
 321
 322
 323 void
 324 lo_tell(dbh, fd)
 325     SV *        dbh
 326     int fd
 327     CODE:
 328         int ret = pg_db_lo_tell(dbh, fd);
 329         ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
 330
 331
 332 void
 333 lo_unlink(dbh, lobjId)
 334     SV *        dbh
 335     unsigned int        lobjId
 336     CODE:
 337         ST(0) = (-1 != pg_db_lo_unlink(dbh, lobjId)) ? &sv_yes : &sv_no;
 338
 339
 340 void
 341 lo_import(dbh, filename)
 342     SV *        dbh
 343     char *      filename
 344     CODE:
 345         unsigned int ret = pg_db_lo_import(dbh, filename);
 346         ST(0) = (ret) ? sv_2mortal(newSViv(ret)) : &sv_undef;
 347
 348
 349 void
 350 lo_export(dbh, lobjId, filename)
 351     SV *        dbh
 352     unsigned int        lobjId
 353     char *      filename
 354     CODE:
 355         ST(0) = (-1 != pg_db_lo_export(dbh, lobjId, filename)) ? &sv_yes : &sv_no;
 356
 357
 358 void
 359 putline(dbh, buf)
 360     SV *        dbh
 361     char *      buf
 362     CODE:
 363         int ret = pg_db_putline(dbh, buf);
 364         ST(0) = (-1 != ret) ? &sv_yes : &sv_no;
 365
 366
 367 void
 368 getline(dbh, buf, len)
 369     PREINIT:
 370         SV *bufsv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
 371     INPUT:
 372         SV *    dbh
 373         int     len
 374         char *  buf = sv_grow(bufsv, len);
 375     CODE:
 376         int ret = pg_db_getline(dbh, buf, len);
 377         if (*buf == '\\' && *(buf+1) == '.') {
 378             ret = -1;
 379         }
 380         sv_setpv((SV*)ST(1), buf);
 381         SvSETMAGIC(ST(1));
 382         ST(0) = (-1 != ret) ? &sv_yes : &sv_no;
 383
 384
 385 void
 386 endcopy(dbh)
 387     SV *        dbh
 388     CODE:
 389         ST(0) = (-1 != pg_db_endcopy(dbh)) ? &sv_yes : &sv_no;
 390
 391
 392 # -- end of DBD::Pg::db
 393
 394
 395 # ------------------------------------------------------------
 396 # statement interface
 397 # ------------------------------------------------------------
 398 MODULE = DBD::Pg        PACKAGE = DBD::Pg::st
 399
 400 void
 401 _prepare(sth, statement, attribs=Nullsv)
 402     SV *        sth
 403     char *      statement
 404     SV *        attribs
 405     CODE:
 406     {
 407     D_imp_sth(sth);
 408     D_imp_dbh_from_sth;
 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");
 416         ST(0) = &sv_no;
 417     } else {
 418         ST(0) = dbd_st_prepare(sth, imp_sth, statement, attribs) ? &sv_yes : &sv_no;
 419     }
 420     }
 421
 422
 423 void
 424 rows(sth)
 425     SV *        sth
 426     CODE:
 427     D_imp_sth(sth);
 428     XST_mIV(0, dbd_st_rows(sth, imp_sth));
 429
 430
 431 void
 432 bind_param(sth, param, value, attribs=Nullsv)
 433     SV *        sth
 434     SV *        param
 435     SV *        value
 436     SV *        attribs
 437     CODE:
 438     {
 439     IV sql_type = 0;
 440     D_imp_sth(sth);
 441     if (attribs) {
 442         if (SvNIOK(attribs)) {
 443             sql_type = SvIV(attribs);
 444             attribs = Nullsv;
 445         }
 446         else {
 447             SV **svp;
 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);
 451         }
 452     }
 453     ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, FALSE, 0) ? &sv_yes : &sv_no;
 454     }
 455
 456
 457 void
 458 bind_param_inout(sth, param, value_ref, maxlen, attribs=Nullsv)
 459     SV *        sth
 460     SV *        param
 461     SV *        value_ref
 462     IV          maxlen
 463     SV *        attribs
 464     CODE:
 465     {
 466     IV sql_type = 0;
 467     D_imp_sth(sth);
 468     if (!SvROK(value_ref) || SvTYPE(SvRV(value_ref)) > SVt_PVMG) {
 469         croak("bind_param_inout needs a reference to a scalar value");
 470     }
 471     if (SvREADONLY(SvRV(value_ref))) {
 472        croak(no_modify);
 473     }
 474     if (attribs) {
 475         if (SvNIOK(attribs)) {
 476             sql_type = SvIV(attribs);
 477             attribs = Nullsv;
 478         }
 479         else {
 480             SV **svp;
 481             DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
 482             DBD_ATTRIB_GET_IV(attribs, "TYPE", 4, svp, sql_type);
 483         }
 484     }
 485     ST(0) = dbd_bind_ph(sth, imp_sth, param, SvRV(value_ref), sql_type, attribs, TRUE, maxlen) ? &sv_yes : &sv_no;
 486     }
 487
 488
 489 void
 490 execute(sth, ...)
 491     SV *        sth
 492     CODE:
 493     D_imp_sth(sth);
 494     int ret;
 495     if (items > 1) {
 496         /* Handle binding supplied values to placeholders       */
 497         int i;
 498         SV *idx;
 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));
 502             XSRETURN_UNDEF;
 503         }
 504         idx = sv_2mortal(newSViv(0));
 505         for(i=1; i < items ; ++i) {
 506             sv_setiv(idx, 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 */
 509             }
 510         }
 511     }
 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)              */
 516     }
 517     else if (ret < -1) {        /* -1 == unknown number of rows */
 518         XST_mUNDEF(0);          /* <= -2 means error            */
 519     }
 520     else {
 521         XST_mIV(0, ret);        /* typically 1, rowcount or -1  */
 522     }
 523
 524
 525 void
 526 fetchrow_arrayref(sth)
 527     SV *        sth
 528     ALIAS:
 529         fetch = 1
 530     CODE:
 531     D_imp_sth(sth);
 532     AV *av = dbd_st_fetch(sth, imp_sth);
 533     ST(0) = (av) ? sv_2mortal(newRV_inc((SV *)av)) : &sv_undef;
 534
 535
 536 void
 537 fetchrow_array(sth)
 538     SV *        sth
 539     ALIAS:
 540         fetchrow = 1
 541     PPCODE:
 542     D_imp_sth(sth);
 543     AV *av;
 544     av = dbd_st_fetch(sth, imp_sth);
 545     if (av) {
 546         int num_fields = AvFILL(av)+1;
 547         int i;
 548         EXTEND(sp, num_fields);
 549         for(i=0; i < num_fields; ++i) {
 550             PUSHs(AvARRAY(av)[i]);
 551         }
 552     }
 553
 554
 555 void
 556 finish(sth)
 557     SV *        sth
 558     CODE:
 559     D_imp_sth(sth);
 560     D_imp_dbh_from_sth;
 561     if (!DBIc_ACTIVE(imp_dbh)) {
 562         /* Either an explicit disconnect() or global destruction        */
 563         /* has disconnected us from the database. Finish is meaningless */
 564         /* XXX warn */
 565         XSRETURN_YES;
 566     }
 567     if (!DBIc_ACTIVE(imp_sth)) {
 568         /* No active statement to finish        */
 569         XSRETURN_YES;
 570     }
 571     ST(0) = dbd_st_finish(sth, imp_sth) ? &sv_yes : &sv_no;
 572
 573
 574 void
 575 blob_read(sth, field, offset, len, destrv=Nullsv, destoffset=0)
 576     SV *        sth
 577     int field
 578     long        offset
 579     long        len
 580     SV *        destrv
 581     long        destoffset
 582     CODE:
 583     {
 584     D_imp_sth(sth);
 585     if (!destrv) {
 586         destrv = sv_2mortal(newRV_inc(sv_2mortal(newSViv(0))));
 587     }
 588     ST(0) = dbd_st_blob_read(sth, imp_sth, field, offset, len, destrv, destoffset) ? SvRV(destrv) : &sv_undef;
 589     }
 590
 591 void
 592 STORE(sth, keysv, valuesv)
 593     SV *        sth
 594     SV *        keysv
 595     SV *        valuesv
 596     CODE:
 597     D_imp_sth(sth);
 598     ST(0) = &sv_yes;
 599     if (!dbd_st_STORE_attrib(sth, imp_sth, keysv, valuesv)) {
 600         if (!DBIS->set_attr(sth, keysv, valuesv)) {
 601             ST(0) = &sv_no;
 602         }
 603     }
 604
 605
 606 # FETCH renamed and ALIASed to avoid case clash on VMS :-(
 607 void
 608 FETCH_attrib(sth, keysv)
 609     SV *        sth
 610     SV *        keysv
 611     ALIAS:
 612     FETCH = 1
 613     CODE:
 614     D_imp_sth(sth);
 615     SV *valuesv = dbd_st_FETCH_attrib(sth, imp_sth, keysv);
 616     if (!valuesv) {
 617         valuesv = DBIS->get_attr(sth, keysv);
 618     }
 619     ST(0) = valuesv;    /* dbd_st_FETCH_attrib did sv_2mortal   */
 620
 621
 622 void
 623 DESTROY(sth)
 624     SV *        sth
 625     PPCODE:
 626     D_imp_sth(sth);
 627     ST(0) = &sv_yes;
 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));
 631         }
 632     }
 633     else {
 634         if (DBIc_IADESTROY(imp_sth)) { /* want's ineffective destroy    */
 635             DBIc_ACTIVE_off(imp_sth);
 636         }
 637         if (DBIc_ACTIVE(imp_sth)) {
 638             dbd_st_finish(sth, imp_sth);
 639         }
 640         dbd_st_destroy(sth, imp_sth);
 641     }
 642
 643
 644 # end of Pg.xs