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