cpan/DB_File/DB_File.xs

   1 /*
   2
   3  DB_File.xs -- Perl 5 interface to Berkeley DB
   4
   5  Written by Paul Marquess <pmqs@cpan.org>
   6
   7  All comments/suggestions/problems are welcome
   8
   9      Copyright (c) 1995-2020 Paul Marquess. All rights reserved.
  10      This program is free software; you can redistribute it and/or
  11      modify it under the same terms as Perl itself.
  12
  13  Changes:
  14     0.1 -   Initial Release
  15     0.2 -   No longer bombs out if dbopen returns an error.
  16     0.3 -   Added some support for multiple btree compares
  17     1.0 -   Complete support for multiple callbacks added.
  18             Fixed a problem with pushing a value onto an empty list.
  19     1.01 -  Fixed a SunOS core dump problem.
  20             The return value from TIEHASH wasn't set to NULL when
  21             dbopen returned an error.
  22     1.02 -  Use ALIAS to define TIEARRAY.
  23             Removed some redundant commented code.
  24             Merged OS2 code into the main distribution.
  25             Allow negative subscripts with RECNO interface.
  26             Changed the default flags to O_CREAT|O_RDWR
  27     1.03 -  Added EXISTS
  28     1.04 -  fixed a couple of bugs in hash_cb. Patches supplied by
  29             Dave Hammen, hammen@gothamcity.jsc.nasa.gov
  30     1.05 -  Added logic to allow prefix & hash types to be specified via
  31             Makefile.PL
  32     1.06 -  Minor namespace cleanup: Localized PrintBtree.
  33     1.07 -  Fixed bug with RECNO, where bval wasn't defaulting to "\n".
  34     1.08 -  No change to DB_File.xs
  35     1.09 -  Default mode for dbopen changed to 0666
  36     1.10 -  Fixed fd method so that it still returns -1 for
  37             in-memory files when db 1.86 is used.
  38     1.11 -  No change to DB_File.xs
  39     1.12 -  No change to DB_File.xs
  40     1.13 -  Tidied up a few casts.
  41     1.14 -  Made it illegal to tie an associative array to a RECNO
  42             database and an ordinary array to a HASH or BTREE database.
  43     1.50 -  Make work with both DB 1.x or DB 2.x
  44     1.51 -  Fixed a bug in mapping 1.x O_RDONLY flag to 2.x DB_RDONLY equivalent
  45     1.52 -  Patch from Gisle Aas <gisle@aas.no> to suppress "use of
  46             undefined value" warning with db_get and db_seq.
  47     1.53 -  Added DB_RENUMBER to flags for recno.
  48     1.54 -  Fixed bug in the fd method
  49     1.55 -  Fix for AIX from Jarkko Hietaniemi
  50     1.56 -  No change to DB_File.xs
  51     1.57 -  added the #undef op to allow building with Threads support.
  52     1.58 -  Fixed a problem with the use of sv_setpvn. When the
  53             size is specified as 0, it does a strlen on the data.
  54             This was ok for DB 1.x, but isn't for DB 2.x.
  55     1.59 -  No change to DB_File.xs
  56     1.60 -  Some code tidy up
  57     1.61 -  added flagSet macro for DB 2.5.x
  58             fixed typo in O_RDONLY test.
  59     1.62 -  No change to DB_File.xs
  60     1.63 -  Fix to alllow DB 2.6.x to build.
  61     1.64 -  Tidied up the 1.x to 2.x flags mapping code.
  62             Added a patch from Mark Kettenis <kettenis@wins.uva.nl>
  63             to fix a flag mapping problem with O_RDONLY on the Hurd
  64     1.65 -  Fixed a bug in the PUSH logic.
  65             Added BOOT check that using 2.3.4 or greater
  66     1.66 -  Added DBM filter code
  67     1.67 -  Backed off the use of newSVpvn.
  68             Fixed DBM Filter code for Perl 5.004.
  69             Fixed a small memory leak in the filter code.
  70     1.68 -  fixed backward compatibility bug with R_IAFTER & R_IBEFORE
  71             merged in the 5.005_58 changes
  72     1.69 -  fixed a bug in push -- DB_APPEND wasn't working properly.
  73             Fixed the R_SETCURSOR bug introduced in 1.68
  74             Added a new Perl variable $DB_File::db_ver
  75     1.70 -  Initialise $DB_File::db_ver and $DB_File::db_version with
  76             GV_ADD|GV_ADDMULT -- bug spotted by Nick Ing-Simmons.
  77             Added a BOOT check to test for equivalent versions of db.h &
  78             libdb.a/so.
  79     1.71 -  Support for Berkeley DB version 3.
  80             Support for Berkeley DB 2/3's backward compatibility mode.
  81             Rewrote push
  82     1.72 -  No change to DB_File.xs
  83     1.73 -  No change to DB_File.xs
  84     1.74 -  A call to open needed parenthesised to stop it clashing
  85             with a win32 macro.
  86             Added Perl core patches 7703 & 7801.
  87     1.75 -  Fixed Perl core patch 7703.
  88             Added support to allow DB_File to be built with
  89             Berkeley DB 3.2 -- btree_compare, btree_prefix and hash_cb
  90             needed to be changed.
  91     1.76 -  No change to DB_File.xs
  92     1.77 -  Tidied up a few types used in calling newSVpvn.
  93     1.78 -  Core patch 10335, 10372, 10534, 10549, 11051 included.
  94     1.79 -  NEXTKEY ignores the input key.
  95             Added lots of casts
  96     1.800 - Moved backward compatibility code into ppport.h.
  97             Use the new constants code.
  98     1.801 - No change to DB_File.xs
  99     1.802 - No change to DB_File.xs
 100     1.803 - FETCH, STORE & DELETE don't map the flags parameter
 101             into the equivalent Berkeley DB function anymore.
 102     1.804 - no change.
 103     1.805 - recursion detection added to the callbacks
 104             Support for 4.1.X added.
 105             Filter code can now cope with read-only $_
 106     1.806 - recursion detection beefed up.
 107     1.807 - no change
 108     1.808 - leak fixed in ParseOpenInfo
 109     1.809 - no change
 110     1.810 - no change
 111     1.811 - no change
 112     1.812 - no change
 113     1.813 - no change
 114     1.814 - no change
 115     1.814 - C++ casting fixes
 116
 117 */
 118
 119 #define PERL_NO_GET_CONTEXT
 120 #include "EXTERN.h"
 121 #include "perl.h"
 122 #include "XSUB.h"
 123
 124 #ifdef _NOT_CORE
 125 #  include "ppport.h"
 126 #endif
 127
 128 int DB_File___unused() { return 0; }
 129
 130 /* Mention DB_VERSION_MAJOR_CFG, DB_VERSION_MINOR_CFG, and
 131    DB_VERSION_PATCH_CFG here so that Configure pulls them all in. */
 132
 133 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
 134  * shortly #included by the <db.h>) __attribute__ to the possibly
 135  * already defined __attribute__, for example by GNUC or by Perl. */
 136
 137 /* #if DB_VERSION_MAJOR_CFG < 2  */
 138 #ifndef DB_VERSION_MAJOR
 139 #    undef __attribute__
 140 #endif
 141
 142 #ifdef COMPAT185
 143 #    include <db_185.h>
 144 #else
 145
 146 /* Uncomment one of the lines below */
 147 /* See the section "At least one secondary cursor must be specified to DB->join"
 148    in the README file for the circumstances where you need to uncomment one
 149    of the two lines below.
 150 */
 151
 152 /* #define time_t __time64_t */
 153 /* #define time_t __time32_t */
 154
 155 #    include <db.h>
 156 #endif
 157
 158 #ifndef PERL_UNUSED_ARG
 159 #  define PERL_UNUSED_ARG(x) ((void)x)
 160 #endif
 161
 162 /* Wall starts with 5.7.x */
 163
 164 #if PERL_REVISION > 5 || (PERL_REVISION == 5 && PERL_VERSION >= 7)
 165
 166 /* Since we dropped the gccish definition of __attribute__ we will want
 167  * to redefine dNOOP, however (so that dTHX continues to work).  Yes,
 168  * all this means that we can't do attribute checking on the DB_File,
 169  * boo, hiss. */
 170 #  ifndef DB_VERSION_MAJOR
 171
 172 #    undef  dNOOP
 173 #    ifdef __cplusplus
 174 #        define dNOOP (void)0
 175 #    else
 176 #        define dNOOP extern int DB_File___notused()
 177 #    endif
 178
 179     /* Ditto for dXSARGS. */
 180 #    undef  dXSARGS
 181 #    define dXSARGS             \
 182     dSP; dMARK;         \
 183     I32 ax = mark - PL_stack_base + 1;  \
 184     I32 items = sp - mark
 185
 186 #  endif
 187
 188 /* avoid -Wall; DB_File xsubs never make use of `ix' setup for ALIASes */
 189 #  undef dXSI32
 190 #  define dXSI32 dNOOP
 191
 192 #endif /* Perl >= 5.7 */
 193
 194 #include <fcntl.h>
 195
 196 /* #define TRACE */
 197
 198 #ifdef TRACE
 199 #    define Trace(x)        printf x
 200 #else
 201 #    define Trace(x)
 202 #endif
 203
 204
 205 #define DBT_clear(x)    Zero(&x, 1, DBT) ;
 206
 207 #ifdef DB_VERSION_MAJOR
 208
 209 #if DB_VERSION_MAJOR == 2
 210 #    define BERKELEY_DB_1_OR_2
 211 #endif
 212
 213 #if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 2)
 214 #    define AT_LEAST_DB_3_2
 215 #endif
 216
 217 #if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 3)
 218 #    define AT_LEAST_DB_3_3
 219 #endif
 220
 221 #if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 1)
 222 #    define AT_LEAST_DB_4_1
 223 #endif
 224
 225 #if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 3)
 226 #    define AT_LEAST_DB_4_3
 227 #endif
 228
 229 #if DB_VERSION_MAJOR >= 6
 230 #    define AT_LEAST_DB_6_0
 231 #endif
 232
 233 #ifdef AT_LEAST_DB_3_3
 234 #   define WANT_ERROR
 235 #endif
 236
 237 /* map version 2 features & constants onto their version 1 equivalent */
 238
 239 #ifdef DB_Prefix_t
 240 #    undef DB_Prefix_t
 241 #endif
 242 #define DB_Prefix_t size_t
 243
 244 #ifdef DB_Hash_t
 245 #    undef DB_Hash_t
 246 #endif
 247 #define DB_Hash_t   u_int32_t
 248
 249 /* DBTYPE stays the same */
 250 /* HASHINFO, RECNOINFO and BTREEINFO  map to DB_INFO */
 251 #if DB_VERSION_MAJOR == 2
 252     typedef DB_INFO INFO ;
 253 #else /* DB_VERSION_MAJOR > 2 */
 254 #    define DB_FIXEDLEN (0x8000)
 255 #endif /* DB_VERSION_MAJOR == 2 */
 256
 257 /* version 2 has db_recno_t in place of recno_t */
 258 typedef db_recno_t  recno_t;
 259
 260
 261 #define R_CURSOR        DB_SET_RANGE
 262 #define R_FIRST         DB_FIRST
 263 #define R_IAFTER        DB_AFTER
 264 #define R_IBEFORE       DB_BEFORE
 265 #define R_LAST          DB_LAST
 266 #define R_NEXT          DB_NEXT
 267 #define R_NOOVERWRITE   DB_NOOVERWRITE
 268 #define R_PREV          DB_PREV
 269
 270 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
 271 #  define R_SETCURSOR   0x800000
 272 #else
 273 #  define R_SETCURSOR   (DB_OPFLAGS_MASK)
 274 #endif
 275
 276 #define R_RECNOSYNC     0
 277 #define R_FIXEDLEN  DB_FIXEDLEN
 278 #define R_DUP       DB_DUP
 279
 280
 281 #define db_HA_hash  h_hash
 282 #define db_HA_ffactor   h_ffactor
 283 #define db_HA_nelem h_nelem
 284 #define db_HA_bsize db_pagesize
 285 #define db_HA_cachesize db_cachesize
 286 #define db_HA_lorder    db_lorder
 287
 288 #define db_BT_compare   bt_compare
 289 #define db_BT_prefix    bt_prefix
 290 #define db_BT_flags flags
 291 #define db_BT_psize db_pagesize
 292 #define db_BT_cachesize db_cachesize
 293 #define db_BT_lorder    db_lorder
 294 #define db_BT_maxkeypage
 295 #define db_BT_minkeypage
 296
 297
 298 #define db_RE_reclen    re_len
 299 #define db_RE_flags flags
 300 #define db_RE_bval  re_pad
 301 #define db_RE_bfname    re_source
 302 #define db_RE_psize db_pagesize
 303 #define db_RE_cachesize db_cachesize
 304 #define db_RE_lorder    db_lorder
 305
 306 #define TXN NULL,
 307
 308 #define do_SEQ(db, key, value, flag)    (db->cursor->c_get)(db->cursor, &key, &value, flag)
 309
 310
 311 #define DBT_flags(x)    x.flags = 0
 312 #define DB_flags(x, v)  x |= v
 313
 314 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
 315 #    define flagSet(flags, bitmask) ((flags) & (bitmask))
 316 #else
 317 #    define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (u_int)(bitmask))
 318 #endif
 319
 320 #else /* db version 1.x */
 321
 322 #define BERKELEY_DB_1
 323 #define BERKELEY_DB_1_OR_2
 324
 325 typedef union INFO {
 326         HASHINFO    hash ;
 327         RECNOINFO   recno ;
 328         BTREEINFO   btree ;
 329       } INFO ;
 330
 331
 332 #ifdef mDB_Prefix_t
 333 #  ifdef DB_Prefix_t
 334 #    undef DB_Prefix_t
 335 #  endif
 336 #  define DB_Prefix_t   mDB_Prefix_t
 337 #endif
 338
 339 #ifdef mDB_Hash_t
 340 #  ifdef DB_Hash_t
 341 #    undef DB_Hash_t
 342 #  endif
 343 #  define DB_Hash_t mDB_Hash_t
 344 #endif
 345
 346 #define db_HA_hash  hash.hash
 347 #define db_HA_ffactor   hash.ffactor
 348 #define db_HA_nelem hash.nelem
 349 #define db_HA_bsize hash.bsize
 350 #define db_HA_cachesize hash.cachesize
 351 #define db_HA_lorder    hash.lorder
 352
 353 #define db_BT_compare   btree.compare
 354 #define db_BT_prefix    btree.prefix
 355 #define db_BT_flags btree.flags
 356 #define db_BT_psize btree.psize
 357 #define db_BT_cachesize btree.cachesize
 358 #define db_BT_lorder    btree.lorder
 359 #define db_BT_maxkeypage btree.maxkeypage
 360 #define db_BT_minkeypage btree.minkeypage
 361
 362 #define db_RE_reclen    recno.reclen
 363 #define db_RE_flags recno.flags
 364 #define db_RE_bval  recno.bval
 365 #define db_RE_bfname    recno.bfname
 366 #define db_RE_psize recno.psize
 367 #define db_RE_cachesize recno.cachesize
 368 #define db_RE_lorder    recno.lorder
 369
 370 #define TXN
 371
 372 #define do_SEQ(db, key, value, flag)    (db->dbp->seq)(db->dbp, &key, &value, flag)
 373 #define DBT_flags(x)
 374 #define DB_flags(x, v)
 375 #define flagSet(flags, bitmask)        ((flags) & (bitmask))
 376
 377 #endif /* db version 1 */
 378
 379
 380
 381 #define db_DELETE(db, key, flags)       ((db->dbp)->del)(db->dbp, TXN &key, 0)
 382 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, 0)
 383 #define db_FETCH(db, key, flags)        ((db->dbp)->get)(db->dbp, TXN &key, &value, 0)
 384
 385 #define db_sync(db, flags)              ((db->dbp)->sync)(db->dbp, flags)
 386 #define db_get(db, key, value, flags)   ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
 387
 388 #ifdef DB_VERSION_MAJOR
 389 #define db_DESTROY(db)                  (!db->aborted && ( db->cursor->c_close(db->cursor),\
 390                       (db->dbp->close)(db->dbp, 0) ))
 391 #define db_close(db)            ((db->dbp)->close)(db->dbp, 0)
 392 #define db_del(db, key, flags)          (flagSet(flags, R_CURSOR)                   \
 393                         ? ((db->cursor)->c_del)(db->cursor, 0)      \
 394                         : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
 395
 396 #else /* ! DB_VERSION_MAJOR */
 397
 398 #define db_DESTROY(db)                  (!db->aborted && ((db->dbp)->close)(db->dbp))
 399 #define db_close(db)            ((db->dbp)->close)(db->dbp)
 400 #define db_del(db, key, flags)          ((db->dbp)->del)(db->dbp, &key, flags)
 401 #define db_put(db, key, value, flags)   ((db->dbp)->put)(db->dbp, &key, &value, flags)
 402
 403 #endif /* ! DB_VERSION_MAJOR */
 404
 405
 406 #define db_seq(db, key, value, flags)   do_SEQ(db, key, value, flags)
 407
 408 typedef struct {
 409     DBTYPE  type ;
 410     DB *    dbp ;
 411     SV *    compare ;
 412     bool    in_compare ;
 413     SV *    prefix ;
 414     bool    in_prefix ;
 415     SV *    hash ;
 416     bool    in_hash ;
 417     bool    aborted ;
 418     int in_memory ;
 419 #ifdef BERKELEY_DB_1_OR_2
 420     INFO    info ;
 421 #endif
 422 #ifdef DB_VERSION_MAJOR
 423     DBC *   cursor ;
 424 #endif
 425     SV *    filter_fetch_key ;
 426     SV *    filter_store_key ;
 427     SV *    filter_fetch_value ;
 428     SV *    filter_store_value ;
 429     int     filtering ;
 430
 431     } DB_File_type;
 432
 433 typedef DB_File_type * DB_File ;
 434 typedef DBT DBTKEY ;
 435
 436 #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (const char *)""), s)
 437
 438 #define OutputValue(arg, name)                                              \
 439     { if (RETVAL == 0) {                                                    \
 440           SvGETMAGIC(arg) ;                                                 \
 441           my_sv_setpvn(arg, (const char *)name.data, name.size) ;           \
 442           TAINT;                                                            \
 443           SvTAINTED_on(arg);                                                \
 444           SvUTF8_off(arg);                                                  \
 445           DBM_ckFilter(arg, filter_fetch_value,"filter_fetch_value") ;      \
 446       }                                                                     \
 447     }
 448
 449 #define OutputKey(arg, name)                                          \
 450     { if (RETVAL == 0)                                                \
 451       {                                                               \
 452           SvGETMAGIC(arg) ;                                           \
 453           if (db->type != DB_RECNO) {                                 \
 454               my_sv_setpvn(arg, (const char *)name.data, name.size);  \
 455           }                                                           \
 456           else                                                        \
 457               sv_setiv(arg, (I32)*(I32*)name.data - 1);               \
 458           TAINT;                                                      \
 459           SvTAINTED_on(arg);                                          \
 460           SvUTF8_off(arg);                                            \
 461           DBM_ckFilter(arg, filter_fetch_key,"filter_fetch_key") ;    \
 462       }                                                               \
 463     }
 464
 465 /* Macro err_close only for use in croak_and_free */
 466 #ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1  or 2 */
 467 #  define err_close(r)
 468 #else
 469 #  define err_close(r) db_close(r)
 470 #endif
 471
 472 /* Macro croak_and_free only for use in ParseOpenInfo */
 473 #define croak_and_free(x)                                             \
 474     do                                                                \
 475     {                                                                 \
 476         if (RETVAL->dbp) err_close(RETVAL) ;                           \
 477         Safefree(RETVAL);                                             \
 478         croak(x);                                                     \
 479     } while (0)
 480
 481 #define my_SvUV32(sv) ((u_int32_t)SvUV(sv))
 482
 483 #ifdef CAN_PROTOTYPE
 484 extern void __getBerkeleyDBInfo(void);
 485 #endif
 486
 487 /* Internal Global Data */
 488
 489 #define MY_CXT_KEY "DB_File::_guts" XS_VERSION
 490
 491 typedef struct {
 492     recno_t x_Value;
 493     recno_t x_zero;
 494     DB_File x_CurrentDB;
 495     DBTKEY  x_empty;
 496 } my_cxt_t;
 497
 498 START_MY_CXT
 499
 500 #define Value       (MY_CXT.x_Value)
 501 #define zero        (MY_CXT.x_zero)
 502 #define CurrentDB   (MY_CXT.x_CurrentDB)
 503 #define empty       (MY_CXT.x_empty)
 504
 505 #define ERR_BUFF "DB_File::Error"
 506
 507 #ifdef DB_VERSION_MAJOR
 508
 509 static int
 510 #ifdef CAN_PROTOTYPE
 511 db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
 512 #else
 513 db_put(db, key, value, flags)
 514 DB_File     db ;
 515 DBTKEY      key ;
 516 DBT         value ;
 517 u_int       flags ;
 518 #endif
 519 {
 520     int status ;
 521
 522     if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) {
 523         DBC * temp_cursor ;
 524         DBT l_key, l_value;
 525
 526 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
 527         if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor) != 0)
 528 #else
 529         if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor, 0) != 0)
 530 #endif
 531             return (-1) ;
 532
 533         memset(&l_key, 0, sizeof(l_key));
 534         l_key.data = key.data;
 535         l_key.size = key.size;
 536         memset(&l_value, 0, sizeof(l_value));
 537         l_value.data = value.data;
 538         l_value.size = value.size;
 539
 540         if ( temp_cursor->c_get(temp_cursor, &l_key, &l_value, DB_SET) != 0) {
 541             (void)temp_cursor->c_close(temp_cursor);
 542             return (-1);
 543         }
 544
 545         status = temp_cursor->c_put(temp_cursor, &key, &value, flags);
 546         (void)temp_cursor->c_close(temp_cursor);
 547
 548         return (status) ;
 549     }
 550
 551
 552     if (flagSet(flags, R_CURSOR)) {
 553         return ((db->cursor)->c_put)(db->cursor, &key, &value, DB_CURRENT);
 554     }
 555     if (flagSet(flags, R_SETCURSOR)) {
 556         if ((db->dbp)->put(db->dbp, NULL, &key, &value, 0) != 0)
 557             return -1 ;
 558         return ((db->cursor)->c_get)(db->cursor, &key, &value, DB_SET_RANGE);
 559     }
 560
 561     return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
 562
 563 }
 564
 565 #endif /* DB_VERSION_MAJOR */
 566
 567 static void
 568 tidyUp(DB_File db)
 569 {
 570     db->aborted = TRUE ;
 571 }
 572
 573
 574 static int
 575
 576 #ifdef AT_LEAST_DB_6_0
 577 #ifdef CAN_PROTOTYPE
 578 btree_compare(DB * db, const DBT *key1, const DBT *key2, size_t* locp)
 579 #else
 580 btree_compare(db, key1, key2, locp)
 581 DB * db ;
 582 const DBT * key1 ;
 583 const DBT * key2 ;
 584 size_t* locp;
 585 #endif /* CAN_PROTOTYPE */
 586
 587 #else /* Berkeley DB < 6.0 */
 588 #ifdef AT_LEAST_DB_3_2
 589
 590 #ifdef CAN_PROTOTYPE
 591 btree_compare(DB * db, const DBT *key1, const DBT *key2)
 592 #else
 593 btree_compare(db, key1, key2)
 594 DB        * db ;
 595 const DBT * key1 ;
 596 const DBT * key2 ;
 597 #endif /* CAN_PROTOTYPE */
 598
 599 #else /* Berkeley DB < 3.2 */
 600
 601 #ifdef CAN_PROTOTYPE
 602 btree_compare(const DBT *key1, const DBT *key2)
 603 #else
 604 btree_compare(key1, key2)
 605 const DBT * key1 ;
 606 const DBT * key2 ;
 607 #endif
 608
 609 #endif
 610 #endif
 611
 612 {
 613 #ifdef dTHX
 614     dTHX;
 615 #endif
 616     dSP ;
 617     dMY_CXT ;
 618     void * data1, * data2 ;
 619     int retval ;
 620     int count ;
 621
 622 #ifdef AT_LEAST_DB_3_2
 623     PERL_UNUSED_ARG(db);
 624 #endif
 625 #ifdef AT_LEAST_DB_6_0
 626     PERL_UNUSED_ARG(locp);
 627 #endif
 628
 629     if (CurrentDB->in_compare) {
 630         tidyUp(CurrentDB);
 631         croak ("DB_File btree_compare: recursion detected\n") ;
 632     }
 633
 634     data1 = (char *) key1->data ;
 635     data2 = (char *) key2->data ;
 636
 637 #ifndef newSVpvn
 638     /* As newSVpv will assume that the data pointer is a null terminated C
 639        string if the size parameter is 0, make sure that data points to an
 640        empty string if the length is 0
 641     */
 642     if (key1->size == 0)
 643         data1 = "" ;
 644     if (key2->size == 0)
 645         data2 = "" ;
 646 #endif
 647
 648     ENTER ;
 649     SAVETMPS;
 650     SAVESPTR(CurrentDB);
 651     CurrentDB->in_compare = FALSE;
 652     SAVEINT(CurrentDB->in_compare);
 653     CurrentDB->in_compare = TRUE;
 654
 655     PUSHMARK(SP) ;
 656     EXTEND(SP,2) ;
 657     PUSHs(sv_2mortal(newSVpvn((const char*)data1,key1->size)));
 658     PUSHs(sv_2mortal(newSVpvn((const char*)data2,key2->size)));
 659     PUTBACK ;
 660
 661     count = perl_call_sv(CurrentDB->compare, G_SCALAR);
 662
 663     SPAGAIN ;
 664
 665     if (count != 1){
 666         tidyUp(CurrentDB);
 667         croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
 668     }
 669
 670     retval = POPi ;
 671
 672     PUTBACK ;
 673     FREETMPS ;
 674     LEAVE ;
 675
 676     return (retval) ;
 677
 678 }
 679
 680 static DB_Prefix_t
 681 #ifdef AT_LEAST_DB_3_2
 682
 683 #ifdef CAN_PROTOTYPE
 684 btree_prefix(DB * db, const DBT *key1, const DBT *key2)
 685 #else
 686 btree_prefix(db, key1, key2)
 687 Db * db ;
 688 const DBT * key1 ;
 689 const DBT * key2 ;
 690 #endif
 691
 692 #else /* Berkeley DB < 3.2 */
 693
 694 #ifdef CAN_PROTOTYPE
 695 btree_prefix(const DBT *key1, const DBT *key2)
 696 #else
 697 btree_prefix(key1, key2)
 698 const DBT * key1 ;
 699 const DBT * key2 ;
 700 #endif
 701
 702 #endif
 703 {
 704 #ifdef dTHX
 705     dTHX;
 706 #endif
 707     dSP ;
 708     dMY_CXT ;
 709     char * data1, * data2 ;
 710     int retval ;
 711     int count ;
 712
 713 #ifdef AT_LEAST_DB_3_2
 714     PERL_UNUSED_ARG(db);
 715 #endif
 716
 717     if (CurrentDB->in_prefix){
 718         tidyUp(CurrentDB);
 719         croak ("DB_File btree_prefix: recursion detected\n") ;
 720     }
 721
 722     data1 = (char *) key1->data ;
 723     data2 = (char *) key2->data ;
 724
 725 #ifndef newSVpvn
 726     /* As newSVpv will assume that the data pointer is a null terminated C
 727        string if the size parameter is 0, make sure that data points to an
 728        empty string if the length is 0
 729     */
 730     if (key1->size == 0)
 731         data1 = "" ;
 732     if (key2->size == 0)
 733         data2 = "" ;
 734 #endif
 735
 736     ENTER ;
 737     SAVETMPS;
 738     SAVESPTR(CurrentDB);
 739     CurrentDB->in_prefix = FALSE;
 740     SAVEINT(CurrentDB->in_prefix);
 741     CurrentDB->in_prefix = TRUE;
 742
 743     PUSHMARK(SP) ;
 744     EXTEND(SP,2) ;
 745     PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
 746     PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
 747     PUTBACK ;
 748
 749     count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
 750
 751     SPAGAIN ;
 752
 753     if (count != 1){
 754         tidyUp(CurrentDB);
 755         croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
 756     }
 757
 758     retval = POPi ;
 759
 760     PUTBACK ;
 761     FREETMPS ;
 762     LEAVE ;
 763
 764     return (retval) ;
 765 }
 766
 767
 768 #ifdef BERKELEY_DB_1
 769 #    define HASH_CB_SIZE_TYPE size_t
 770 #else
 771 #    define HASH_CB_SIZE_TYPE u_int32_t
 772 #endif
 773
 774 static DB_Hash_t
 775 #ifdef AT_LEAST_DB_3_2
 776
 777 #ifdef CAN_PROTOTYPE
 778 hash_cb(DB * db, const void *data, u_int32_t size)
 779 #else
 780 hash_cb(db, data, size)
 781 DB * db ;
 782 const void * data ;
 783 HASH_CB_SIZE_TYPE size ;
 784 #endif
 785
 786 #else /* Berkeley DB < 3.2 */
 787
 788 #ifdef CAN_PROTOTYPE
 789 hash_cb(const void *data, HASH_CB_SIZE_TYPE size)
 790 #else
 791 hash_cb(data, size)
 792 const void * data ;
 793 HASH_CB_SIZE_TYPE size ;
 794 #endif
 795
 796 #endif
 797 {
 798 #ifdef dTHX
 799     dTHX;
 800 #endif
 801     dSP ;
 802     dMY_CXT;
 803     int retval = 0;
 804     int count ;
 805
 806 #ifdef AT_LEAST_DB_3_2
 807     PERL_UNUSED_ARG(db);
 808 #endif
 809
 810     if (CurrentDB->in_hash){
 811         tidyUp(CurrentDB);
 812         croak ("DB_File hash callback: recursion detected\n") ;
 813     }
 814
 815 #ifndef newSVpvn
 816     if (size == 0)
 817         data = "" ;
 818 #endif
 819
 820      /* DGH - Next two lines added to fix corrupted stack problem */
 821     ENTER ;
 822     SAVETMPS;
 823     SAVESPTR(CurrentDB);
 824     CurrentDB->in_hash = FALSE;
 825     SAVEINT(CurrentDB->in_hash);
 826     CurrentDB->in_hash = TRUE;
 827
 828     PUSHMARK(SP) ;
 829
 830
 831     XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
 832     PUTBACK ;
 833
 834     count = perl_call_sv(CurrentDB->hash, G_SCALAR);
 835
 836     SPAGAIN ;
 837
 838     if (count != 1){
 839         tidyUp(CurrentDB);
 840         croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
 841     }
 842
 843     retval = POPi ;
 844
 845     PUTBACK ;
 846     FREETMPS ;
 847     LEAVE ;
 848
 849     return (retval) ;
 850 }
 851
 852 #ifdef WANT_ERROR
 853
 854 static void
 855 #ifdef AT_LEAST_DB_4_3
 856 db_errcall_cb(const DB_ENV* dbenv, const char * db_errpfx, const char * buffer)
 857 #else
 858 db_errcall_cb(const char * db_errpfx, char * buffer)
 859 #endif
 860 {
 861 #ifdef dTHX
 862     dTHX;
 863 #endif
 864     SV * sv = perl_get_sv(ERR_BUFF, FALSE) ;
 865 #ifdef AT_LEAST_DB_4_3
 866     PERL_UNUSED_ARG(dbenv);
 867 #endif
 868     if (sv) {
 869         if (db_errpfx)
 870             sv_setpvf(sv, "%s: %s", db_errpfx, buffer) ;
 871         else
 872             sv_setpv(sv, buffer) ;
 873     }
 874 }
 875 #endif
 876
 877 #if defined(TRACE) && defined(BERKELEY_DB_1_OR_2)
 878
 879 static void
 880 #ifdef CAN_PROTOTYPE
 881 PrintHash(INFO *hash)
 882 #else
 883 PrintHash(hash)
 884 INFO * hash ;
 885 #endif
 886 {
 887     printf ("HASH Info\n") ;
 888     printf ("  hash      = %s\n",
 889             (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
 890     printf ("  bsize     = %d\n", hash->db_HA_bsize) ;
 891     printf ("  ffactor   = %d\n", hash->db_HA_ffactor) ;
 892     printf ("  nelem     = %d\n", hash->db_HA_nelem) ;
 893     printf ("  cachesize = %d\n", hash->db_HA_cachesize) ;
 894     printf ("  lorder    = %d\n", hash->db_HA_lorder) ;
 895
 896 }
 897
 898 static void
 899 #ifdef CAN_PROTOTYPE
 900 PrintRecno(INFO *recno)
 901 #else
 902 PrintRecno(recno)
 903 INFO * recno ;
 904 #endif
 905 {
 906     printf ("RECNO Info\n") ;
 907     printf ("  flags     = %d\n", recno->db_RE_flags) ;
 908     printf ("  cachesize = %d\n", recno->db_RE_cachesize) ;
 909     printf ("  psize     = %d\n", recno->db_RE_psize) ;
 910     printf ("  lorder    = %d\n", recno->db_RE_lorder) ;
 911     printf ("  reclen    = %lu\n", (unsigned long)recno->db_RE_reclen) ;
 912     printf ("  bval      = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
 913     printf ("  bfname    = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
 914 }
 915
 916 static void
 917 #ifdef CAN_PROTOTYPE
 918 PrintBtree(INFO *btree)
 919 #else
 920 PrintBtree(btree)
 921 INFO * btree ;
 922 #endif
 923 {
 924     printf ("BTREE Info\n") ;
 925     printf ("  compare    = %s\n",
 926             (btree->db_BT_compare ? "redefined" : "default")) ;
 927     printf ("  prefix     = %s\n",
 928             (btree->db_BT_prefix ? "redefined" : "default")) ;
 929     printf ("  flags      = %d\n", btree->db_BT_flags) ;
 930     printf ("  cachesize  = %d\n", btree->db_BT_cachesize) ;
 931     printf ("  psize      = %d\n", btree->db_BT_psize) ;
 932 #ifndef DB_VERSION_MAJOR
 933     printf ("  maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
 934     printf ("  minkeypage = %d\n", btree->db_BT_minkeypage) ;
 935 #endif
 936     printf ("  lorder     = %d\n", btree->db_BT_lorder) ;
 937 }
 938
 939 #else
 940
 941 #define PrintRecno(recno)
 942 #define PrintHash(hash)
 943 #define PrintBtree(btree)
 944
 945 #endif /* TRACE */
 946
 947
 948 static I32
 949 #ifdef CAN_PROTOTYPE
 950 GetArrayLength(pTHX_ DB_File db)
 951 #else
 952 GetArrayLength(db)
 953 DB_File db ;
 954 #endif
 955 {
 956     DBT     key ;
 957     DBT     value ;
 958     int     RETVAL ;
 959
 960     DBT_clear(key) ;
 961     DBT_clear(value) ;
 962     RETVAL = do_SEQ(db, key, value, R_LAST) ;
 963     if (RETVAL == 0)
 964         RETVAL = *(I32 *)key.data ;
 965     else /* No key means empty file */
 966         RETVAL = 0 ;
 967
 968     return ((I32)RETVAL) ;
 969 }
 970
 971 static recno_t
 972 #ifdef CAN_PROTOTYPE
 973 GetRecnoKey(pTHX_ DB_File db, I32 value)
 974 #else
 975 GetRecnoKey(db, value)
 976 DB_File  db ;
 977 I32      value ;
 978 #endif
 979 {
 980     if (value < 0) {
 981         /* Get the length of the array */
 982         I32 length = GetArrayLength(aTHX_ db) ;
 983
 984         /* check for attempt to write before start of array */
 985         if (length + value + 1 <= 0) {
 986             tidyUp(db);
 987             croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
 988         }
 989
 990         value = length + value + 1 ;
 991     }
 992     else
 993         ++ value ;
 994
 995     return value ;
 996 }
 997
 998
 999 static DB_File
1000 #ifdef CAN_PROTOTYPE
1001 ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
1002 #else
1003 ParseOpenInfo(isHASH, name, flags, mode, sv)
1004 int    isHASH ;
1005 char * name ;
1006 int    flags ;
1007 int    mode ;
1008 SV *   sv ;
1009 #endif
1010 {
1011
1012 #ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1  or 2 */
1013
1014     SV **   svp;
1015     HV *    action ;
1016     DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
1017     void *  openinfo = NULL ;
1018     INFO    * info  = &RETVAL->info ;
1019     STRLEN  n_a;
1020     dMY_CXT;
1021
1022 #ifdef TRACE
1023     printf("In ParseOpenInfo name=[%s] flags=[%d] mode=[%d] SV NULL=[%d]\n",
1024             name, flags, mode, sv == NULL) ;
1025 #endif
1026     Zero(RETVAL, 1, DB_File_type) ;
1027
1028     /* Default to HASH */
1029     RETVAL->filtering = 0 ;
1030     RETVAL->filter_fetch_key = RETVAL->filter_store_key =
1031     RETVAL->filter_fetch_value = RETVAL->filter_store_value =
1032     RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
1033     RETVAL->type = DB_HASH ;
1034
1035      /* DGH - Next line added to avoid SEGV on existing hash DB */
1036     CurrentDB = RETVAL;
1037
1038     /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
1039     RETVAL->in_memory = (name == NULL) ;
1040
1041     if (sv)
1042     {
1043         if (! SvROK(sv) )
1044             croak_and_free("type parameter is not a reference") ;
1045
1046         svp  = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
1047         if (svp && SvOK(*svp))
1048             action  = (HV*) SvRV(*svp) ;
1049         else
1050             croak_and_free("internal error") ;
1051
1052         if (sv_isa(sv, "DB_File::HASHINFO"))
1053         {
1054
1055             if (!isHASH)
1056                 croak_and_free("DB_File can only tie an associative array to a DB_HASH database") ;
1057
1058             RETVAL->type = DB_HASH ;
1059             openinfo = (void*)info ;
1060
1061             svp = hv_fetch(action, "hash", 4, FALSE);
1062
1063             if (svp && SvOK(*svp))
1064             {
1065                 info->db_HA_hash = hash_cb ;
1066                 RETVAL->hash = newSVsv(*svp) ;
1067             }
1068             else
1069                 info->db_HA_hash = NULL ;
1070
1071             svp = hv_fetch(action, "ffactor", 7, FALSE);
1072             info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
1073
1074             svp = hv_fetch(action, "nelem", 5, FALSE);
1075             info->db_HA_nelem = svp ? SvIV(*svp) : 0;
1076
1077             svp = hv_fetch(action, "bsize", 5, FALSE);
1078             info->db_HA_bsize = svp ? SvIV(*svp) : 0;
1079
1080             svp = hv_fetch(action, "cachesize", 9, FALSE);
1081             info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
1082
1083             svp = hv_fetch(action, "lorder", 6, FALSE);
1084             info->db_HA_lorder = svp ? SvIV(*svp) : 0;
1085
1086             PrintHash(info) ;
1087         }
1088         else if (sv_isa(sv, "DB_File::BTREEINFO"))
1089         {
1090             if (!isHASH)
1091                 croak_and_free("DB_File can only tie an associative array to a DB_BTREE database");
1092
1093             RETVAL->type = DB_BTREE ;
1094             openinfo = (void*)info ;
1095
1096             svp = hv_fetch(action, "compare", 7, FALSE);
1097             if (svp && SvOK(*svp))
1098             {
1099                 info->db_BT_compare = btree_compare ;
1100                 RETVAL->compare = newSVsv(*svp) ;
1101             }
1102             else
1103                 info->db_BT_compare = NULL ;
1104
1105             svp = hv_fetch(action, "prefix", 6, FALSE);
1106             if (svp && SvOK(*svp))
1107             {
1108                 info->db_BT_prefix = btree_prefix ;
1109                 RETVAL->prefix = newSVsv(*svp) ;
1110             }
1111             else
1112                 info->db_BT_prefix = NULL ;
1113
1114             svp = hv_fetch(action, "flags", 5, FALSE);
1115             info->db_BT_flags = svp ? SvIV(*svp) : 0;
1116
1117             svp = hv_fetch(action, "cachesize", 9, FALSE);
1118             info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
1119
1120 #ifndef DB_VERSION_MAJOR
1121             svp = hv_fetch(action, "minkeypage", 10, FALSE);
1122             info->btree.minkeypage = svp ? SvIV(*svp) : 0;
1123
1124             svp = hv_fetch(action, "maxkeypage", 10, FALSE);
1125             info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
1126 #endif
1127
1128             svp = hv_fetch(action, "psize", 5, FALSE);
1129             info->db_BT_psize = svp ? SvIV(*svp) : 0;
1130
1131             svp = hv_fetch(action, "lorder", 6, FALSE);
1132             info->db_BT_lorder = svp ? SvIV(*svp) : 0;
1133
1134             PrintBtree(info) ;
1135
1136         }
1137         else if (sv_isa(sv, "DB_File::RECNOINFO"))
1138         {
1139             if (isHASH)
1140                 croak_and_free("DB_File can only tie an array to a DB_RECNO database");
1141
1142             RETVAL->type = DB_RECNO ;
1143             openinfo = (void *)info ;
1144
1145             info->db_RE_flags = 0 ;
1146
1147             svp = hv_fetch(action, "flags", 5, FALSE);
1148             info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
1149
1150             svp = hv_fetch(action, "reclen", 6, FALSE);
1151             info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
1152
1153             svp = hv_fetch(action, "cachesize", 9, FALSE);
1154             info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
1155
1156             svp = hv_fetch(action, "psize", 5, FALSE);
1157             info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
1158
1159             svp = hv_fetch(action, "lorder", 6, FALSE);
1160             info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
1161
1162 #ifdef DB_VERSION_MAJOR
1163             info->re_source = name ;
1164             name = NULL ;
1165 #endif
1166             svp = hv_fetch(action, "bfname", 6, FALSE);
1167             if (svp && SvOK(*svp)) {
1168                 char * ptr = SvPV(*svp,n_a) ;
1169 #ifdef DB_VERSION_MAJOR
1170                 name = (char*) n_a ? ptr : NULL ;
1171 #else
1172                 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
1173 #endif
1174             }
1175             else
1176 #ifdef DB_VERSION_MAJOR
1177                name = NULL ;
1178 #else
1179                info->db_RE_bfname = NULL ;
1180 #endif
1181
1182             svp = hv_fetch(action, "bval", 4, FALSE);
1183 #ifdef DB_VERSION_MAJOR
1184             if (svp && SvOK(*svp))
1185             {
1186                 int value ;
1187                 if (SvPOK(*svp))
1188                     value = (int)*SvPV(*svp, n_a) ;
1189                 else
1190                     value = SvIV(*svp) ;
1191
1192                 if (info->flags & DB_FIXEDLEN) {
1193                     info->re_pad = value ;
1194                     info->flags |= DB_PAD ;
1195                 }
1196                 else {
1197                     info->re_delim = value ;
1198                     info->flags |= DB_DELIMITER ;
1199                 }
1200
1201             }
1202 #else
1203             if (svp && SvOK(*svp))
1204             {
1205                 if (SvPOK(*svp))
1206                     info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
1207                 else
1208                     info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
1209                 DB_flags(info->flags, DB_DELIMITER) ;
1210
1211             }
1212             else
1213             {
1214                 if (info->db_RE_flags & R_FIXEDLEN)
1215                     info->db_RE_bval = (u_char) ' ' ;
1216                 else
1217                     info->db_RE_bval = (u_char) '\n' ;
1218                 DB_flags(info->flags, DB_DELIMITER) ;
1219             }
1220 #endif
1221
1222 #ifdef DB_RENUMBER
1223             info->flags |= DB_RENUMBER ;
1224 #endif
1225
1226             PrintRecno(info) ;
1227         }
1228         else
1229             croak_and_free("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1230     }
1231
1232
1233     /* OS2 Specific Code */
1234 #ifdef OS2
1235 #ifdef __EMX__
1236     flags |= O_BINARY;
1237 #endif /* __EMX__ */
1238 #endif /* OS2 */
1239
1240 #ifdef DB_VERSION_MAJOR
1241
1242     {
1243         int     Flags = 0 ;
1244         int     status ;
1245
1246         /* Map 1.x flags to 2.x flags */
1247         if ((flags & O_CREAT) == O_CREAT)
1248             Flags |= DB_CREATE ;
1249
1250 #if O_RDONLY == 0
1251         if (flags == O_RDONLY)
1252 #else
1253         if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1254 #endif
1255             Flags |= DB_RDONLY ;
1256
1257 #ifdef O_TRUNC
1258         if ((flags & O_TRUNC) == O_TRUNC)
1259             Flags |= DB_TRUNCATE ;
1260 #endif
1261
1262         status = db_open(name, RETVAL->type, Flags, mode, NULL, (DB_INFO*)openinfo, &RETVAL->dbp) ;
1263         if (status == 0)
1264 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
1265             status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
1266 #else
1267             status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor, 0) ;
1268 #endif
1269
1270         if (status)
1271              RETVAL->dbp = NULL ;
1272     }
1273 #else
1274
1275 #if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2
1276     RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ;
1277 #else
1278     RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
1279 #endif /* DB_LIBRARY_COMPATIBILITY_API */
1280
1281 #endif
1282
1283     return (RETVAL) ;
1284
1285 #else /* Berkeley DB Version > 2 */
1286
1287     SV **   svp;
1288     HV *    action ;
1289     DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
1290     DB *    dbp ;
1291     STRLEN  n_a;
1292     int     status ;
1293     dMY_CXT;
1294
1295     Trace(("In ParseOpenInfo name=[%s] flags=[%d] mode=[%d] SV NULL=[%d]\n",\
1296             name, flags, mode, sv == NULL)) ;
1297     Zero(RETVAL, 1, DB_File_type) ;
1298
1299     /* Default to HASH */
1300     RETVAL->filtering = 0 ;
1301     RETVAL->filter_fetch_key = RETVAL->filter_store_key =
1302     RETVAL->filter_fetch_value = RETVAL->filter_store_value =
1303     RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
1304     RETVAL->type = DB_HASH ;
1305
1306      /* DGH - Next line added to avoid SEGV on existing hash DB */
1307     CurrentDB = RETVAL;
1308
1309     /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
1310     RETVAL->in_memory = (name == NULL) ;
1311
1312     status = db_create(&RETVAL->dbp, NULL,0) ;
1313     Trace(("db_create returned %d %s\n", status, db_strerror(status))) ;
1314     if (status) {
1315         RETVAL->dbp = NULL ;
1316         return (RETVAL) ;
1317     }
1318     dbp = RETVAL->dbp ;
1319
1320 #ifdef WANT_ERROR
1321     RETVAL->dbp->set_errcall(RETVAL->dbp, db_errcall_cb) ;
1322 #endif
1323     if (sv)
1324     {
1325         if (! SvROK(sv) )
1326             croak_and_free("type parameter is not a reference") ;
1327
1328         svp  = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
1329         if (svp && SvOK(*svp))
1330             action  = (HV*) SvRV(*svp) ;
1331         else
1332             croak_and_free("internal error") ;
1333
1334         if (sv_isa(sv, "DB_File::HASHINFO"))
1335         {
1336
1337             if (!isHASH)
1338                 croak_and_free("DB_File can only tie an associative array to a DB_HASH database") ;
1339
1340             RETVAL->type = DB_HASH ;
1341
1342             svp = hv_fetch(action, "hash", 4, FALSE);
1343
1344             if (svp && SvOK(*svp))
1345             {
1346                 (void)dbp->set_h_hash(dbp, hash_cb) ;
1347                 RETVAL->hash = newSVsv(*svp) ;
1348             }
1349
1350            svp = hv_fetch(action, "ffactor", 7, FALSE);
1351            if (svp)
1352                (void)dbp->set_h_ffactor(dbp, my_SvUV32(*svp)) ;
1353
1354            svp = hv_fetch(action, "nelem", 5, FALSE);
1355            if (svp)
1356                (void)dbp->set_h_nelem(dbp, my_SvUV32(*svp)) ;
1357
1358            svp = hv_fetch(action, "bsize", 5, FALSE);
1359            if (svp)
1360                (void)dbp->set_pagesize(dbp, my_SvUV32(*svp));
1361
1362            svp = hv_fetch(action, "cachesize", 9, FALSE);
1363            if (svp)
1364                (void)dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
1365
1366            svp = hv_fetch(action, "lorder", 6, FALSE);
1367            if (svp)
1368                (void)dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
1369
1370            PrintHash(info) ;
1371         }
1372         else if (sv_isa(sv, "DB_File::BTREEINFO"))
1373         {
1374             if (!isHASH)
1375                 croak_and_free("DB_File can only tie an associative array to a DB_BTREE database");
1376
1377             RETVAL->type = DB_BTREE ;
1378
1379             svp = hv_fetch(action, "compare", 7, FALSE);
1380             if (svp && SvOK(*svp))
1381             {
1382                 (void)dbp->set_bt_compare(dbp, btree_compare) ;
1383                 RETVAL->compare = newSVsv(*svp) ;
1384             }
1385
1386             svp = hv_fetch(action, "prefix", 6, FALSE);
1387             if (svp && SvOK(*svp))
1388             {
1389                 (void)dbp->set_bt_prefix(dbp, btree_prefix) ;
1390                 RETVAL->prefix = newSVsv(*svp) ;
1391             }
1392
1393            svp = hv_fetch(action, "flags", 5, FALSE);
1394            if (svp)
1395                (void)dbp->set_flags(dbp, my_SvUV32(*svp)) ;
1396
1397            svp = hv_fetch(action, "cachesize", 9, FALSE);
1398            if (svp)
1399                (void)dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
1400
1401            svp = hv_fetch(action, "psize", 5, FALSE);
1402            if (svp)
1403                (void)dbp->set_pagesize(dbp, my_SvUV32(*svp)) ;
1404
1405            svp = hv_fetch(action, "lorder", 6, FALSE);
1406            if (svp)
1407                (void)dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
1408
1409            PrintBtree(info) ;
1410
1411         }
1412         else if (sv_isa(sv, "DB_File::RECNOINFO"))
1413         {
1414             int fixed = FALSE ;
1415
1416             if (isHASH)
1417                 croak_and_free("DB_File can only tie an array to a DB_RECNO database");
1418
1419             RETVAL->type = DB_RECNO ;
1420
1421             svp = hv_fetch(action, "flags", 5, FALSE);
1422             if (svp) {
1423                 int flags = SvIV(*svp) ;
1424                 /* remove FIXDLEN, if present */
1425                 if (flags & DB_FIXEDLEN) {
1426                     fixed = TRUE ;
1427                     flags &= ~DB_FIXEDLEN ;
1428                 }
1429             }
1430
1431             svp = hv_fetch(action, "cachesize", 9, FALSE);
1432             if (svp) {
1433                 status = dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
1434             }
1435
1436             svp = hv_fetch(action, "psize", 5, FALSE);
1437             if (svp) {
1438                 status = dbp->set_pagesize(dbp, my_SvUV32(*svp)) ;
1439             }
1440
1441             svp = hv_fetch(action, "lorder", 6, FALSE);
1442             if (svp) {
1443                 status = dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
1444             }
1445
1446             svp = hv_fetch(action, "bval", 4, FALSE);
1447             if (svp && SvOK(*svp))
1448             {
1449                 int value ;
1450                 if (SvPOK(*svp))
1451                     value = (int)*SvPV(*svp, n_a) ;
1452                 else
1453                     value = (int)SvIV(*svp) ;
1454
1455                 if (fixed) {
1456                     (void)dbp->set_re_pad(dbp, value) ;
1457                 }
1458                 else {
1459                     (void)dbp->set_re_delim(dbp, value) ;
1460                 }
1461
1462             }
1463
1464             if (fixed) {
1465                 svp = hv_fetch(action, "reclen", 6, FALSE);
1466                 if (svp) {
1467                     u_int32_t len =  my_SvUV32(*svp) ;
1468                     (void)dbp->set_re_len(dbp, len) ;
1469                 }
1470             }
1471
1472             if (name != NULL) {
1473                 (void)dbp->set_re_source(dbp, name) ;
1474                 name = NULL ;
1475             }
1476
1477             svp = hv_fetch(action, "bfname", 6, FALSE);
1478             if (svp && SvOK(*svp)) {
1479                 char * ptr = SvPV(*svp,n_a) ;
1480                 name = (char*) n_a ? ptr : NULL ;
1481             }
1482             else
1483                 name = NULL ;
1484
1485
1486             (void)dbp->set_flags(dbp, (u_int32_t)DB_RENUMBER) ;
1487
1488             if (flags){
1489                 (void)dbp->set_flags(dbp, (u_int32_t)flags) ;
1490             }
1491             PrintRecno(info) ;
1492         }
1493         else
1494             croak_and_free("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1495     }
1496
1497     {
1498         u_int32_t   Flags = 0 ;
1499         int     status ;
1500
1501         /* Map 1.x flags to 3.x flags */
1502         if ((flags & O_CREAT) == O_CREAT)
1503             Flags |= DB_CREATE ;
1504
1505 #if O_RDONLY == 0
1506         if (flags == O_RDONLY)
1507 #else
1508         if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1509 #endif
1510             Flags |= DB_RDONLY ;
1511
1512 #ifdef O_TRUNC
1513         if ((flags & O_TRUNC) == O_TRUNC)
1514             Flags |= DB_TRUNCATE ;
1515 #endif
1516
1517 #ifdef AT_LEAST_DB_4_4
1518         /* need this for recno */
1519         if ((flags & O_TRUNC) == O_TRUNC)
1520             Flags |= DB_CREATE ;
1521 #endif
1522
1523 #ifdef AT_LEAST_DB_4_1
1524         status = (RETVAL->dbp->open)(RETVAL->dbp, NULL, name, NULL, RETVAL->type,
1525                     Flags, mode) ;
1526 #else
1527         status = (RETVAL->dbp->open)(RETVAL->dbp, name, NULL, RETVAL->type,
1528                     Flags, mode) ;
1529 #endif
1530         Trace(("open returned %d %s\n", status, db_strerror(status))) ;
1531
1532         if (status == 0) {
1533
1534             status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor, 0) ;
1535             Trace(("cursor returned %d %s\n", status, db_strerror(status))) ;
1536         }
1537
1538         if (status)
1539         {
1540             db_close(RETVAL); /* close **dbp handle to prevent mem.leak */
1541             RETVAL->dbp = NULL ;
1542         }
1543     }
1544
1545     return (RETVAL) ;
1546
1547 #endif /* Berkeley DB Version > 2 */
1548
1549 } /* ParseOpenInfo */
1550
1551
1552 #include "constants.h"
1553
1554 MODULE = DB_File    PACKAGE = DB_File   PREFIX = db_
1555
1556 INCLUDE: constants.xs
1557
1558 BOOT:
1559   {
1560 #ifdef dTHX
1561     dTHX;
1562 #endif
1563 #ifdef WANT_ERROR
1564     SV * sv_err = perl_get_sv(ERR_BUFF, GV_ADD|GV_ADDMULTI) ;
1565 #endif
1566     MY_CXT_INIT;
1567 #ifdef WANT_ERROR
1568     PERL_UNUSED_VAR(sv_err); /* huh? we just retrieved it... */
1569 #endif
1570     __getBerkeleyDBInfo() ;
1571
1572     DBT_clear(empty) ;
1573     empty.data = &zero ;
1574     empty.size =  sizeof(recno_t) ;
1575   }
1576
1577
1578
1579 DB_File
1580 db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1581     int     isHASH
1582     char *      dbtype
1583     int     flags
1584     int     mode
1585     CODE:
1586     {
1587         char *  name = (char *) NULL ;
1588         SV *    sv = (SV *) NULL ;
1589         STRLEN  n_a;
1590         Trace(("In db_DoTie_\n"));
1591
1592         if (items >= 3 && SvOK(ST(2)))
1593             name = (char*) SvPV(ST(2), n_a) ;
1594
1595         if (items == 6)
1596             sv = ST(5) ;
1597
1598         RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
1599         Trace(("db_DoTie_ %p\n", RETVAL));
1600         if (RETVAL->dbp == NULL) {
1601             Safefree(RETVAL);
1602             RETVAL = NULL ;
1603         }
1604     }
1605     OUTPUT:
1606         RETVAL
1607
1608 int
1609 db_DESTROY(db)
1610     DB_File     db
1611     PREINIT:
1612       dMY_CXT;
1613     INIT:
1614       CurrentDB = db ;
1615       Trace(("DESTROY %p\n", db));
1616     CLEANUP:
1617       Trace(("DESTROY %p done\n", db));
1618       if (db->hash)
1619         SvREFCNT_dec(db->hash) ;
1620       if (db->compare)
1621         SvREFCNT_dec(db->compare) ;
1622       if (db->prefix)
1623         SvREFCNT_dec(db->prefix) ;
1624       if (db->filter_fetch_key)
1625         SvREFCNT_dec(db->filter_fetch_key) ;
1626       if (db->filter_store_key)
1627         SvREFCNT_dec(db->filter_store_key) ;
1628       if (db->filter_fetch_value)
1629         SvREFCNT_dec(db->filter_fetch_value) ;
1630       if (db->filter_store_value)
1631         SvREFCNT_dec(db->filter_store_value) ;
1632       safefree(db) ;
1633 #ifdef DB_VERSION_MAJOR
1634       if (RETVAL > 0)
1635         RETVAL = -1 ;
1636 #endif
1637
1638
1639 int
1640 db_DELETE(db, key, flags=0)
1641     DB_File     db
1642     DBTKEY      key
1643     u_int       flags
1644     PREINIT:
1645       dMY_CXT;
1646     INIT:
1647       (void)flags;
1648       CurrentDB = db ;
1649
1650
1651 int
1652 db_EXISTS(db, key)
1653     DB_File     db
1654     DBTKEY      key
1655     PREINIT:
1656       dMY_CXT;
1657     CODE:
1658     {
1659       DBT       value ;
1660
1661       DBT_clear(value) ;
1662       CurrentDB = db ;
1663       RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
1664     }
1665     OUTPUT:
1666       RETVAL
1667
1668 void
1669 db_FETCH(db, key, flags=0)
1670     DB_File     db
1671     DBTKEY      key
1672     u_int       flags
1673     PREINIT:
1674       dMY_CXT ;
1675       int RETVAL ;
1676     CODE:
1677     {
1678         DBT     value ;
1679
1680         DBT_clear(value) ;
1681         CurrentDB = db ;
1682         RETVAL = db_get(db, key, value, flags) ;
1683         ST(0) = sv_newmortal();
1684         OutputValue(ST(0), value)
1685     }
1686
1687 int
1688 db_STORE(db, key, value, flags=0)
1689     DB_File     db
1690     DBTKEY      key
1691     DBT     value
1692     u_int       flags
1693     PREINIT:
1694       dMY_CXT;
1695     INIT:
1696       (void)flags;
1697       CurrentDB = db ;
1698
1699
1700 void
1701 db_FIRSTKEY(db)
1702     DB_File     db
1703     PREINIT:
1704       dMY_CXT ;
1705       int RETVAL ;
1706     CODE:
1707     {
1708         DBTKEY  key ;
1709         DBT     value ;
1710
1711         DBT_clear(key) ;
1712         DBT_clear(value) ;
1713         CurrentDB = db ;
1714         RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1715         ST(0) = sv_newmortal();
1716         OutputKey(ST(0), key) ;
1717     }
1718
1719 void
1720 db_NEXTKEY(db, key)
1721     DB_File     db
1722     DBTKEY      key = NO_INIT
1723     PREINIT:
1724       dMY_CXT ;
1725       int RETVAL ;
1726     CODE:
1727     {
1728         DBT     value ;
1729
1730         DBT_clear(key) ;
1731         DBT_clear(value) ;
1732         CurrentDB = db ;
1733         RETVAL = do_SEQ(db, key, value, R_NEXT) ;
1734         ST(0) = sv_newmortal();
1735         OutputKey(ST(0), key) ;
1736     }
1737
1738 #
1739 # These would be nice for RECNO
1740 #
1741
1742 int
1743 unshift(db, ...)
1744     DB_File     db
1745     ALIAS:      UNSHIFT = 1
1746     PREINIT:
1747       dMY_CXT;
1748     CODE:
1749     {
1750         DBTKEY  key ;
1751         DBT     value ;
1752         int     i ;
1753         int     One ;
1754         STRLEN  n_a;
1755
1756         DBT_clear(key) ;
1757         DBT_clear(value) ;
1758         CurrentDB = db ;
1759 #ifdef DB_VERSION_MAJOR
1760         /* get the first value */
1761         RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1762         RETVAL = 0 ;
1763 #else
1764         RETVAL = -1 ;
1765 #endif
1766         for (i = items-1 ; i > 0 ; --i)
1767         {
1768             DBM_ckFilter(ST(i), filter_store_value, "filter_store_value");
1769             value.data = SvPVbyte(ST(i), n_a) ;
1770             value.size = n_a ;
1771             One = 1 ;
1772             key.data = &One ;
1773             key.size = sizeof(int) ;
1774 #ifdef DB_VERSION_MAJOR
1775             RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1776 #else
1777             RETVAL = (db->dbp->put)(db->dbp, &key, &value, R_IBEFORE) ;
1778 #endif
1779             if (RETVAL != 0)
1780                 break;
1781         }
1782     }
1783     OUTPUT:
1784         RETVAL
1785
1786 void
1787 pop(db)
1788     DB_File     db
1789     PREINIT:
1790       dMY_CXT;
1791     ALIAS:      POP = 1
1792     PREINIT:
1793       I32 RETVAL;
1794     CODE:
1795     {
1796         DBTKEY  key ;
1797         DBT     value ;
1798
1799         DBT_clear(key) ;
1800         DBT_clear(value) ;
1801         CurrentDB = db ;
1802
1803         /* First get the final value */
1804         RETVAL = do_SEQ(db, key, value, R_LAST) ;
1805         ST(0) = sv_newmortal();
1806         /* Now delete it */
1807         if (RETVAL == 0)
1808         {
1809             /* the call to del will trash value, so take a copy now */
1810             OutputValue(ST(0), value) ;
1811             RETVAL = db_del(db, key, R_CURSOR) ;
1812             if (RETVAL != 0)
1813                 sv_setsv(ST(0), &PL_sv_undef);
1814         }
1815     }
1816
1817 void
1818 shift(db)
1819     DB_File     db
1820     PREINIT:
1821       dMY_CXT;
1822     ALIAS:      SHIFT = 1
1823     PREINIT:
1824       I32 RETVAL;
1825     CODE:
1826     {
1827         DBT     value ;
1828         DBTKEY  key ;
1829
1830         DBT_clear(key) ;
1831         DBT_clear(value) ;
1832         CurrentDB = db ;
1833         /* get the first value */
1834         RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1835         ST(0) = sv_newmortal();
1836         /* Now delete it */
1837         if (RETVAL == 0)
1838         {
1839             /* the call to del will trash value, so take a copy now */
1840             OutputValue(ST(0), value) ;
1841             RETVAL = db_del(db, key, R_CURSOR) ;
1842             if (RETVAL != 0)
1843                 sv_setsv (ST(0), &PL_sv_undef) ;
1844         }
1845     }
1846
1847
1848 I32
1849 push(db, ...)
1850     DB_File     db
1851     PREINIT:
1852       dMY_CXT;
1853     ALIAS:      PUSH = 1
1854     CODE:
1855     {
1856         DBTKEY  key ;
1857         DBT     value ;
1858         DB *    Db = db->dbp ;
1859         int     i ;
1860         STRLEN  n_a;
1861         int     keyval ;
1862
1863         DBT_flags(key) ;
1864         DBT_flags(value) ;
1865         CurrentDB = db ;
1866         /* Set the Cursor to the Last element */
1867         RETVAL = do_SEQ(db, key, value, R_LAST) ;
1868 #ifndef DB_VERSION_MAJOR
1869         if (RETVAL >= 0)
1870 #endif
1871         {
1872             if (RETVAL == 0)
1873                 keyval = *(int*)key.data ;
1874             else
1875                 keyval = 0 ;
1876             for (i = 1 ; i < items ; ++i)
1877             {
1878                 DBM_ckFilter(ST(i), filter_store_value, "filter_store_value");
1879                 value.data = SvPVbyte(ST(i), n_a) ;
1880                 value.size = n_a ;
1881                 ++ keyval ;
1882                 key.data = &keyval ;
1883                 key.size = sizeof(int) ;
1884                 RETVAL = (Db->put)(Db, TXN &key, &value, 0) ;
1885                 if (RETVAL != 0)
1886                     break;
1887             }
1888         }
1889     }
1890     OUTPUT:
1891         RETVAL
1892
1893 I32
1894 length(db)
1895     DB_File     db
1896     PREINIT:
1897       dMY_CXT;
1898     ALIAS:      FETCHSIZE = 1
1899     CODE:
1900         CurrentDB = db ;
1901         RETVAL = GetArrayLength(aTHX_ db) ;
1902     OUTPUT:
1903         RETVAL
1904
1905
1906 #
1907 # Now provide an interface to the rest of the DB functionality
1908 #
1909
1910 int
1911 db_del(db, key, flags=0)
1912     DB_File     db
1913     DBTKEY      key
1914     u_int       flags
1915     PREINIT:
1916       dMY_CXT;
1917     CODE:
1918       CurrentDB = db ;
1919       RETVAL = db_del(db, key, flags) ;
1920 #ifdef DB_VERSION_MAJOR
1921       if (RETVAL > 0)
1922         RETVAL = -1 ;
1923       else if (RETVAL == DB_NOTFOUND)
1924         RETVAL = 1 ;
1925 #endif
1926     OUTPUT:
1927       RETVAL
1928
1929
1930 int
1931 db_get(db, key, value, flags=0)
1932     DB_File     db
1933     DBTKEY      key
1934     DBT     value = NO_INIT
1935     u_int       flags
1936     PREINIT:
1937       dMY_CXT;
1938     CODE:
1939       CurrentDB = db ;
1940       DBT_clear(value) ;
1941       RETVAL = db_get(db, key, value, flags) ;
1942 #ifdef DB_VERSION_MAJOR
1943       if (RETVAL > 0)
1944         RETVAL = -1 ;
1945       else if (RETVAL == DB_NOTFOUND)
1946         RETVAL = 1 ;
1947 #endif
1948     OUTPUT:
1949       RETVAL
1950       value
1951
1952 int
1953 db_put(db, key, value, flags=0)
1954     DB_File     db
1955     DBTKEY      key
1956     DBT     value
1957     u_int       flags
1958     PREINIT:
1959       dMY_CXT;
1960     CODE:
1961       CurrentDB = db ;
1962       RETVAL = db_put(db, key, value, flags) ;
1963 #ifdef DB_VERSION_MAJOR
1964       if (RETVAL > 0)
1965         RETVAL = -1 ;
1966       else if (RETVAL == DB_KEYEXIST)
1967         RETVAL = 1 ;
1968 #endif
1969     OUTPUT:
1970       RETVAL
1971       key       if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
1972
1973 int
1974 db_fd(db)
1975     DB_File     db
1976     PREINIT:
1977       dMY_CXT ;
1978     CODE:
1979       CurrentDB = db ;
1980 #ifdef DB_VERSION_MAJOR
1981       RETVAL = -1 ;
1982       {
1983         int status = 0 ;
1984         status = (db->in_memory
1985                   ? -1
1986                   : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
1987         if (status != 0)
1988           RETVAL = -1 ;
1989       }
1990 #else
1991       RETVAL = (db->in_memory
1992                 ? -1
1993                 : ((db->dbp)->fd)(db->dbp) ) ;
1994 #endif
1995     OUTPUT:
1996       RETVAL
1997
1998 int
1999 db_sync(db, flags=0)
2000     DB_File     db
2001     u_int       flags
2002     PREINIT:
2003       dMY_CXT;
2004     CODE:
2005       CurrentDB = db ;
2006       RETVAL = db_sync(db, flags) ;
2007 #ifdef DB_VERSION_MAJOR
2008       if (RETVAL > 0)
2009         RETVAL = -1 ;
2010 #endif
2011     OUTPUT:
2012       RETVAL
2013
2014
2015 int
2016 db_seq(db, key, value, flags)
2017     DB_File     db
2018     DBTKEY      key
2019     DBT     value = NO_INIT
2020     u_int       flags
2021     PREINIT:
2022       dMY_CXT;
2023     CODE:
2024       CurrentDB = db ;
2025       DBT_clear(value) ;
2026       RETVAL = db_seq(db, key, value, flags);
2027 #ifdef DB_VERSION_MAJOR
2028       if (RETVAL > 0)
2029         RETVAL = -1 ;
2030       else if (RETVAL == DB_NOTFOUND)
2031         RETVAL = 1 ;
2032 #endif
2033     OUTPUT:
2034       RETVAL
2035       key
2036       value
2037
2038 SV *
2039 filter_fetch_key(db, code)
2040     DB_File     db
2041     SV *        code
2042     SV *        RETVAL = &PL_sv_undef ;
2043     CODE:
2044         DBM_setFilter(db->filter_fetch_key, code) ;
2045
2046 SV *
2047 filter_store_key(db, code)
2048     DB_File     db
2049     SV *        code
2050     SV *        RETVAL = &PL_sv_undef ;
2051     CODE:
2052         DBM_setFilter(db->filter_store_key, code) ;
2053
2054 SV *
2055 filter_fetch_value(db, code)
2056     DB_File     db
2057     SV *        code
2058     SV *        RETVAL = &PL_sv_undef ;
2059     CODE:
2060         DBM_setFilter(db->filter_fetch_value, code) ;
2061
2062 SV *
2063 filter_store_value(db, code)
2064     DB_File     db
2065     SV *        code
2066     SV *        RETVAL = &PL_sv_undef ;
2067     CODE:
2068         DBM_setFilter(db->filter_store_value, code) ;
2069