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