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