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