ext/DB_File/DB_File.xs

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