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