ext/DB_File/DB_File.xs

   1 /*
   2
   3  DB_File.xs -- Perl 5 interface to Berkeley DB
   4
   5  written by Paul Marquess <Paul.Marquess@btinternet.com>
   6  last modified 6th March 1999
   7  version 1.65
   8
   9  All comments/suggestions/problems are welcome
  10
  11      Copyright (c) 1995-9 Paul Marquess. All rights reserved.
  12      This program is free software; you can redistribute it and/or
  13      modify it under the same terms as Perl itself.
  14
  15  Changes:
  16         0.1 -   Initial Release
  17         0.2 -   No longer bombs out if dbopen returns an error.
  18         0.3 -   Added some support for multiple btree compares
  19         1.0 -   Complete support for multiple callbacks added.
  20                 Fixed a problem with pushing a value onto an empty list.
  21         1.01 -  Fixed a SunOS core dump problem.
  22                 The return value from TIEHASH wasn't set to NULL when
  23                 dbopen returned an error.
  24         1.02 -  Use ALIAS to define TIEARRAY.
  25                 Removed some redundant commented code.
  26                 Merged OS2 code into the main distribution.
  27                 Allow negative subscripts with RECNO interface.
  28                 Changed the default flags to O_CREAT|O_RDWR
  29         1.03 -  Added EXISTS
  30         1.04 -  fixed a couple of bugs in hash_cb. Patches supplied by
  31                 Dave Hammen, hammen@gothamcity.jsc.nasa.gov
  32         1.05 -  Added logic to allow prefix & hash types to be specified via
  33                 Makefile.PL
  34         1.06 -  Minor namespace cleanup: Localized PrintBtree.
  35         1.07 -  Fixed bug with RECNO, where bval wasn't defaulting to "\n".
  36         1.08 -  No change to DB_File.xs
  37         1.09 -  Default mode for dbopen changed to 0666
  38         1.10 -  Fixed fd method so that it still returns -1 for
  39                 in-memory files when db 1.86 is used.
  40         1.11 -  No change to DB_File.xs
  41         1.12 -  No change to DB_File.xs
  42         1.13 -  Tidied up a few casts.
  43         1.14 -  Made it illegal to tie an associative array to a RECNO
  44                 database and an ordinary array to a HASH or BTREE database.
  45         1.50 -  Make work with both DB 1.x or DB 2.x
  46         1.51 -  Fixed a bug in mapping 1.x O_RDONLY flag to 2.x DB_RDONLY equivalent
  47         1.52 -  Patch from Gisle Aas <gisle@aas.no> to suppress "use of
  48                 undefined value" warning with db_get and db_seq.
  49         1.53 -  Added DB_RENUMBER to flags for recno.
  50         1.54 -  Fixed bug in the fd method
  51         1.55 -  Fix for AIX from Jarkko Hietaniemi
  52         1.56 -  No change to DB_File.xs
  53         1.57 -  added the #undef op to allow building with Threads support.
  54         1.58 -  Fixed a problem with the use of sv_setpvn. When the
  55                 size is specified as 0, it does a strlen on the data.
  56                 This was ok for DB 1.x, but isn't for DB 2.x.
  57         1.59 -  No change to DB_File.xs
  58         1.60 -  Some code tidy up
  59         1.61 -  added flagSet macro for DB 2.5.x
  60                 fixed typo in O_RDONLY test.
  61         1.62 -  No change to DB_File.xs
  62         1.63 -  Fix to alllow DB 2.6.x to build.
  63         1.64 -  Tidied up the 1.x to 2.x flags mapping code.
  64                 Added a patch from Mark Kettenis <kettenis@wins.uva.nl>
  65                 to fix a flag mapping problem with O_RDONLY on the Hurd
  66         1.65 -  Fixed a bug in the PUSH logic.
  67                 Added BOOT check that using 2.3.4 or greater
  68
  69
  70
  71 */
  72
  73 #include "EXTERN.h"
  74 #include "perl.h"
  75 #include "XSUB.h"
  76
  77 #ifndef PERL_VERSION
  78 #include "patchlevel.h"
  79 #define PERL_REVISION   5
  80 #define PERL_VERSION    PATCHLEVEL
  81 #define PERL_SUBVERSION SUBVERSION
  82 #endif
  83
  84 #if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 ))
  85
  86 #    define PL_sv_undef         sv_undef
  87 #    define PL_na               na
  88
  89 #endif
  90
  91 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
  92  * shortly #included by the <db.h>) __attribute__ to the possibly
  93  * already defined __attribute__, for example by GNUC or by Perl. */
  94
  95 #undef __attribute__
  96
  97 /* If Perl has been compiled with Threads support,the symbol op will
  98    be defined here. This clashes with a field name in db.h, so get rid of it.
  99  */
 100 #ifdef op
 101 #undef op
 102 #endif
 103 #include <db.h>
 104
 105 #include <fcntl.h>
 106
 107 /* #define TRACE */
 108
 109
 110
 111 #ifdef DB_VERSION_MAJOR
 112
 113 /* map version 2 features & constants onto their version 1 equivalent */
 114
 115 #ifdef DB_Prefix_t
 116 #undef DB_Prefix_t
 117 #endif
 118 #define DB_Prefix_t     size_t
 119
 120 #ifdef DB_Hash_t
 121 #undef DB_Hash_t
 122 #endif
 123 #define DB_Hash_t       u_int32_t
 124
 125 /* DBTYPE stays the same */
 126 /* HASHINFO, RECNOINFO and BTREEINFO  map to DB_INFO */
 127 typedef DB_INFO INFO ;
 128
 129 /* version 2 has db_recno_t in place of recno_t */
 130 typedef db_recno_t      recno_t;
 131
 132
 133 #define R_CURSOR        DB_SET_RANGE
 134 #define R_FIRST         DB_FIRST
 135 #define R_IAFTER        DB_AFTER
 136 #define R_IBEFORE       DB_BEFORE
 137 #define R_LAST          DB_LAST
 138 #define R_NEXT          DB_NEXT
 139 #define R_NOOVERWRITE   DB_NOOVERWRITE
 140 #define R_PREV          DB_PREV
 141 #define R_SETCURSOR     0
 142 #define R_RECNOSYNC     0
 143 #define R_FIXEDLEN      DB_FIXEDLEN
 144 #define R_DUP           DB_DUP
 145
 146 #define db_HA_hash      h_hash
 147 #define db_HA_ffactor   h_ffactor
 148 #define db_HA_nelem     h_nelem
 149 #define db_HA_bsize     db_pagesize
 150 #define db_HA_cachesize db_cachesize
 151 #define db_HA_lorder    db_lorder
 152
 153 #define db_BT_compare   bt_compare
 154 #define db_BT_prefix    bt_prefix
 155 #define db_BT_flags     flags
 156 #define db_BT_psize     db_pagesize
 157 #define db_BT_cachesize db_cachesize
 158 #define db_BT_lorder    db_lorder
 159 #define db_BT_maxkeypage
 160 #define db_BT_minkeypage
 161
 162
 163 #define db_RE_reclen    re_len
 164 #define db_RE_flags     flags
 165 #define db_RE_bval      re_pad
 166 #define db_RE_bfname    re_source
 167 #define db_RE_psize     db_pagesize
 168 #define db_RE_cachesize db_cachesize
 169 #define db_RE_lorder    db_lorder
 170
 171 #define TXN     NULL,
 172
 173 #define do_SEQ(db, key, value, flag)    (db->cursor->c_get)(db->cursor, &key, &value, flag)
 174
 175
 176 #define DBT_flags(x)    x.flags = 0
 177 #define DB_flags(x, v)  x |= v
 178
 179 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
 180 #define flagSet(flags, bitmask)        ((flags) & (bitmask))
 181 #else
 182 #define flagSet(flags, bitmask)        (((flags) & DB_OPFLAGS_MASK) == (bitmask))
 183 #endif
 184
 185 #else /* db version 1.x */
 186
 187 typedef union INFO {
 188         HASHINFO        hash ;
 189         RECNOINFO       recno ;
 190         BTREEINFO       btree ;
 191       } INFO ;
 192
 193
 194 #ifdef mDB_Prefix_t
 195 #ifdef DB_Prefix_t
 196 #undef DB_Prefix_t
 197 #endif
 198 #define DB_Prefix_t     mDB_Prefix_t
 199 #endif
 200
 201 #ifdef mDB_Hash_t
 202 #ifdef DB_Hash_t
 203 #undef DB_Hash_t
 204 #endif
 205 #define DB_Hash_t       mDB_Hash_t
 206 #endif
 207
 208 #define db_HA_hash      hash.hash
 209 #define db_HA_ffactor   hash.ffactor
 210 #define db_HA_nelem     hash.nelem
 211 #define db_HA_bsize     hash.bsize
 212 #define db_HA_cachesize hash.cachesize
 213 #define db_HA_lorder    hash.lorder
 214
 215 #define db_BT_compare   btree.compare
 216 #define db_BT_prefix    btree.prefix
 217 #define db_BT_flags     btree.flags
 218 #define db_BT_psize     btree.psize
 219 #define db_BT_cachesize btree.cachesize
 220 #define db_BT_lorder    btree.lorder
 221 #define db_BT_maxkeypage btree.maxkeypage
 222 #define db_BT_minkeypage btree.minkeypage
 223
 224 #define db_RE_reclen    recno.reclen
 225 #define db_RE_flags     recno.flags
 226 #define db_RE_bval      recno.bval
 227 #define db_RE_bfname    recno.bfname
 228 #define db_RE_psize     recno.psize
 229 #define db_RE_cachesize recno.cachesize
 230 #define db_RE_lorder    recno.lorder
 231
 232 #define TXN
 233
 234 #define do_SEQ(db, key, value, flag)    (db->dbp->seq)(db->dbp, &key, &value, flag)
 235 #define DBT_flags(x)
 236 #define DB_flags(x, v)
 237 #define flagSet(flags, bitmask)        ((flags) & (bitmask))
 238
 239 #endif /* db version 1 */
 240
 241
 242
 243 #define db_DELETE(db, key, flags)       ((db->dbp)->del)(db->dbp, TXN &key, flags)
 244 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, flags)
 245 #define db_FETCH(db, key, flags)        ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
 246
 247 #define db_sync(db, flags)              ((db->dbp)->sync)(db->dbp, flags)
 248 #define db_get(db, key, value, flags)   ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
 249
 250 #ifdef DB_VERSION_MAJOR
 251 #define db_DESTROY(db)                  ((db->dbp)->close)(db->dbp, 0)
 252 #define db_close(db)                    ((db->dbp)->close)(db->dbp, 0)
 253 #define db_del(db, key, flags)          (flagSet(flags, R_CURSOR)                                       \
 254                                                 ? ((db->cursor)->c_del)(db->cursor, 0)          \
 255                                                 : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
 256
 257 #else
 258
 259 #define db_DESTROY(db)                  ((db->dbp)->close)(db->dbp)
 260 #define db_close(db)                    ((db->dbp)->close)(db->dbp)
 261 #define db_del(db, key, flags)          ((db->dbp)->del)(db->dbp, &key, flags)
 262 #define db_put(db, key, value, flags)   ((db->dbp)->put)(db->dbp, &key, &value, flags)
 263
 264 #endif
 265
 266
 267 #define db_seq(db, key, value, flags)   do_SEQ(db, key, value, flags)
 268
 269 typedef struct {
 270         DBTYPE  type ;
 271         DB *    dbp ;
 272         SV *    compare ;
 273         SV *    prefix ;
 274         SV *    hash ;
 275         int     in_memory ;
 276         INFO    info ;
 277 #ifdef DB_VERSION_MAJOR
 278         DBC *   cursor ;
 279 #endif
 280         } DB_File_type;
 281
 282 typedef DB_File_type * DB_File ;
 283 typedef DBT DBTKEY ;
 284
 285 #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
 286
 287 #define OutputValue(arg, name)                                  \
 288         { if (RETVAL == 0) {                                    \
 289               my_sv_setpvn(arg, name.data, name.size) ;         \
 290           }                                                     \
 291         }
 292
 293 #define OutputKey(arg, name)                                    \
 294         { if (RETVAL == 0)                                      \
 295           {                                                     \
 296                 if (db->type != DB_RECNO) {                     \
 297                     my_sv_setpvn(arg, name.data, name.size);    \
 298                 }                                               \
 299                 else                                            \
 300                     sv_setiv(arg, (I32)*(I32*)name.data - 1);   \
 301           }                                                     \
 302         }
 303
 304
 305 /* Internal Global Data */
 306 static recno_t Value ;
 307 static recno_t zero = 0 ;
 308 static DB_File CurrentDB ;
 309 static DBTKEY empty ;
 310
 311 #ifdef DB_VERSION_MAJOR
 312
 313 static int
 314 db_put(db, key, value, flags)
 315 DB_File         db ;
 316 DBTKEY          key ;
 317 DBT             value ;
 318 u_int           flags ;
 319
 320 {
 321     int status ;
 322
 323     if (flagSet(flags, R_CURSOR)) {
 324         status = ((db->cursor)->c_del)(db->cursor, 0);
 325         if (status != 0)
 326             return status ;
 327
 328 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
 329         flags &= ~R_CURSOR ;
 330 #else
 331         flags &= ~DB_OPFLAGS_MASK ;
 332 #endif
 333
 334     }
 335
 336     return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
 337
 338 }
 339
 340 #endif /* DB_VERSION_MAJOR */
 341
 342 static void
 343 GetVersionInfo()
 344 {
 345     SV * ver_sv = perl_get_sv("DB_File::db_version", TRUE) ;
 346 #ifdef DB_VERSION_MAJOR
 347     int Major, Minor, Patch ;
 348
 349     (void)db_version(&Major, &Minor, &Patch) ;
 350
 351     /* check that libdb is recent enough  -- we need 2.3.4 or greater */
 352     if (Major == 2 && (Minor < 3 || (Minor ==  3 && Patch < 4)))
 353         croak("DB_File needs Berkeley DB 2.3.4 or greater, you have %d.%d.%d\n",
 354                  Major, Minor, Patch) ;
 355
 356 #if PERL_VERSION > 3
 357     sv_setpvf(ver_sv, "%d.%d", Major, Minor) ;
 358 #else
 359     {
 360         char buffer[40] ;
 361         sprintf(buffer, "%d.%d", Major, Minor) ;
 362         sv_setpv(ver_sv, buffer) ;
 363     }
 364 #endif
 365
 366 #else
 367     sv_setiv(ver_sv, 1) ;
 368 #endif
 369
 370 }
 371
 372
 373 static int
 374 btree_compare(key1, key2)
 375 const DBT * key1 ;
 376 const DBT * key2 ;
 377 {
 378     dSP ;
 379     void * data1, * data2 ;
 380     int retval ;
 381     int count ;
 382
 383     data1 = key1->data ;
 384     data2 = key2->data ;
 385
 386     /* As newSVpv will assume that the data pointer is a null terminated C
 387        string if the size parameter is 0, make sure that data points to an
 388        empty string if the length is 0
 389     */
 390     if (key1->size == 0)
 391         data1 = "" ;
 392     if (key2->size == 0)
 393         data2 = "" ;
 394
 395     ENTER ;
 396     SAVETMPS;
 397
 398     PUSHMARK(SP) ;
 399     EXTEND(SP,2) ;
 400     PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
 401     PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
 402     PUTBACK ;
 403
 404     count = perl_call_sv(CurrentDB->compare, G_SCALAR);
 405
 406     SPAGAIN ;
 407
 408     if (count != 1)
 409         croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
 410
 411     retval = POPi ;
 412
 413     PUTBACK ;
 414     FREETMPS ;
 415     LEAVE ;
 416     return (retval) ;
 417
 418 }
 419
 420 static DB_Prefix_t
 421 btree_prefix(key1, key2)
 422 const DBT * key1 ;
 423 const DBT * key2 ;
 424 {
 425     dSP ;
 426     void * data1, * data2 ;
 427     int retval ;
 428     int count ;
 429
 430     data1 = key1->data ;
 431     data2 = key2->data ;
 432
 433     /* As newSVpv will assume that the data pointer is a null terminated C
 434        string if the size parameter is 0, make sure that data points to an
 435        empty string if the length is 0
 436     */
 437     if (key1->size == 0)
 438         data1 = "" ;
 439     if (key2->size == 0)
 440         data2 = "" ;
 441
 442     ENTER ;
 443     SAVETMPS;
 444
 445     PUSHMARK(SP) ;
 446     EXTEND(SP,2) ;
 447     PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
 448     PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
 449     PUTBACK ;
 450
 451     count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
 452
 453     SPAGAIN ;
 454
 455     if (count != 1)
 456         croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
 457
 458     retval = POPi ;
 459
 460     PUTBACK ;
 461     FREETMPS ;
 462     LEAVE ;
 463
 464     return (retval) ;
 465 }
 466
 467 static DB_Hash_t
 468 hash_cb(data, size)
 469 const void * data ;
 470 size_t size ;
 471 {
 472     dSP ;
 473     int retval ;
 474     int count ;
 475
 476     if (size == 0)
 477         data = "" ;
 478
 479      /* DGH - Next two lines added to fix corrupted stack problem */
 480     ENTER ;
 481     SAVETMPS;
 482
 483     PUSHMARK(SP) ;
 484
 485     XPUSHs(sv_2mortal(newSVpv((char*)data,size)));
 486     PUTBACK ;
 487
 488     count = perl_call_sv(CurrentDB->hash, G_SCALAR);
 489
 490     SPAGAIN ;
 491
 492     if (count != 1)
 493         croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
 494
 495     retval = POPi ;
 496
 497     PUTBACK ;
 498     FREETMPS ;
 499     LEAVE ;
 500
 501     return (retval) ;
 502 }
 503
 504
 505 #ifdef TRACE
 506
 507 static void
 508 PrintHash(hash)
 509 INFO * hash ;
 510 {
 511     printf ("HASH Info\n") ;
 512     printf ("  hash      = %s\n",
 513                 (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
 514     printf ("  bsize     = %d\n", hash->db_HA_bsize) ;
 515     printf ("  ffactor   = %d\n", hash->db_HA_ffactor) ;
 516     printf ("  nelem     = %d\n", hash->db_HA_nelem) ;
 517     printf ("  cachesize = %d\n", hash->db_HA_cachesize) ;
 518     printf ("  lorder    = %d\n", hash->db_HA_lorder) ;
 519
 520 }
 521
 522 static void
 523 PrintRecno(recno)
 524 INFO * recno ;
 525 {
 526     printf ("RECNO Info\n") ;
 527     printf ("  flags     = %d\n", recno->db_RE_flags) ;
 528     printf ("  cachesize = %d\n", recno->db_RE_cachesize) ;
 529     printf ("  psize     = %d\n", recno->db_RE_psize) ;
 530     printf ("  lorder    = %d\n", recno->db_RE_lorder) ;
 531     printf ("  reclen    = %ul\n", (unsigned long)recno->db_RE_reclen) ;
 532     printf ("  bval      = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
 533     printf ("  bfname    = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
 534 }
 535
 536 static void
 537 PrintBtree(btree)
 538 INFO * btree ;
 539 {
 540     printf ("BTREE Info\n") ;
 541     printf ("  compare    = %s\n",
 542                 (btree->db_BT_compare ? "redefined" : "default")) ;
 543     printf ("  prefix     = %s\n",
 544                 (btree->db_BT_prefix ? "redefined" : "default")) ;
 545     printf ("  flags      = %d\n", btree->db_BT_flags) ;
 546     printf ("  cachesize  = %d\n", btree->db_BT_cachesize) ;
 547     printf ("  psize      = %d\n", btree->db_BT_psize) ;
 548 #ifndef DB_VERSION_MAJOR
 549     printf ("  maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
 550     printf ("  minkeypage = %d\n", btree->db_BT_minkeypage) ;
 551 #endif
 552     printf ("  lorder     = %d\n", btree->db_BT_lorder) ;
 553 }
 554
 555 #else
 556
 557 #define PrintRecno(recno)
 558 #define PrintHash(hash)
 559 #define PrintBtree(btree)
 560
 561 #endif /* TRACE */
 562
 563
 564 static I32
 565 GetArrayLength(db)
 566 DB_File db ;
 567 {
 568     DBT         key ;
 569     DBT         value ;
 570     int         RETVAL ;
 571
 572     DBT_flags(key) ;
 573     DBT_flags(value) ;
 574     RETVAL = do_SEQ(db, key, value, R_LAST) ;
 575     if (RETVAL == 0)
 576         RETVAL = *(I32 *)key.data ;
 577     else /* No key means empty file */
 578         RETVAL = 0 ;
 579
 580     return ((I32)RETVAL) ;
 581 }
 582
 583 static recno_t
 584 GetRecnoKey(db, value)
 585 DB_File  db ;
 586 I32      value ;
 587 {
 588     if (value < 0) {
 589         /* Get the length of the array */
 590         I32 length = GetArrayLength(db) ;
 591
 592         /* check for attempt to write before start of array */
 593         if (length + value + 1 <= 0)
 594             croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
 595
 596         value = length + value + 1 ;
 597     }
 598     else
 599         ++ value ;
 600
 601     return value ;
 602 }
 603
 604 static DB_File
 605 ParseOpenInfo(isHASH, name, flags, mode, sv)
 606 int    isHASH ;
 607 char * name ;
 608 int    flags ;
 609 int    mode ;
 610 SV *   sv ;
 611 {
 612     SV **       svp;
 613     HV *        action ;
 614     DB_File     RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
 615     void *      openinfo = NULL ;
 616     INFO        * info  = &RETVAL->info ;
 617     STRLEN      n_a;
 618
 619 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ;  */
 620     Zero(RETVAL, 1, DB_File_type) ;
 621
 622     /* Default to HASH */
 623     RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
 624     RETVAL->type = DB_HASH ;
 625
 626      /* DGH - Next line added to avoid SEGV on existing hash DB */
 627     CurrentDB = RETVAL;
 628
 629     /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
 630     RETVAL->in_memory = (name == NULL) ;
 631
 632     if (sv)
 633     {
 634         if (! SvROK(sv) )
 635             croak ("type parameter is not a reference") ;
 636
 637         svp  = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
 638         if (svp && SvOK(*svp))
 639             action  = (HV*) SvRV(*svp) ;
 640         else
 641             croak("internal error") ;
 642
 643         if (sv_isa(sv, "DB_File::HASHINFO"))
 644         {
 645
 646             if (!isHASH)
 647                 croak("DB_File can only tie an associative array to a DB_HASH database") ;
 648
 649             RETVAL->type = DB_HASH ;
 650             openinfo = (void*)info ;
 651
 652             svp = hv_fetch(action, "hash", 4, FALSE);
 653
 654             if (svp && SvOK(*svp))
 655             {
 656                 info->db_HA_hash = hash_cb ;
 657                 RETVAL->hash = newSVsv(*svp) ;
 658             }
 659             else
 660                 info->db_HA_hash = NULL ;
 661
 662            svp = hv_fetch(action, "ffactor", 7, FALSE);
 663            info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
 664
 665            svp = hv_fetch(action, "nelem", 5, FALSE);
 666            info->db_HA_nelem = svp ? SvIV(*svp) : 0;
 667
 668            svp = hv_fetch(action, "bsize", 5, FALSE);
 669            info->db_HA_bsize = svp ? SvIV(*svp) : 0;
 670
 671            svp = hv_fetch(action, "cachesize", 9, FALSE);
 672            info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
 673
 674            svp = hv_fetch(action, "lorder", 6, FALSE);
 675            info->db_HA_lorder = svp ? SvIV(*svp) : 0;
 676
 677            PrintHash(info) ;
 678         }
 679         else if (sv_isa(sv, "DB_File::BTREEINFO"))
 680         {
 681             if (!isHASH)
 682                 croak("DB_File can only tie an associative array to a DB_BTREE database");
 683
 684             RETVAL->type = DB_BTREE ;
 685             openinfo = (void*)info ;
 686
 687             svp = hv_fetch(action, "compare", 7, FALSE);
 688             if (svp && SvOK(*svp))
 689             {
 690                 info->db_BT_compare = btree_compare ;
 691                 RETVAL->compare = newSVsv(*svp) ;
 692             }
 693             else
 694                 info->db_BT_compare = NULL ;
 695
 696             svp = hv_fetch(action, "prefix", 6, FALSE);
 697             if (svp && SvOK(*svp))
 698             {
 699                 info->db_BT_prefix = btree_prefix ;
 700                 RETVAL->prefix = newSVsv(*svp) ;
 701             }
 702             else
 703                 info->db_BT_prefix = NULL ;
 704
 705             svp = hv_fetch(action, "flags", 5, FALSE);
 706             info->db_BT_flags = svp ? SvIV(*svp) : 0;
 707
 708             svp = hv_fetch(action, "cachesize", 9, FALSE);
 709             info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
 710
 711 #ifndef DB_VERSION_MAJOR
 712             svp = hv_fetch(action, "minkeypage", 10, FALSE);
 713             info->btree.minkeypage = svp ? SvIV(*svp) : 0;
 714
 715             svp = hv_fetch(action, "maxkeypage", 10, FALSE);
 716             info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
 717 #endif
 718
 719             svp = hv_fetch(action, "psize", 5, FALSE);
 720             info->db_BT_psize = svp ? SvIV(*svp) : 0;
 721
 722             svp = hv_fetch(action, "lorder", 6, FALSE);
 723             info->db_BT_lorder = svp ? SvIV(*svp) : 0;
 724
 725             PrintBtree(info) ;
 726
 727         }
 728         else if (sv_isa(sv, "DB_File::RECNOINFO"))
 729         {
 730             if (isHASH)
 731                 croak("DB_File can only tie an array to a DB_RECNO database");
 732
 733             RETVAL->type = DB_RECNO ;
 734             openinfo = (void *)info ;
 735
 736             info->db_RE_flags = 0 ;
 737
 738             svp = hv_fetch(action, "flags", 5, FALSE);
 739             info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
 740
 741             svp = hv_fetch(action, "reclen", 6, FALSE);
 742             info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
 743
 744             svp = hv_fetch(action, "cachesize", 9, FALSE);
 745             info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
 746
 747             svp = hv_fetch(action, "psize", 5, FALSE);
 748             info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
 749
 750             svp = hv_fetch(action, "lorder", 6, FALSE);
 751             info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
 752
 753 #ifdef DB_VERSION_MAJOR
 754             info->re_source = name ;
 755             name = NULL ;
 756 #endif
 757             svp = hv_fetch(action, "bfname", 6, FALSE);
 758             if (svp && SvOK(*svp)) {
 759                 char * ptr = SvPV(*svp,n_a) ;
 760 #ifdef DB_VERSION_MAJOR
 761                 name = (char*) n_a ? ptr : NULL ;
 762 #else
 763                 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
 764 #endif
 765             }
 766             else
 767 #ifdef DB_VERSION_MAJOR
 768                 name = NULL ;
 769 #else
 770                 info->db_RE_bfname = NULL ;
 771 #endif
 772
 773             svp = hv_fetch(action, "bval", 4, FALSE);
 774 #ifdef DB_VERSION_MAJOR
 775             if (svp && SvOK(*svp))
 776             {
 777                 int value ;
 778                 if (SvPOK(*svp))
 779                     value = (int)*SvPV(*svp, n_a) ;
 780                 else
 781                     value = SvIV(*svp) ;
 782
 783                 if (info->flags & DB_FIXEDLEN) {
 784                     info->re_pad = value ;
 785                     info->flags |= DB_PAD ;
 786                 }
 787                 else {
 788                     info->re_delim = value ;
 789                     info->flags |= DB_DELIMITER ;
 790                 }
 791
 792             }
 793 #else
 794             if (svp && SvOK(*svp))
 795             {
 796                 if (SvPOK(*svp))
 797                     info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
 798                 else
 799                     info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
 800                 DB_flags(info->flags, DB_DELIMITER) ;
 801
 802             }
 803             else
 804             {
 805                 if (info->db_RE_flags & R_FIXEDLEN)
 806                     info->db_RE_bval = (u_char) ' ' ;
 807                 else
 808                     info->db_RE_bval = (u_char) '\n' ;
 809                 DB_flags(info->flags, DB_DELIMITER) ;
 810             }
 811 #endif
 812
 813 #ifdef DB_RENUMBER
 814             info->flags |= DB_RENUMBER ;
 815 #endif
 816
 817             PrintRecno(info) ;
 818         }
 819         else
 820             croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
 821     }
 822
 823
 824     /* OS2 Specific Code */
 825 #ifdef OS2
 826 #ifdef __EMX__
 827     flags |= O_BINARY;
 828 #endif /* __EMX__ */
 829 #endif /* OS2 */
 830
 831 #ifdef DB_VERSION_MAJOR
 832
 833     {
 834         int             Flags = 0 ;
 835         int             status ;
 836
 837         /* Map 1.x flags to 2.x flags */
 838         if ((flags & O_CREAT) == O_CREAT)
 839             Flags |= DB_CREATE ;
 840
 841 #if O_RDONLY == 0
 842         if (flags == O_RDONLY)
 843 #else
 844         if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
 845 #endif
 846             Flags |= DB_RDONLY ;
 847
 848 #ifdef O_TRUNC
 849         if ((flags & O_TRUNC) == O_TRUNC)
 850             Flags |= DB_TRUNCATE ;
 851 #endif
 852
 853         status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
 854         if (status == 0)
 855 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
 856             status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
 857 #else
 858             status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
 859                         0) ;
 860 #endif
 861
 862         if (status)
 863             RETVAL->dbp = NULL ;
 864
 865     }
 866 #else
 867     RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
 868 #endif
 869
 870     return (RETVAL) ;
 871 }
 872
 873
 874 static int
 875 not_here(s)
 876 char *s;
 877 {
 878     croak("DB_File::%s not implemented on this architecture", s);
 879     return -1;
 880 }
 881
 882 static double
 883 constant(name, arg)
 884 char *name;
 885 int arg;
 886 {
 887     errno = 0;
 888     switch (*name) {
 889     case 'A':
 890         break;
 891     case 'B':
 892         if (strEQ(name, "BTREEMAGIC"))
 893 #ifdef BTREEMAGIC
 894             return BTREEMAGIC;
 895 #else
 896             goto not_there;
 897 #endif
 898         if (strEQ(name, "BTREEVERSION"))
 899 #ifdef BTREEVERSION
 900             return BTREEVERSION;
 901 #else
 902             goto not_there;
 903 #endif
 904         break;
 905     case 'C':
 906         break;
 907     case 'D':
 908         if (strEQ(name, "DB_LOCK"))
 909 #ifdef DB_LOCK
 910             return DB_LOCK;
 911 #else
 912             goto not_there;
 913 #endif
 914         if (strEQ(name, "DB_SHMEM"))
 915 #ifdef DB_SHMEM
 916             return DB_SHMEM;
 917 #else
 918             goto not_there;
 919 #endif
 920         if (strEQ(name, "DB_TXN"))
 921 #ifdef DB_TXN
 922             return (U32)DB_TXN;
 923 #else
 924             goto not_there;
 925 #endif
 926         break;
 927     case 'E':
 928         break;
 929     case 'F':
 930         break;
 931     case 'G':
 932         break;
 933     case 'H':
 934         if (strEQ(name, "HASHMAGIC"))
 935 #ifdef HASHMAGIC
 936             return HASHMAGIC;
 937 #else
 938             goto not_there;
 939 #endif
 940         if (strEQ(name, "HASHVERSION"))
 941 #ifdef HASHVERSION
 942             return HASHVERSION;
 943 #else
 944             goto not_there;
 945 #endif
 946         break;
 947     case 'I':
 948         break;
 949     case 'J':
 950         break;
 951     case 'K':
 952         break;
 953     case 'L':
 954         break;
 955     case 'M':
 956         if (strEQ(name, "MAX_PAGE_NUMBER"))
 957 #ifdef MAX_PAGE_NUMBER
 958             return (U32)MAX_PAGE_NUMBER;
 959 #else
 960             goto not_there;
 961 #endif
 962         if (strEQ(name, "MAX_PAGE_OFFSET"))
 963 #ifdef MAX_PAGE_OFFSET
 964             return MAX_PAGE_OFFSET;
 965 #else
 966             goto not_there;
 967 #endif
 968         if (strEQ(name, "MAX_REC_NUMBER"))
 969 #ifdef MAX_REC_NUMBER
 970             return (U32)MAX_REC_NUMBER;
 971 #else
 972             goto not_there;
 973 #endif
 974         break;
 975     case 'N':
 976         break;
 977     case 'O':
 978         break;
 979     case 'P':
 980         break;
 981     case 'Q':
 982         break;
 983     case 'R':
 984         if (strEQ(name, "RET_ERROR"))
 985 #ifdef RET_ERROR
 986             return RET_ERROR;
 987 #else
 988             goto not_there;
 989 #endif
 990         if (strEQ(name, "RET_SPECIAL"))
 991 #ifdef RET_SPECIAL
 992             return RET_SPECIAL;
 993 #else
 994             goto not_there;
 995 #endif
 996         if (strEQ(name, "RET_SUCCESS"))
 997 #ifdef RET_SUCCESS
 998             return RET_SUCCESS;
 999 #else
1000             goto not_there;
1001 #endif
1002         if (strEQ(name, "R_CURSOR"))
1003 #ifdef R_CURSOR
1004             return R_CURSOR;
1005 #else
1006             goto not_there;
1007 #endif
1008         if (strEQ(name, "R_DUP"))
1009 #ifdef R_DUP
1010             return R_DUP;
1011 #else
1012             goto not_there;
1013 #endif
1014         if (strEQ(name, "R_FIRST"))
1015 #ifdef R_FIRST
1016             return R_FIRST;
1017 #else
1018             goto not_there;
1019 #endif
1020         if (strEQ(name, "R_FIXEDLEN"))
1021 #ifdef R_FIXEDLEN
1022             return R_FIXEDLEN;
1023 #else
1024             goto not_there;
1025 #endif
1026         if (strEQ(name, "R_IAFTER"))
1027 #ifdef R_IAFTER
1028             return R_IAFTER;
1029 #else
1030             goto not_there;
1031 #endif
1032         if (strEQ(name, "R_IBEFORE"))
1033 #ifdef R_IBEFORE
1034             return R_IBEFORE;
1035 #else
1036             goto not_there;
1037 #endif
1038         if (strEQ(name, "R_LAST"))
1039 #ifdef R_LAST
1040             return R_LAST;
1041 #else
1042             goto not_there;
1043 #endif
1044         if (strEQ(name, "R_NEXT"))
1045 #ifdef R_NEXT
1046             return R_NEXT;
1047 #else
1048             goto not_there;
1049 #endif
1050         if (strEQ(name, "R_NOKEY"))
1051 #ifdef R_NOKEY
1052             return R_NOKEY;
1053 #else
1054             goto not_there;
1055 #endif
1056         if (strEQ(name, "R_NOOVERWRITE"))
1057 #ifdef R_NOOVERWRITE
1058             return R_NOOVERWRITE;
1059 #else
1060             goto not_there;
1061 #endif
1062         if (strEQ(name, "R_PREV"))
1063 #ifdef R_PREV
1064             return R_PREV;
1065 #else
1066             goto not_there;
1067 #endif
1068         if (strEQ(name, "R_RECNOSYNC"))
1069 #ifdef R_RECNOSYNC
1070             return R_RECNOSYNC;
1071 #else
1072             goto not_there;
1073 #endif
1074         if (strEQ(name, "R_SETCURSOR"))
1075 #ifdef R_SETCURSOR
1076             return R_SETCURSOR;
1077 #else
1078             goto not_there;
1079 #endif
1080         if (strEQ(name, "R_SNAPSHOT"))
1081 #ifdef R_SNAPSHOT
1082             return R_SNAPSHOT;
1083 #else
1084             goto not_there;
1085 #endif
1086         break;
1087     case 'S':
1088         break;
1089     case 'T':
1090         break;
1091     case 'U':
1092         break;
1093     case 'V':
1094         break;
1095     case 'W':
1096         break;
1097     case 'X':
1098         break;
1099     case 'Y':
1100         break;
1101     case 'Z':
1102         break;
1103     case '_':
1104         break;
1105     }
1106     errno = EINVAL;
1107     return 0;
1108
1109 not_there:
1110     errno = ENOENT;
1111     return 0;
1112 }
1113
1114 MODULE = DB_File        PACKAGE = DB_File       PREFIX = db_
1115
1116 BOOT:
1117   {
1118     GetVersionInfo() ;
1119
1120     empty.data = &zero ;
1121     empty.size =  sizeof(recno_t) ;
1122     DBT_flags(empty) ;
1123   }
1124
1125 double
1126 constant(name,arg)
1127         char *          name
1128         int             arg
1129
1130
1131 DB_File
1132 db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1133         int             isHASH
1134         char *          dbtype
1135         int             flags
1136         int             mode
1137         CODE:
1138         {
1139             char *      name = (char *) NULL ;
1140             SV *        sv = (SV *) NULL ;
1141             STRLEN      n_a;
1142
1143             if (items >= 3 && SvOK(ST(2)))
1144                 name = (char*) SvPV(ST(2), n_a) ;
1145
1146             if (items == 6)
1147                 sv = ST(5) ;
1148
1149             RETVAL = ParseOpenInfo(isHASH, name, flags, mode, sv) ;
1150             if (RETVAL->dbp == NULL)
1151                 RETVAL = NULL ;
1152         }
1153         OUTPUT:
1154             RETVAL
1155
1156 int
1157 db_DESTROY(db)
1158         DB_File         db
1159         INIT:
1160           CurrentDB = db ;
1161         CLEANUP:
1162           if (db->hash)
1163             SvREFCNT_dec(db->hash) ;
1164           if (db->compare)
1165             SvREFCNT_dec(db->compare) ;
1166           if (db->prefix)
1167             SvREFCNT_dec(db->prefix) ;
1168           Safefree(db) ;
1169 #ifdef DB_VERSION_MAJOR
1170           if (RETVAL > 0)
1171             RETVAL = -1 ;
1172 #endif
1173
1174
1175 int
1176 db_DELETE(db, key, flags=0)
1177         DB_File         db
1178         DBTKEY          key
1179         u_int           flags
1180         INIT:
1181           CurrentDB = db ;
1182
1183
1184 int
1185 db_EXISTS(db, key)
1186         DB_File         db
1187         DBTKEY          key
1188         CODE:
1189         {
1190           DBT           value ;
1191
1192           DBT_flags(value) ;
1193           CurrentDB = db ;
1194           RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
1195         }
1196         OUTPUT:
1197           RETVAL
1198
1199 int
1200 db_FETCH(db, key, flags=0)
1201         DB_File         db
1202         DBTKEY          key
1203         u_int           flags
1204         CODE:
1205         {
1206             DBT         value ;
1207
1208             DBT_flags(value) ;
1209             CurrentDB = db ;
1210             /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
1211             RETVAL = db_get(db, key, value, flags) ;
1212             ST(0) = sv_newmortal();
1213             OutputValue(ST(0), value)
1214         }
1215
1216 int
1217 db_STORE(db, key, value, flags=0)
1218         DB_File         db
1219         DBTKEY          key
1220         DBT             value
1221         u_int           flags
1222         INIT:
1223           CurrentDB = db ;
1224
1225
1226 int
1227 db_FIRSTKEY(db)
1228         DB_File         db
1229         CODE:
1230         {
1231             DBTKEY      key ;
1232             DBT         value ;
1233
1234             DBT_flags(key) ;
1235             DBT_flags(value) ;
1236             CurrentDB = db ;
1237             RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1238             ST(0) = sv_newmortal();
1239             OutputKey(ST(0), key) ;
1240         }
1241
1242 int
1243 db_NEXTKEY(db, key)
1244         DB_File         db
1245         DBTKEY          key
1246         CODE:
1247         {
1248             DBT         value ;
1249
1250             DBT_flags(value) ;
1251             CurrentDB = db ;
1252             RETVAL = do_SEQ(db, key, value, R_NEXT) ;
1253             ST(0) = sv_newmortal();
1254             OutputKey(ST(0), key) ;
1255         }
1256
1257 #
1258 # These would be nice for RECNO
1259 #
1260
1261 int
1262 unshift(db, ...)
1263         DB_File         db
1264         ALIAS:          UNSHIFT = 1
1265         CODE:
1266         {
1267             DBTKEY      key ;
1268             DBT         value ;
1269             int         i ;
1270             int         One ;
1271             DB *        Db = db->dbp ;
1272             STRLEN      n_a;
1273
1274             DBT_flags(key) ;
1275             DBT_flags(value) ;
1276             CurrentDB = db ;
1277 #ifdef DB_VERSION_MAJOR
1278             /* get the first value */
1279             RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1280             RETVAL = 0 ;
1281 #else
1282             RETVAL = -1 ;
1283 #endif
1284             for (i = items-1 ; i > 0 ; --i)
1285             {
1286                 value.data = SvPV(ST(i), n_a) ;
1287                 value.size = n_a ;
1288                 One = 1 ;
1289                 key.data = &One ;
1290                 key.size = sizeof(int) ;
1291 #ifdef DB_VERSION_MAJOR
1292                 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1293 #else
1294                 RETVAL = (Db->put)(Db, &key, &value, R_IBEFORE) ;
1295 #endif
1296                 if (RETVAL != 0)
1297                     break;
1298             }
1299         }
1300         OUTPUT:
1301             RETVAL
1302
1303 I32
1304 pop(db)
1305         DB_File         db
1306         ALIAS:          POP = 1
1307         CODE:
1308         {
1309             DBTKEY      key ;
1310             DBT         value ;
1311
1312             DBT_flags(key) ;
1313             DBT_flags(value) ;
1314             CurrentDB = db ;
1315
1316             /* First get the final value */
1317             RETVAL = do_SEQ(db, key, value, R_LAST) ;
1318             ST(0) = sv_newmortal();
1319             /* Now delete it */
1320             if (RETVAL == 0)
1321             {
1322                 /* the call to del will trash value, so take a copy now */
1323                 OutputValue(ST(0), value) ;
1324                 RETVAL = db_del(db, key, R_CURSOR) ;
1325                 if (RETVAL != 0)
1326                     sv_setsv(ST(0), &PL_sv_undef);
1327             }
1328         }
1329
1330 I32
1331 shift(db)
1332         DB_File         db
1333         ALIAS:          SHIFT = 1
1334         CODE:
1335         {
1336             DBT         value ;
1337             DBTKEY      key ;
1338
1339             DBT_flags(key) ;
1340             DBT_flags(value) ;
1341             CurrentDB = db ;
1342             /* get the first value */
1343             RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1344             ST(0) = sv_newmortal();
1345             /* Now delete it */
1346             if (RETVAL == 0)
1347             {
1348                 /* the call to del will trash value, so take a copy now */
1349                 OutputValue(ST(0), value) ;
1350                 RETVAL = db_del(db, key, R_CURSOR) ;
1351                 if (RETVAL != 0)
1352                     sv_setsv (ST(0), &PL_sv_undef) ;
1353             }
1354         }
1355
1356
1357 I32
1358 push(db, ...)
1359         DB_File         db
1360         ALIAS:          PUSH = 1
1361         CODE:
1362         {
1363             DBTKEY      key ;
1364             DBT         value ;
1365             DB *        Db = db->dbp ;
1366             int         i ;
1367             STRLEN      n_a;
1368
1369             DBT_flags(key) ;
1370             DBT_flags(value) ;
1371             CurrentDB = db ;
1372 #ifdef DB_VERSION_MAJOR
1373                 RETVAL = 0 ;
1374                 key = empty ;
1375                 for (i = 1 ; i < items  ; ++i)
1376                 {
1377                     value.data = SvPV(ST(i), n_a) ;
1378                     value.size = n_a ;
1379                     RETVAL = (Db->put)(Db, NULL, &key, &value, DB_APPEND) ;
1380                     if (RETVAL != 0)
1381                         break;
1382                 }
1383 #else
1384             /* Set the Cursor to the Last element */
1385             RETVAL = do_SEQ(db, key, value, R_LAST) ;
1386             if (RETVAL >= 0)
1387             {
1388                 if (RETVAL == 1)
1389                     key = empty ;
1390                 for (i = items - 1 ; i > 0 ; --i)
1391                 {
1392                     value.data = SvPV(ST(i), n_a) ;
1393                     value.size = n_a ;
1394                     RETVAL = (Db->put)(Db, &key, &value, R_IAFTER) ;
1395                     if (RETVAL != 0)
1396                         break;
1397                 }
1398             }
1399 #endif
1400         }
1401         OUTPUT:
1402             RETVAL
1403
1404
1405 I32
1406 length(db)
1407         DB_File         db
1408         ALIAS:          FETCHSIZE = 1
1409         CODE:
1410             CurrentDB = db ;
1411             RETVAL = GetArrayLength(db) ;
1412         OUTPUT:
1413             RETVAL
1414
1415
1416 #
1417 # Now provide an interface to the rest of the DB functionality
1418 #
1419
1420 int
1421 db_del(db, key, flags=0)
1422         DB_File         db
1423         DBTKEY          key
1424         u_int           flags
1425         CODE:
1426           CurrentDB = db ;
1427           RETVAL = db_del(db, key, flags) ;
1428 #ifdef DB_VERSION_MAJOR
1429           if (RETVAL > 0)
1430             RETVAL = -1 ;
1431           else if (RETVAL == DB_NOTFOUND)
1432             RETVAL = 1 ;
1433 #endif
1434         OUTPUT:
1435           RETVAL
1436
1437
1438 int
1439 db_get(db, key, value, flags=0)
1440         DB_File         db
1441         DBTKEY          key
1442         DBT             value = NO_INIT
1443         u_int           flags
1444         CODE:
1445           CurrentDB = db ;
1446           DBT_flags(value) ;
1447           RETVAL = db_get(db, key, value, flags) ;
1448 #ifdef DB_VERSION_MAJOR
1449           if (RETVAL > 0)
1450             RETVAL = -1 ;
1451           else if (RETVAL == DB_NOTFOUND)
1452             RETVAL = 1 ;
1453 #endif
1454         OUTPUT:
1455           RETVAL
1456           value
1457
1458 int
1459 db_put(db, key, value, flags=0)
1460         DB_File         db
1461         DBTKEY          key
1462         DBT             value
1463         u_int           flags
1464         CODE:
1465           CurrentDB = db ;
1466           RETVAL = db_put(db, key, value, flags) ;
1467 #ifdef DB_VERSION_MAJOR
1468           if (RETVAL > 0)
1469             RETVAL = -1 ;
1470           else if (RETVAL == DB_KEYEXIST)
1471             RETVAL = 1 ;
1472 #endif
1473         OUTPUT:
1474           RETVAL
1475           key           if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
1476
1477 int
1478 db_fd(db)
1479         DB_File         db
1480         int             status = 0 ;
1481         CODE:
1482           CurrentDB = db ;
1483 #ifdef DB_VERSION_MAJOR
1484           RETVAL = -1 ;
1485           status = (db->in_memory
1486                 ? -1
1487                 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
1488           if (status != 0)
1489             RETVAL = -1 ;
1490 #else
1491           RETVAL = (db->in_memory
1492                 ? -1
1493                 : ((db->dbp)->fd)(db->dbp) ) ;
1494 #endif
1495         OUTPUT:
1496           RETVAL
1497
1498 int
1499 db_sync(db, flags=0)
1500         DB_File         db
1501         u_int           flags
1502         CODE:
1503           CurrentDB = db ;
1504           RETVAL = db_sync(db, flags) ;
1505 #ifdef DB_VERSION_MAJOR
1506           if (RETVAL > 0)
1507             RETVAL = -1 ;
1508 #endif
1509         OUTPUT:
1510           RETVAL
1511
1512
1513 int
1514 db_seq(db, key, value, flags)
1515         DB_File         db
1516         DBTKEY          key
1517         DBT             value = NO_INIT
1518         u_int           flags
1519         CODE:
1520           CurrentDB = db ;
1521           DBT_flags(value) ;
1522           RETVAL = db_seq(db, key, value, flags);
1523 #ifdef DB_VERSION_MAJOR
1524           if (RETVAL > 0)
1525             RETVAL = -1 ;
1526           else if (RETVAL == DB_NOTFOUND)
1527             RETVAL = 1 ;
1528 #endif
1529         OUTPUT:
1530           RETVAL
1531           key
1532           value
1533