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