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