ext/DB_File/DB_File.xs

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