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     STRLEN      n_a;
 597
 598 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ;  */
 599     Zero(RETVAL, 1, DB_File_type) ;
 600
 601     /* Default to HASH */
 602     RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
 603     RETVAL->type = DB_HASH ;
 604
 605      /* DGH - Next line added to avoid SEGV on existing hash DB */
 606     CurrentDB = RETVAL;
 607
 608     /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
 609     RETVAL->in_memory = (name == NULL) ;
 610
 611     if (sv)
 612     {
 613         if (! SvROK(sv) )
 614             croak ("type parameter is not a reference") ;
 615
 616         svp  = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
 617         if (svp && SvOK(*svp))
 618             action  = (HV*) SvRV(*svp) ;
 619         else
 620             croak("internal error") ;
 621
 622         if (sv_isa(sv, "DB_File::HASHINFO"))
 623         {
 624
 625             if (!isHASH)
 626                 croak("DB_File can only tie an associative array to a DB_HASH database") ;
 627
 628             RETVAL->type = DB_HASH ;
 629             openinfo = (void*)info ;
 630
 631             svp = hv_fetch(action, "hash", 4, FALSE);
 632
 633             if (svp && SvOK(*svp))
 634             {
 635                 info->db_HA_hash = hash_cb ;
 636                 RETVAL->hash = newSVsv(*svp) ;
 637             }
 638             else
 639                 info->db_HA_hash = NULL ;
 640
 641            svp = hv_fetch(action, "ffactor", 7, FALSE);
 642            info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
 643
 644            svp = hv_fetch(action, "nelem", 5, FALSE);
 645            info->db_HA_nelem = svp ? SvIV(*svp) : 0;
 646
 647            svp = hv_fetch(action, "bsize", 5, FALSE);
 648            info->db_HA_bsize = svp ? SvIV(*svp) : 0;
 649
 650            svp = hv_fetch(action, "cachesize", 9, FALSE);
 651            info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
 652
 653            svp = hv_fetch(action, "lorder", 6, FALSE);
 654            info->db_HA_lorder = svp ? SvIV(*svp) : 0;
 655
 656            PrintHash(info) ;
 657         }
 658         else if (sv_isa(sv, "DB_File::BTREEINFO"))
 659         {
 660             if (!isHASH)
 661                 croak("DB_File can only tie an associative array to a DB_BTREE database");
 662
 663             RETVAL->type = DB_BTREE ;
 664             openinfo = (void*)info ;
 665
 666             svp = hv_fetch(action, "compare", 7, FALSE);
 667             if (svp && SvOK(*svp))
 668             {
 669                 info->db_BT_compare = btree_compare ;
 670                 RETVAL->compare = newSVsv(*svp) ;
 671             }
 672             else
 673                 info->db_BT_compare = NULL ;
 674
 675             svp = hv_fetch(action, "prefix", 6, FALSE);
 676             if (svp && SvOK(*svp))
 677             {
 678                 info->db_BT_prefix = btree_prefix ;
 679                 RETVAL->prefix = newSVsv(*svp) ;
 680             }
 681             else
 682                 info->db_BT_prefix = NULL ;
 683
 684             svp = hv_fetch(action, "flags", 5, FALSE);
 685             info->db_BT_flags = svp ? SvIV(*svp) : 0;
 686
 687             svp = hv_fetch(action, "cachesize", 9, FALSE);
 688             info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
 689
 690 #ifndef DB_VERSION_MAJOR
 691             svp = hv_fetch(action, "minkeypage", 10, FALSE);
 692             info->btree.minkeypage = svp ? SvIV(*svp) : 0;
 693
 694             svp = hv_fetch(action, "maxkeypage", 10, FALSE);
 695             info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
 696 #endif
 697
 698             svp = hv_fetch(action, "psize", 5, FALSE);
 699             info->db_BT_psize = svp ? SvIV(*svp) : 0;
 700
 701             svp = hv_fetch(action, "lorder", 6, FALSE);
 702             info->db_BT_lorder = svp ? SvIV(*svp) : 0;
 703
 704             PrintBtree(info) ;
 705
 706         }
 707         else if (sv_isa(sv, "DB_File::RECNOINFO"))
 708         {
 709             if (isHASH)
 710                 croak("DB_File can only tie an array to a DB_RECNO database");
 711
 712             RETVAL->type = DB_RECNO ;
 713             openinfo = (void *)info ;
 714
 715             info->db_RE_flags = 0 ;
 716
 717             svp = hv_fetch(action, "flags", 5, FALSE);
 718             info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
 719
 720             svp = hv_fetch(action, "reclen", 6, FALSE);
 721             info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
 722
 723             svp = hv_fetch(action, "cachesize", 9, FALSE);
 724             info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
 725
 726             svp = hv_fetch(action, "psize", 5, FALSE);
 727             info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
 728
 729             svp = hv_fetch(action, "lorder", 6, FALSE);
 730             info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
 731
 732 #ifdef DB_VERSION_MAJOR
 733             info->re_source = name ;
 734             name = NULL ;
 735 #endif
 736             svp = hv_fetch(action, "bfname", 6, FALSE);
 737             if (svp && SvOK(*svp)) {
 738                 char * ptr = SvPV(*svp,n_a) ;
 739 #ifdef DB_VERSION_MAJOR
 740                 name = (char*) n_a ? ptr : NULL ;
 741 #else
 742                 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
 743 #endif
 744             }
 745             else
 746 #ifdef DB_VERSION_MAJOR
 747                 name = NULL ;
 748 #else
 749                 info->db_RE_bfname = NULL ;
 750 #endif
 751
 752             svp = hv_fetch(action, "bval", 4, FALSE);
 753 #ifdef DB_VERSION_MAJOR
 754             if (svp && SvOK(*svp))
 755             {
 756                 int value ;
 757                 if (SvPOK(*svp))
 758                     value = (int)*SvPV(*svp, n_a) ;
 759                 else
 760                     value = SvIV(*svp) ;
 761
 762                 if (info->flags & DB_FIXEDLEN) {
 763                     info->re_pad = value ;
 764                     info->flags |= DB_PAD ;
 765                 }
 766                 else {
 767                     info->re_delim = value ;
 768                     info->flags |= DB_DELIMITER ;
 769                 }
 770
 771             }
 772 #else
 773             if (svp && SvOK(*svp))
 774             {
 775                 if (SvPOK(*svp))
 776                     info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
 777                 else
 778                     info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
 779                 DB_flags(info->flags, DB_DELIMITER) ;
 780
 781             }
 782             else
 783             {
 784                 if (info->db_RE_flags & R_FIXEDLEN)
 785                     info->db_RE_bval = (u_char) ' ' ;
 786                 else
 787                     info->db_RE_bval = (u_char) '\n' ;
 788                 DB_flags(info->flags, DB_DELIMITER) ;
 789             }
 790 #endif
 791
 792 #ifdef DB_RENUMBER
 793             info->flags |= DB_RENUMBER ;
 794 #endif
 795
 796             PrintRecno(info) ;
 797         }
 798         else
 799             croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
 800     }
 801
 802
 803     /* OS2 Specific Code */
 804 #ifdef OS2
 805 #ifdef __EMX__
 806     flags |= O_BINARY;
 807 #endif /* __EMX__ */
 808 #endif /* OS2 */
 809
 810 #ifdef DB_VERSION_MAJOR
 811
 812     {
 813         int             Flags = 0 ;
 814         int             status ;
 815
 816         /* Map 1.x flags to 2.x flags */
 817         if ((flags & O_CREAT) == O_CREAT)
 818             Flags |= DB_CREATE ;
 819
 820 #ifdef O_NONBLOCK
 821         if ((flags & O_NONBLOCK) == O_NONBLOCK)
 822             Flags |= DB_EXCL ;
 823 #endif
 824
 825 #if O_RDONLY == 0
 826         if (flags == O_RDONLY)
 827 #else
 828         if ((flags & O_RDONLY) == O_RDONLY)
 829 #endif
 830             Flags |= DB_RDONLY ;
 831
 832 #ifdef O_NONBLOCK
 833         if ((flags & O_TRUNC) == O_TRUNC)
 834             Flags |= DB_TRUNCATE ;
 835 #endif
 836
 837         status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
 838         if (status == 0)
 839             status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
 840
 841         if (status)
 842             RETVAL->dbp = NULL ;
 843
 844     }
 845 #else
 846     RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
 847 #endif
 848
 849     return (RETVAL) ;
 850 }
 851
 852
 853 static int
 854 not_here(s)
 855 char *s;
 856 {
 857     croak("DB_File::%s not implemented on this architecture", s);
 858     return -1;
 859 }
 860
 861 static double
 862 constant(name, arg)
 863 char *name;
 864 int arg;
 865 {
 866     errno = 0;
 867     switch (*name) {
 868     case 'A':
 869         break;
 870     case 'B':
 871         if (strEQ(name, "BTREEMAGIC"))
 872 #ifdef BTREEMAGIC
 873             return BTREEMAGIC;
 874 #else
 875             goto not_there;
 876 #endif
 877         if (strEQ(name, "BTREEVERSION"))
 878 #ifdef BTREEVERSION
 879             return BTREEVERSION;
 880 #else
 881             goto not_there;
 882 #endif
 883         break;
 884     case 'C':
 885         break;
 886     case 'D':
 887         if (strEQ(name, "DB_LOCK"))
 888 #ifdef DB_LOCK
 889             return DB_LOCK;
 890 #else
 891             goto not_there;
 892 #endif
 893         if (strEQ(name, "DB_SHMEM"))
 894 #ifdef DB_SHMEM
 895             return DB_SHMEM;
 896 #else
 897             goto not_there;
 898 #endif
 899         if (strEQ(name, "DB_TXN"))
 900 #ifdef DB_TXN
 901             return (U32)DB_TXN;
 902 #else
 903             goto not_there;
 904 #endif
 905         break;
 906     case 'E':
 907         break;
 908     case 'F':
 909         break;
 910     case 'G':
 911         break;
 912     case 'H':
 913         if (strEQ(name, "HASHMAGIC"))
 914 #ifdef HASHMAGIC
 915             return HASHMAGIC;
 916 #else
 917             goto not_there;
 918 #endif
 919         if (strEQ(name, "HASHVERSION"))
 920 #ifdef HASHVERSION
 921             return HASHVERSION;
 922 #else
 923             goto not_there;
 924 #endif
 925         break;
 926     case 'I':
 927         break;
 928     case 'J':
 929         break;
 930     case 'K':
 931         break;
 932     case 'L':
 933         break;
 934     case 'M':
 935         if (strEQ(name, "MAX_PAGE_NUMBER"))
 936 #ifdef MAX_PAGE_NUMBER
 937             return (U32)MAX_PAGE_NUMBER;
 938 #else
 939             goto not_there;
 940 #endif
 941         if (strEQ(name, "MAX_PAGE_OFFSET"))
 942 #ifdef MAX_PAGE_OFFSET
 943             return MAX_PAGE_OFFSET;
 944 #else
 945             goto not_there;
 946 #endif
 947         if (strEQ(name, "MAX_REC_NUMBER"))
 948 #ifdef MAX_REC_NUMBER
 949             return (U32)MAX_REC_NUMBER;
 950 #else
 951             goto not_there;
 952 #endif
 953         break;
 954     case 'N':
 955         break;
 956     case 'O':
 957         break;
 958     case 'P':
 959         break;
 960     case 'Q':
 961         break;
 962     case 'R':
 963         if (strEQ(name, "RET_ERROR"))
 964 #ifdef RET_ERROR
 965             return RET_ERROR;
 966 #else
 967             goto not_there;
 968 #endif
 969         if (strEQ(name, "RET_SPECIAL"))
 970 #ifdef RET_SPECIAL
 971             return RET_SPECIAL;
 972 #else
 973             goto not_there;
 974 #endif
 975         if (strEQ(name, "RET_SUCCESS"))
 976 #ifdef RET_SUCCESS
 977             return RET_SUCCESS;
 978 #else
 979             goto not_there;
 980 #endif
 981         if (strEQ(name, "R_CURSOR"))
 982 #ifdef R_CURSOR
 983             return R_CURSOR;
 984 #else
 985             goto not_there;
 986 #endif
 987         if (strEQ(name, "R_DUP"))
 988 #ifdef R_DUP
 989             return R_DUP;
 990 #else
 991             goto not_there;
 992 #endif
 993         if (strEQ(name, "R_FIRST"))
 994 #ifdef R_FIRST
 995             return R_FIRST;
 996 #else
 997             goto not_there;
 998 #endif
 999         if (strEQ(name, "R_FIXEDLEN"))
1000 #ifdef R_FIXEDLEN
1001             return R_FIXEDLEN;
1002 #else
1003             goto not_there;
1004 #endif
1005         if (strEQ(name, "R_IAFTER"))
1006 #ifdef R_IAFTER
1007             return R_IAFTER;
1008 #else
1009             goto not_there;
1010 #endif
1011         if (strEQ(name, "R_IBEFORE"))
1012 #ifdef R_IBEFORE
1013             return R_IBEFORE;
1014 #else
1015             goto not_there;
1016 #endif
1017         if (strEQ(name, "R_LAST"))
1018 #ifdef R_LAST
1019             return R_LAST;
1020 #else
1021             goto not_there;
1022 #endif
1023         if (strEQ(name, "R_NEXT"))
1024 #ifdef R_NEXT
1025             return R_NEXT;
1026 #else
1027             goto not_there;
1028 #endif
1029         if (strEQ(name, "R_NOKEY"))
1030 #ifdef R_NOKEY
1031             return R_NOKEY;
1032 #else
1033             goto not_there;
1034 #endif
1035         if (strEQ(name, "R_NOOVERWRITE"))
1036 #ifdef R_NOOVERWRITE
1037             return R_NOOVERWRITE;
1038 #else
1039             goto not_there;
1040 #endif
1041         if (strEQ(name, "R_PREV"))
1042 #ifdef R_PREV
1043             return R_PREV;
1044 #else
1045             goto not_there;
1046 #endif
1047         if (strEQ(name, "R_RECNOSYNC"))
1048 #ifdef R_RECNOSYNC
1049             return R_RECNOSYNC;
1050 #else
1051             goto not_there;
1052 #endif
1053         if (strEQ(name, "R_SETCURSOR"))
1054 #ifdef R_SETCURSOR
1055             return R_SETCURSOR;
1056 #else
1057             goto not_there;
1058 #endif
1059         if (strEQ(name, "R_SNAPSHOT"))
1060 #ifdef R_SNAPSHOT
1061             return R_SNAPSHOT;
1062 #else
1063             goto not_there;
1064 #endif
1065         break;
1066     case 'S':
1067         break;
1068     case 'T':
1069         break;
1070     case 'U':
1071         break;
1072     case 'V':
1073         break;
1074     case 'W':
1075         break;
1076     case 'X':
1077         break;
1078     case 'Y':
1079         break;
1080     case 'Z':
1081         break;
1082     case '_':
1083         break;
1084     }
1085     errno = EINVAL;
1086     return 0;
1087
1088 not_there:
1089     errno = ENOENT;
1090     return 0;
1091 }
1092
1093 MODULE = DB_File        PACKAGE = DB_File       PREFIX = db_
1094
1095 BOOT:
1096   {
1097     GetVersionInfo() ;
1098
1099     empty.data = &zero ;
1100     empty.size =  sizeof(recno_t) ;
1101     DBT_flags(empty) ;
1102   }
1103
1104 double
1105 constant(name,arg)
1106         char *          name
1107         int             arg
1108
1109
1110 DB_File
1111 db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1112         int             isHASH
1113         char *          dbtype
1114         int             flags
1115         int             mode
1116         CODE:
1117         {
1118             char *      name = (char *) NULL ;
1119             SV *        sv = (SV *) NULL ;
1120             STRLEN      n_a;
1121
1122             if (items >= 3 && SvOK(ST(2)))
1123                 name = (char*) SvPV(ST(2), n_a) ;
1124
1125             if (items == 6)
1126                 sv = ST(5) ;
1127
1128             RETVAL = ParseOpenInfo(isHASH, name, flags, mode, sv) ;
1129             if (RETVAL->dbp == NULL)
1130                 RETVAL = NULL ;
1131         }
1132         OUTPUT:
1133             RETVAL
1134
1135 int
1136 db_DESTROY(db)
1137         DB_File         db
1138         INIT:
1139           CurrentDB = db ;
1140         CLEANUP:
1141           if (db->hash)
1142             SvREFCNT_dec(db->hash) ;
1143           if (db->compare)
1144             SvREFCNT_dec(db->compare) ;
1145           if (db->prefix)
1146             SvREFCNT_dec(db->prefix) ;
1147           Safefree(db) ;
1148 #ifdef DB_VERSION_MAJOR
1149           if (RETVAL > 0)
1150             RETVAL = -1 ;
1151 #endif
1152
1153
1154 int
1155 db_DELETE(db, key, flags=0)
1156         DB_File         db
1157         DBTKEY          key
1158         u_int           flags
1159         INIT:
1160           CurrentDB = db ;
1161
1162
1163 int
1164 db_EXISTS(db, key)
1165         DB_File         db
1166         DBTKEY          key
1167         CODE:
1168         {
1169           DBT           value ;
1170
1171           DBT_flags(value) ;
1172           CurrentDB = db ;
1173           RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
1174         }
1175         OUTPUT:
1176           RETVAL
1177
1178 int
1179 db_FETCH(db, key, flags=0)
1180         DB_File         db
1181         DBTKEY          key
1182         u_int           flags
1183         CODE:
1184         {
1185             DBT         value ;
1186
1187             DBT_flags(value) ;
1188             CurrentDB = db ;
1189             /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
1190             RETVAL = db_get(db, key, value, flags) ;
1191             ST(0) = sv_newmortal();
1192             OutputValue(ST(0), value)
1193         }
1194
1195 int
1196 db_STORE(db, key, value, flags=0)
1197         DB_File         db
1198         DBTKEY          key
1199         DBT             value
1200         u_int           flags
1201         INIT:
1202           CurrentDB = db ;
1203
1204
1205 int
1206 db_FIRSTKEY(db)
1207         DB_File         db
1208         CODE:
1209         {
1210             DBTKEY      key ;
1211             DBT         value ;
1212             DB *        Db = db->dbp ;
1213
1214             DBT_flags(key) ;
1215             DBT_flags(value) ;
1216             CurrentDB = db ;
1217             RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1218             ST(0) = sv_newmortal();
1219             OutputKey(ST(0), key) ;
1220         }
1221
1222 int
1223 db_NEXTKEY(db, key)
1224         DB_File         db
1225         DBTKEY          key
1226         CODE:
1227         {
1228             DBT         value ;
1229             DB *        Db = db->dbp ;
1230
1231             DBT_flags(value) ;
1232             CurrentDB = db ;
1233             RETVAL = do_SEQ(db, key, value, R_NEXT) ;
1234             ST(0) = sv_newmortal();
1235             OutputKey(ST(0), key) ;
1236         }
1237
1238 #
1239 # These would be nice for RECNO
1240 #
1241
1242 int
1243 unshift(db, ...)
1244         DB_File         db
1245         ALIAS:          UNSHIFT = 1
1246         CODE:
1247         {
1248             DBTKEY      key ;
1249             DBT         value ;
1250             int         i ;
1251             int         One ;
1252             DB *        Db = db->dbp ;
1253             STRLEN      n_a;
1254
1255             DBT_flags(key) ;
1256             DBT_flags(value) ;
1257             CurrentDB = db ;
1258 #ifdef DB_VERSION_MAJOR
1259             /* get the first value */
1260             RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1261             RETVAL = 0 ;
1262 #else
1263             RETVAL = -1 ;
1264 #endif
1265             for (i = items-1 ; i > 0 ; --i)
1266             {
1267                 value.data = SvPV(ST(i), n_a) ;
1268                 value.size = n_a ;
1269                 One = 1 ;
1270                 key.data = &One ;
1271                 key.size = sizeof(int) ;
1272 #ifdef DB_VERSION_MAJOR
1273                 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1274 #else
1275                 RETVAL = (Db->put)(Db, &key, &value, R_IBEFORE) ;
1276 #endif
1277                 if (RETVAL != 0)
1278                     break;
1279             }
1280         }
1281         OUTPUT:
1282             RETVAL
1283
1284 I32
1285 pop(db)
1286         DB_File         db
1287         ALIAS:          POP = 1
1288         CODE:
1289         {
1290             DBTKEY      key ;
1291             DBT         value ;
1292             DB *        Db = db->dbp ;
1293
1294             DBT_flags(key) ;
1295             DBT_flags(value) ;
1296             CurrentDB = db ;
1297
1298             /* First get the final value */
1299             RETVAL = do_SEQ(db, key, value, R_LAST) ;
1300             ST(0) = sv_newmortal();
1301             /* Now delete it */
1302             if (RETVAL == 0)
1303             {
1304                 /* the call to del will trash value, so take a copy now */
1305                 OutputValue(ST(0), value) ;
1306                 RETVAL = db_del(db, key, R_CURSOR) ;
1307                 if (RETVAL != 0)
1308                     sv_setsv(ST(0), &PL_sv_undef);
1309             }
1310         }
1311
1312 I32
1313 shift(db)
1314         DB_File         db
1315         ALIAS:          SHIFT = 1
1316         CODE:
1317         {
1318             DBT         value ;
1319             DBTKEY      key ;
1320             DB *        Db = db->dbp ;
1321
1322             DBT_flags(key) ;
1323             DBT_flags(value) ;
1324             CurrentDB = db ;
1325             /* get the first value */
1326             RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1327             ST(0) = sv_newmortal();
1328             /* Now delete it */
1329             if (RETVAL == 0)
1330             {
1331                 /* the call to del will trash value, so take a copy now */
1332                 OutputValue(ST(0), value) ;
1333                 RETVAL = db_del(db, key, R_CURSOR) ;
1334                 if (RETVAL != 0)
1335                     sv_setsv (ST(0), &PL_sv_undef) ;
1336             }
1337         }
1338
1339
1340 I32
1341 push(db, ...)
1342         DB_File         db
1343         ALIAS:          PUSH = 1
1344         CODE:
1345         {
1346             DBTKEY      key ;
1347             DBTKEY *    keyptr = &key ;
1348             DBT         value ;
1349             DB *        Db = db->dbp ;
1350             int         i ;
1351             STRLEN      n_a;
1352
1353             DBT_flags(key) ;
1354             DBT_flags(value) ;
1355             CurrentDB = db ;
1356             /* Set the Cursor to the Last element */
1357             RETVAL = do_SEQ(db, key, value, R_LAST) ;
1358             if (RETVAL >= 0)
1359             {
1360                 if (RETVAL == 1)
1361                     keyptr = &empty ;
1362 #ifdef DB_VERSION_MAJOR
1363                 for (i = 1 ; i < items  ; ++i)
1364                 {
1365
1366                     ++ (* (int*)key.data) ;
1367                     value.data = SvPV(ST(i), n_a) ;
1368                     value.size = n_a ;
1369                     RETVAL = (Db->put)(Db, NULL, &key, &value, 0) ;
1370                     if (RETVAL != 0)
1371                         break;
1372                 }
1373 #else
1374                 for (i = items - 1 ; i > 0 ; --i)
1375                 {
1376                     value.data = SvPV(ST(i), n_a) ;
1377                     value.size = n_a ;
1378                     RETVAL = (Db->put)(Db, keyptr, &value, R_IAFTER) ;
1379                     if (RETVAL != 0)
1380                         break;
1381                 }
1382 #endif
1383             }
1384         }
1385         OUTPUT:
1386             RETVAL
1387
1388
1389 I32
1390 length(db)
1391         DB_File         db
1392         ALIAS:          FETCHSIZE = 1
1393         CODE:
1394             CurrentDB = db ;
1395             RETVAL = GetArrayLength(db) ;
1396         OUTPUT:
1397             RETVAL
1398
1399
1400 #
1401 # Now provide an interface to the rest of the DB functionality
1402 #
1403
1404 int
1405 db_del(db, key, flags=0)
1406         DB_File         db
1407         DBTKEY          key
1408         u_int           flags
1409         CODE:
1410           CurrentDB = db ;
1411           RETVAL = db_del(db, key, flags) ;
1412 #ifdef DB_VERSION_MAJOR
1413           if (RETVAL > 0)
1414             RETVAL = -1 ;
1415           else if (RETVAL == DB_NOTFOUND)
1416             RETVAL = 1 ;
1417 #endif
1418         OUTPUT:
1419           RETVAL
1420
1421
1422 int
1423 db_get(db, key, value, flags=0)
1424         DB_File         db
1425         DBTKEY          key
1426         DBT             value = NO_INIT
1427         u_int           flags
1428         CODE:
1429           CurrentDB = db ;
1430           DBT_flags(value) ;
1431           RETVAL = db_get(db, key, value, flags) ;
1432 #ifdef DB_VERSION_MAJOR
1433           if (RETVAL > 0)
1434             RETVAL = -1 ;
1435           else if (RETVAL == DB_NOTFOUND)
1436             RETVAL = 1 ;
1437 #endif
1438         OUTPUT:
1439           RETVAL
1440           value
1441
1442 int
1443 db_put(db, key, value, flags=0)
1444         DB_File         db
1445         DBTKEY          key
1446         DBT             value
1447         u_int           flags
1448         CODE:
1449           CurrentDB = db ;
1450           RETVAL = db_put(db, key, value, flags) ;
1451 #ifdef DB_VERSION_MAJOR
1452           if (RETVAL > 0)
1453             RETVAL = -1 ;
1454           else if (RETVAL == DB_KEYEXIST)
1455             RETVAL = 1 ;
1456 #endif
1457         OUTPUT:
1458           RETVAL
1459           key           if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
1460
1461 int
1462 db_fd(db)
1463         DB_File         db
1464         int             status = 0 ;
1465         CODE:
1466           CurrentDB = db ;
1467 #ifdef DB_VERSION_MAJOR
1468           RETVAL = -1 ;
1469           status = (db->in_memory
1470                 ? -1
1471                 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
1472           if (status != 0)
1473             RETVAL = -1 ;
1474 #else
1475           RETVAL = (db->in_memory
1476                 ? -1
1477                 : ((db->dbp)->fd)(db->dbp) ) ;
1478 #endif
1479         OUTPUT:
1480           RETVAL
1481
1482 int
1483 db_sync(db, flags=0)
1484         DB_File         db
1485         u_int           flags
1486         CODE:
1487           CurrentDB = db ;
1488           RETVAL = db_sync(db, flags) ;
1489 #ifdef DB_VERSION_MAJOR
1490           if (RETVAL > 0)
1491             RETVAL = -1 ;
1492 #endif
1493         OUTPUT:
1494           RETVAL
1495
1496
1497 int
1498 db_seq(db, key, value, flags)
1499         DB_File         db
1500         DBTKEY          key
1501         DBT             value = NO_INIT
1502         u_int           flags
1503         CODE:
1504           CurrentDB = db ;
1505           DBT_flags(value) ;
1506           RETVAL = db_seq(db, key, value, flags);
1507 #ifdef DB_VERSION_MAJOR
1508           if (RETVAL > 0)
1509             RETVAL = -1 ;
1510           else if (RETVAL == DB_NOTFOUND)
1511             RETVAL = 1 ;
1512 #endif
1513         OUTPUT:
1514           RETVAL
1515           key
1516           value
1517