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