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