ext/DB_File/DB_File.xs

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