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