3 DB_File.xs -- Perl 5 interface to Berkeley DB
5 written by Paul Marquess <Paul.Marquess@btinternet.com>
6 last modified 22nd Oct 2001
9 All comments/suggestions/problems are welcome
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.
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
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
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 &
81 1.71 - Support for Berkeley DB version 3.
82 Support for Berkeley DB 2/3's backward compatability mode.
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
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
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 1.79 - NEXTKEY ignores the input key.
101 #define PERL_NO_GET_CONTEXT
107 # include "patchlevel.h"
108 # define PERL_REVISION 5
109 # define PERL_VERSION PATCHLEVEL
110 # define PERL_SUBVERSION SUBVERSION
113 #if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 ))
115 # define PL_sv_undef sv_undef
120 /* DEFSV appears first in 5.004_56 */
122 # define DEFSV GvSV(defgv)
125 /* Mention DB_VERSION_MAJOR_CFG, DB_VERSION_MINOR_CFG, and
126 DB_VERSION_PATCH_CFG here so that Configure pulls them all in. */
128 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
129 * shortly #included by the <db.h>) __attribute__ to the possibly
130 * already defined __attribute__, for example by GNUC or by Perl. */
132 /* #if DB_VERSION_MAJOR_CFG < 2 */
133 #ifndef DB_VERSION_MAJOR
134 # undef __attribute__
139 /* If Perl has been compiled with Threads support,the symbol op will
140 be defined here. This clashes with a field name in db.h, so get rid of it.
152 /* Wall starts with 5.7.x */
154 #if PERL_REVISION > 5 || (PERL_REVISION == 5 && PERL_VERSION >= 7)
156 /* Since we dropped the gccish definition of __attribute__ we will want
157 * to redefine dNOOP, however (so that dTHX continues to work). Yes,
158 * all this means that we can't do attribute checking on the DB_File,
160 # ifndef DB_VERSION_MAJOR
163 # define dNOOP extern int Perl___notused
165 /* Ditto for dXSARGS. */
169 I32 ax = mark - PL_stack_base + 1; \
170 I32 items = sp - mark
174 /* avoid -Wall; DB_File xsubs never make use of `ix' setup for ALIASes */
176 # define dXSI32 dNOOP
178 #endif /* Perl >= 5.7 */
188 # define newSVpvn(a,b) newSVpv(a,b)
194 #define DBM_FILTERING
197 # define Trace(x) printf x
203 #define DBT_clear(x) Zero(&x, 1, DBT) ;
205 #ifdef DB_VERSION_MAJOR
207 #if DB_VERSION_MAJOR == 2
208 # define BERKELEY_DB_1_OR_2
211 #if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 2)
212 # define AT_LEAST_DB_3_2
215 /* map version 2 features & constants onto their version 1 equivalent */
220 #define DB_Prefix_t size_t
225 #define DB_Hash_t u_int32_t
227 /* DBTYPE stays the same */
228 /* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */
229 #if DB_VERSION_MAJOR == 2
230 typedef DB_INFO INFO ;
231 #else /* DB_VERSION_MAJOR > 2 */
232 # define DB_FIXEDLEN (0x8000)
233 #endif /* DB_VERSION_MAJOR == 2 */
235 /* version 2 has db_recno_t in place of recno_t */
236 typedef db_recno_t recno_t;
239 #define R_CURSOR DB_SET_RANGE
240 #define R_FIRST DB_FIRST
241 #define R_IAFTER DB_AFTER
242 #define R_IBEFORE DB_BEFORE
243 #define R_LAST DB_LAST
244 #define R_NEXT DB_NEXT
245 #define R_NOOVERWRITE DB_NOOVERWRITE
246 #define R_PREV DB_PREV
248 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
249 # define R_SETCURSOR 0x800000
251 # define R_SETCURSOR (-100)
254 #define R_RECNOSYNC 0
255 #define R_FIXEDLEN DB_FIXEDLEN
259 #define db_HA_hash h_hash
260 #define db_HA_ffactor h_ffactor
261 #define db_HA_nelem h_nelem
262 #define db_HA_bsize db_pagesize
263 #define db_HA_cachesize db_cachesize
264 #define db_HA_lorder db_lorder
266 #define db_BT_compare bt_compare
267 #define db_BT_prefix bt_prefix
268 #define db_BT_flags flags
269 #define db_BT_psize db_pagesize
270 #define db_BT_cachesize db_cachesize
271 #define db_BT_lorder db_lorder
272 #define db_BT_maxkeypage
273 #define db_BT_minkeypage
276 #define db_RE_reclen re_len
277 #define db_RE_flags flags
278 #define db_RE_bval re_pad
279 #define db_RE_bfname re_source
280 #define db_RE_psize db_pagesize
281 #define db_RE_cachesize db_cachesize
282 #define db_RE_lorder db_lorder
286 #define do_SEQ(db, key, value, flag) (db->cursor->c_get)(db->cursor, &key, &value, flag)
289 #define DBT_flags(x) x.flags = 0
290 #define DB_flags(x, v) x |= v
292 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
293 # define flagSet(flags, bitmask) ((flags) & (bitmask))
295 # define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask))
298 #else /* db version 1.x */
300 #define BERKELEY_DB_1
301 #define BERKELEY_DB_1_OR_2
314 # define DB_Prefix_t mDB_Prefix_t
321 # define DB_Hash_t mDB_Hash_t
324 #define db_HA_hash hash.hash
325 #define db_HA_ffactor hash.ffactor
326 #define db_HA_nelem hash.nelem
327 #define db_HA_bsize hash.bsize
328 #define db_HA_cachesize hash.cachesize
329 #define db_HA_lorder hash.lorder
331 #define db_BT_compare btree.compare
332 #define db_BT_prefix btree.prefix
333 #define db_BT_flags btree.flags
334 #define db_BT_psize btree.psize
335 #define db_BT_cachesize btree.cachesize
336 #define db_BT_lorder btree.lorder
337 #define db_BT_maxkeypage btree.maxkeypage
338 #define db_BT_minkeypage btree.minkeypage
340 #define db_RE_reclen recno.reclen
341 #define db_RE_flags recno.flags
342 #define db_RE_bval recno.bval
343 #define db_RE_bfname recno.bfname
344 #define db_RE_psize recno.psize
345 #define db_RE_cachesize recno.cachesize
346 #define db_RE_lorder recno.lorder
350 #define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag)
352 #define DB_flags(x, v)
353 #define flagSet(flags, bitmask) ((flags) & (bitmask))
355 #endif /* db version 1 */
359 #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, TXN &key, flags)
360 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, flags)
361 #define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
363 #define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
364 #define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
366 #ifdef DB_VERSION_MAJOR
367 #define db_DESTROY(db) ( db->cursor->c_close(db->cursor),\
368 (db->dbp->close)(db->dbp, 0) )
369 #define db_close(db) ((db->dbp)->close)(db->dbp, 0)
370 #define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \
371 ? ((db->cursor)->c_del)(db->cursor, 0) \
372 : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
374 #else /* ! DB_VERSION_MAJOR */
376 #define db_DESTROY(db) ((db->dbp)->close)(db->dbp)
377 #define db_close(db) ((db->dbp)->close)(db->dbp)
378 #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
379 #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
381 #endif /* ! DB_VERSION_MAJOR */
384 #define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags)
393 #ifdef BERKELEY_DB_1_OR_2
396 #ifdef DB_VERSION_MAJOR
400 SV * filter_fetch_key ;
401 SV * filter_store_key ;
402 SV * filter_fetch_value ;
403 SV * filter_store_value ;
405 #endif /* DBM_FILTERING */
409 typedef DB_File_type * DB_File ;
414 #define ckFilter(arg,type,name) \
417 /* printf("filtering %s\n", name) ; */ \
419 croak("recursion detected in %s", name) ; \
420 db->filtering = TRUE ; \
421 save_defsv = newSVsv(DEFSV) ; \
422 sv_setsv(DEFSV, arg) ; \
424 (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \
425 sv_setsv(arg, DEFSV) ; \
426 sv_setsv(DEFSV, save_defsv) ; \
427 SvREFCNT_dec(save_defsv) ; \
428 db->filtering = FALSE ; \
429 /* printf("end of filtering %s\n", name) ; */ \
434 #define ckFilter(arg,type, name)
436 #endif /* DBM_FILTERING */
438 #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
440 #define OutputValue(arg, name) \
441 { if (RETVAL == 0) { \
442 my_sv_setpvn(arg, name.data, name.size) ; \
443 ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \
447 #define OutputKey(arg, name) \
450 if (db->type != DB_RECNO) { \
451 my_sv_setpvn(arg, name.data, name.size); \
454 sv_setiv(arg, (I32)*(I32*)name.data - 1); \
455 ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \
459 #define my_SvUV32(sv) ((u_int32_t)SvUV(sv))
462 extern void __getBerkeleyDBInfo(void);
465 /* Internal Global Data */
466 #define MY_CXT_KEY "DB_File::_guts" XS_VERSION
477 #define Value (MY_CXT.x_Value)
478 #define zero (MY_CXT.x_zero)
479 #define CurrentDB (MY_CXT.x_CurrentDB)
480 #define empty (MY_CXT.x_empty)
482 #ifdef DB_VERSION_MAJOR
486 db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
488 db_put(db, key, value, flags)
497 if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) {
501 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
502 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor) != 0)
504 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor, 0) != 0)
508 memset(&l_key, 0, sizeof(l_key));
509 l_key.data = key.data;
510 l_key.size = key.size;
511 memset(&l_value, 0, sizeof(l_value));
512 l_value.data = value.data;
513 l_value.size = value.size;
515 if ( temp_cursor->c_get(temp_cursor, &l_key, &l_value, DB_SET) != 0) {
516 (void)temp_cursor->c_close(temp_cursor);
520 status = temp_cursor->c_put(temp_cursor, &key, &value, flags);
521 (void)temp_cursor->c_close(temp_cursor);
527 if (flagSet(flags, R_CURSOR)) {
528 return ((db->cursor)->c_put)(db->cursor, &key, &value, DB_CURRENT);
531 if (flagSet(flags, R_SETCURSOR)) {
532 if ((db->dbp)->put(db->dbp, NULL, &key, &value, 0) != 0)
534 return ((db->cursor)->c_get)(db->cursor, &key, &value, DB_SET_RANGE);
538 return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
542 #endif /* DB_VERSION_MAJOR */
546 #ifdef AT_LEAST_DB_3_2
549 btree_compare(DB * db, const DBT *key1, const DBT *key2)
551 btree_compare(db, key1, key2)
555 #endif /* CAN_PROTOTYPE */
557 #else /* Berkeley DB < 3.2 */
560 btree_compare(const DBT *key1, const DBT *key2)
562 btree_compare(key1, key2)
575 void * data1, * data2 ;
579 data1 = (char *) key1->data ;
580 data2 = (char *) key2->data ;
583 /* As newSVpv will assume that the data pointer is a null terminated C
584 string if the size parameter is 0, make sure that data points to an
585 empty string if the length is 0
598 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
599 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
602 count = perl_call_sv(CurrentDB->compare, G_SCALAR);
607 croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
619 #ifdef AT_LEAST_DB_3_2
622 btree_prefix(DB * db, const DBT *key1, const DBT *key2)
624 btree_prefix(db, key1, key2)
630 #else /* Berkeley DB < 3.2 */
633 btree_prefix(const DBT *key1, const DBT *key2)
635 btree_prefix(key1, key2)
647 char * data1, * data2 ;
651 data1 = (char *) key1->data ;
652 data2 = (char *) key2->data ;
655 /* As newSVpv will assume that the data pointer is a null terminated C
656 string if the size parameter is 0, make sure that data points to an
657 empty string if the length is 0
670 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
671 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
674 count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
679 croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
692 # define HASH_CB_SIZE_TYPE size_t
694 # define HASH_CB_SIZE_TYPE u_int32_t
698 #ifdef AT_LEAST_DB_3_2
701 hash_cb(DB * db, const void *data, u_int32_t size)
703 hash_cb(db, data, size)
706 HASH_CB_SIZE_TYPE size ;
709 #else /* Berkeley DB < 3.2 */
712 hash_cb(const void *data, HASH_CB_SIZE_TYPE size)
716 HASH_CB_SIZE_TYPE size ;
734 /* DGH - Next two lines added to fix corrupted stack problem */
740 XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
743 count = perl_call_sv(CurrentDB->hash, G_SCALAR);
748 croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
760 #if defined(TRACE) && defined(BERKELEY_DB_1_OR_2)
764 PrintHash(INFO *hash)
770 printf ("HASH Info\n") ;
771 printf (" hash = %s\n",
772 (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
773 printf (" bsize = %d\n", hash->db_HA_bsize) ;
774 printf (" ffactor = %d\n", hash->db_HA_ffactor) ;
775 printf (" nelem = %d\n", hash->db_HA_nelem) ;
776 printf (" cachesize = %d\n", hash->db_HA_cachesize) ;
777 printf (" lorder = %d\n", hash->db_HA_lorder) ;
783 PrintRecno(INFO *recno)
789 printf ("RECNO Info\n") ;
790 printf (" flags = %d\n", recno->db_RE_flags) ;
791 printf (" cachesize = %d\n", recno->db_RE_cachesize) ;
792 printf (" psize = %d\n", recno->db_RE_psize) ;
793 printf (" lorder = %d\n", recno->db_RE_lorder) ;
794 printf (" reclen = %ul\n", (unsigned long)recno->db_RE_reclen) ;
795 printf (" bval = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
796 printf (" bfname = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
801 PrintBtree(INFO *btree)
807 printf ("BTREE Info\n") ;
808 printf (" compare = %s\n",
809 (btree->db_BT_compare ? "redefined" : "default")) ;
810 printf (" prefix = %s\n",
811 (btree->db_BT_prefix ? "redefined" : "default")) ;
812 printf (" flags = %d\n", btree->db_BT_flags) ;
813 printf (" cachesize = %d\n", btree->db_BT_cachesize) ;
814 printf (" psize = %d\n", btree->db_BT_psize) ;
815 #ifndef DB_VERSION_MAJOR
816 printf (" maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
817 printf (" minkeypage = %d\n", btree->db_BT_minkeypage) ;
819 printf (" lorder = %d\n", btree->db_BT_lorder) ;
824 #define PrintRecno(recno)
825 #define PrintHash(hash)
826 #define PrintBtree(btree)
833 GetArrayLength(pTHX_ DB_File db)
845 RETVAL = do_SEQ(db, key, value, R_LAST) ;
847 RETVAL = *(I32 *)key.data ;
848 else /* No key means empty file */
851 return ((I32)RETVAL) ;
856 GetRecnoKey(pTHX_ DB_File db, I32 value)
858 GetRecnoKey(db, value)
864 /* Get the length of the array */
865 I32 length = GetArrayLength(aTHX_ db) ;
867 /* check for attempt to write before start of array */
868 if (length + value + 1 <= 0)
869 croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
871 value = length + value + 1 ;
882 ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
884 ParseOpenInfo(isHASH, name, flags, mode, sv)
893 #ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1 or 2 */
897 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
898 void * openinfo = NULL ;
899 INFO * info = &RETVAL->info ;
903 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
904 Zero(RETVAL, 1, DB_File_type) ;
906 /* Default to HASH */
908 RETVAL->filtering = 0 ;
909 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
910 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
911 #endif /* DBM_FILTERING */
912 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
913 RETVAL->type = DB_HASH ;
915 /* DGH - Next line added to avoid SEGV on existing hash DB */
918 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
919 RETVAL->in_memory = (name == NULL) ;
924 croak ("type parameter is not a reference") ;
926 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
927 if (svp && SvOK(*svp))
928 action = (HV*) SvRV(*svp) ;
930 croak("internal error") ;
932 if (sv_isa(sv, "DB_File::HASHINFO"))
936 croak("DB_File can only tie an associative array to a DB_HASH database") ;
938 RETVAL->type = DB_HASH ;
939 openinfo = (void*)info ;
941 svp = hv_fetch(action, "hash", 4, FALSE);
943 if (svp && SvOK(*svp))
945 info->db_HA_hash = hash_cb ;
946 RETVAL->hash = newSVsv(*svp) ;
949 info->db_HA_hash = NULL ;
951 svp = hv_fetch(action, "ffactor", 7, FALSE);
952 info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
954 svp = hv_fetch(action, "nelem", 5, FALSE);
955 info->db_HA_nelem = svp ? SvIV(*svp) : 0;
957 svp = hv_fetch(action, "bsize", 5, FALSE);
958 info->db_HA_bsize = svp ? SvIV(*svp) : 0;
960 svp = hv_fetch(action, "cachesize", 9, FALSE);
961 info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
963 svp = hv_fetch(action, "lorder", 6, FALSE);
964 info->db_HA_lorder = svp ? SvIV(*svp) : 0;
968 else if (sv_isa(sv, "DB_File::BTREEINFO"))
971 croak("DB_File can only tie an associative array to a DB_BTREE database");
973 RETVAL->type = DB_BTREE ;
974 openinfo = (void*)info ;
976 svp = hv_fetch(action, "compare", 7, FALSE);
977 if (svp && SvOK(*svp))
979 info->db_BT_compare = btree_compare ;
980 RETVAL->compare = newSVsv(*svp) ;
983 info->db_BT_compare = NULL ;
985 svp = hv_fetch(action, "prefix", 6, FALSE);
986 if (svp && SvOK(*svp))
988 info->db_BT_prefix = btree_prefix ;
989 RETVAL->prefix = newSVsv(*svp) ;
992 info->db_BT_prefix = NULL ;
994 svp = hv_fetch(action, "flags", 5, FALSE);
995 info->db_BT_flags = svp ? SvIV(*svp) : 0;
997 svp = hv_fetch(action, "cachesize", 9, FALSE);
998 info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
1000 #ifndef DB_VERSION_MAJOR
1001 svp = hv_fetch(action, "minkeypage", 10, FALSE);
1002 info->btree.minkeypage = svp ? SvIV(*svp) : 0;
1004 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
1005 info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
1008 svp = hv_fetch(action, "psize", 5, FALSE);
1009 info->db_BT_psize = svp ? SvIV(*svp) : 0;
1011 svp = hv_fetch(action, "lorder", 6, FALSE);
1012 info->db_BT_lorder = svp ? SvIV(*svp) : 0;
1017 else if (sv_isa(sv, "DB_File::RECNOINFO"))
1020 croak("DB_File can only tie an array to a DB_RECNO database");
1022 RETVAL->type = DB_RECNO ;
1023 openinfo = (void *)info ;
1025 info->db_RE_flags = 0 ;
1027 svp = hv_fetch(action, "flags", 5, FALSE);
1028 info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
1030 svp = hv_fetch(action, "reclen", 6, FALSE);
1031 info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
1033 svp = hv_fetch(action, "cachesize", 9, FALSE);
1034 info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
1036 svp = hv_fetch(action, "psize", 5, FALSE);
1037 info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
1039 svp = hv_fetch(action, "lorder", 6, FALSE);
1040 info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
1042 #ifdef DB_VERSION_MAJOR
1043 info->re_source = name ;
1046 svp = hv_fetch(action, "bfname", 6, FALSE);
1047 if (svp && SvOK(*svp)) {
1048 char * ptr = SvPV(*svp,n_a) ;
1049 #ifdef DB_VERSION_MAJOR
1050 name = (char*) n_a ? ptr : NULL ;
1052 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
1056 #ifdef DB_VERSION_MAJOR
1059 info->db_RE_bfname = NULL ;
1062 svp = hv_fetch(action, "bval", 4, FALSE);
1063 #ifdef DB_VERSION_MAJOR
1064 if (svp && SvOK(*svp))
1068 value = (int)*SvPV(*svp, n_a) ;
1070 value = SvIV(*svp) ;
1072 if (info->flags & DB_FIXEDLEN) {
1073 info->re_pad = value ;
1074 info->flags |= DB_PAD ;
1077 info->re_delim = value ;
1078 info->flags |= DB_DELIMITER ;
1083 if (svp && SvOK(*svp))
1086 info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
1088 info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
1089 DB_flags(info->flags, DB_DELIMITER) ;
1094 if (info->db_RE_flags & R_FIXEDLEN)
1095 info->db_RE_bval = (u_char) ' ' ;
1097 info->db_RE_bval = (u_char) '\n' ;
1098 DB_flags(info->flags, DB_DELIMITER) ;
1103 info->flags |= DB_RENUMBER ;
1109 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1113 /* OS2 Specific Code */
1117 #endif /* __EMX__ */
1120 #ifdef DB_VERSION_MAJOR
1126 /* Map 1.x flags to 2.x flags */
1127 if ((flags & O_CREAT) == O_CREAT)
1128 Flags |= DB_CREATE ;
1131 if (flags == O_RDONLY)
1133 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1135 Flags |= DB_RDONLY ;
1138 if ((flags & O_TRUNC) == O_TRUNC)
1139 Flags |= DB_TRUNCATE ;
1142 status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
1144 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
1145 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
1147 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1152 RETVAL->dbp = NULL ;
1157 #if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2
1158 RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ;
1160 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
1161 #endif /* DB_LIBRARY_COMPATIBILITY_API */
1167 #else /* Berkeley DB Version > 2 */
1171 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
1177 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
1178 Zero(RETVAL, 1, DB_File_type) ;
1180 /* Default to HASH */
1181 #ifdef DBM_FILTERING
1182 RETVAL->filtering = 0 ;
1183 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
1184 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
1185 #endif /* DBM_FILTERING */
1186 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
1187 RETVAL->type = DB_HASH ;
1189 /* DGH - Next line added to avoid SEGV on existing hash DB */
1192 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
1193 RETVAL->in_memory = (name == NULL) ;
1195 status = db_create(&RETVAL->dbp, NULL,0) ;
1196 /* printf("db_create returned %d %s\n", status, db_strerror(status)) ; */
1198 RETVAL->dbp = NULL ;
1206 croak ("type parameter is not a reference") ;
1208 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
1209 if (svp && SvOK(*svp))
1210 action = (HV*) SvRV(*svp) ;
1212 croak("internal error") ;
1214 if (sv_isa(sv, "DB_File::HASHINFO"))
1218 croak("DB_File can only tie an associative array to a DB_HASH database") ;
1220 RETVAL->type = DB_HASH ;
1222 svp = hv_fetch(action, "hash", 4, FALSE);
1224 if (svp && SvOK(*svp))
1226 (void)dbp->set_h_hash(dbp, hash_cb) ;
1227 RETVAL->hash = newSVsv(*svp) ;
1230 svp = hv_fetch(action, "ffactor", 7, FALSE);
1232 (void)dbp->set_h_ffactor(dbp, my_SvUV32(*svp)) ;
1234 svp = hv_fetch(action, "nelem", 5, FALSE);
1236 (void)dbp->set_h_nelem(dbp, my_SvUV32(*svp)) ;
1238 svp = hv_fetch(action, "bsize", 5, FALSE);
1240 (void)dbp->set_pagesize(dbp, my_SvUV32(*svp));
1242 svp = hv_fetch(action, "cachesize", 9, FALSE);
1244 (void)dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
1246 svp = hv_fetch(action, "lorder", 6, FALSE);
1248 (void)dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
1252 else if (sv_isa(sv, "DB_File::BTREEINFO"))
1255 croak("DB_File can only tie an associative array to a DB_BTREE database");
1257 RETVAL->type = DB_BTREE ;
1259 svp = hv_fetch(action, "compare", 7, FALSE);
1260 if (svp && SvOK(*svp))
1262 (void)dbp->set_bt_compare(dbp, btree_compare) ;
1263 RETVAL->compare = newSVsv(*svp) ;
1266 svp = hv_fetch(action, "prefix", 6, FALSE);
1267 if (svp && SvOK(*svp))
1269 (void)dbp->set_bt_prefix(dbp, btree_prefix) ;
1270 RETVAL->prefix = newSVsv(*svp) ;
1273 svp = hv_fetch(action, "flags", 5, FALSE);
1275 (void)dbp->set_flags(dbp, my_SvUV32(*svp)) ;
1277 svp = hv_fetch(action, "cachesize", 9, FALSE);
1279 (void)dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
1281 svp = hv_fetch(action, "psize", 5, FALSE);
1283 (void)dbp->set_pagesize(dbp, my_SvUV32(*svp)) ;
1285 svp = hv_fetch(action, "lorder", 6, FALSE);
1287 (void)dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
1292 else if (sv_isa(sv, "DB_File::RECNOINFO"))
1297 croak("DB_File can only tie an array to a DB_RECNO database");
1299 RETVAL->type = DB_RECNO ;
1301 svp = hv_fetch(action, "flags", 5, FALSE);
1303 int flags = SvIV(*svp) ;
1304 /* remove FIXDLEN, if present */
1305 if (flags & DB_FIXEDLEN) {
1307 flags &= ~DB_FIXEDLEN ;
1311 svp = hv_fetch(action, "cachesize", 9, FALSE);
1313 status = dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
1316 svp = hv_fetch(action, "psize", 5, FALSE);
1318 status = dbp->set_pagesize(dbp, my_SvUV32(*svp)) ;
1321 svp = hv_fetch(action, "lorder", 6, FALSE);
1323 status = dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
1326 svp = hv_fetch(action, "bval", 4, FALSE);
1327 if (svp && SvOK(*svp))
1331 value = (int)*SvPV(*svp, n_a) ;
1333 value = (int)SvIV(*svp) ;
1336 status = dbp->set_re_pad(dbp, value) ;
1339 status = dbp->set_re_delim(dbp, value) ;
1345 svp = hv_fetch(action, "reclen", 6, FALSE);
1347 u_int32_t len = my_SvUV32(*svp) ;
1348 status = dbp->set_re_len(dbp, len) ;
1353 status = dbp->set_re_source(dbp, name) ;
1357 svp = hv_fetch(action, "bfname", 6, FALSE);
1358 if (svp && SvOK(*svp)) {
1359 char * ptr = SvPV(*svp,n_a) ;
1360 name = (char*) n_a ? ptr : NULL ;
1366 status = dbp->set_flags(dbp, (u_int32_t)DB_RENUMBER) ;
1369 (void)dbp->set_flags(dbp, (u_int32_t)flags) ;
1374 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1378 u_int32_t Flags = 0 ;
1381 /* Map 1.x flags to 3.x flags */
1382 if ((flags & O_CREAT) == O_CREAT)
1383 Flags |= DB_CREATE ;
1386 if (flags == O_RDONLY)
1388 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1390 Flags |= DB_RDONLY ;
1393 if ((flags & O_TRUNC) == O_TRUNC)
1394 Flags |= DB_TRUNCATE ;
1397 status = (RETVAL->dbp->open)(RETVAL->dbp, name, NULL, RETVAL->type,
1399 /* printf("open returned %d %s\n", status, db_strerror(status)) ; */
1402 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1404 /* printf("cursor returned %d %s\n", status, db_strerror(status)) ; */
1407 RETVAL->dbp = NULL ;
1413 #endif /* Berkeley DB Version > 2 */
1415 } /* ParseOpenInfo */
1419 #ifdef CAN_PROTOTYPE
1420 constant(char *name, int arg)
1432 if (strEQ(name, "BTREEMAGIC"))
1438 if (strEQ(name, "BTREEVERSION"))
1440 return BTREEVERSION;
1448 if (strEQ(name, "DB_LOCK"))
1454 if (strEQ(name, "DB_SHMEM"))
1460 if (strEQ(name, "DB_TXN"))
1474 if (strEQ(name, "HASHMAGIC"))
1480 if (strEQ(name, "HASHVERSION"))
1496 if (strEQ(name, "MAX_PAGE_NUMBER"))
1497 #ifdef MAX_PAGE_NUMBER
1498 return (U32)MAX_PAGE_NUMBER;
1502 if (strEQ(name, "MAX_PAGE_OFFSET"))
1503 #ifdef MAX_PAGE_OFFSET
1504 return MAX_PAGE_OFFSET;
1508 if (strEQ(name, "MAX_REC_NUMBER"))
1509 #ifdef MAX_REC_NUMBER
1510 return (U32)MAX_REC_NUMBER;
1524 if (strEQ(name, "RET_ERROR"))
1530 if (strEQ(name, "RET_SPECIAL"))
1536 if (strEQ(name, "RET_SUCCESS"))
1542 if (strEQ(name, "R_CURSOR"))
1548 if (strEQ(name, "R_DUP"))
1554 if (strEQ(name, "R_FIRST"))
1560 if (strEQ(name, "R_FIXEDLEN"))
1566 if (strEQ(name, "R_IAFTER"))
1572 if (strEQ(name, "R_IBEFORE"))
1578 if (strEQ(name, "R_LAST"))
1584 if (strEQ(name, "R_NEXT"))
1590 if (strEQ(name, "R_NOKEY"))
1596 if (strEQ(name, "R_NOOVERWRITE"))
1597 #ifdef R_NOOVERWRITE
1598 return R_NOOVERWRITE;
1602 if (strEQ(name, "R_PREV"))
1608 if (strEQ(name, "R_RECNOSYNC"))
1614 if (strEQ(name, "R_SETCURSOR"))
1620 if (strEQ(name, "R_SNAPSHOT"))
1654 MODULE = DB_File PACKAGE = DB_File PREFIX = db_
1659 __getBerkeleyDBInfo() ;
1662 empty.data = &zero ;
1663 empty.size = sizeof(recno_t) ;
1673 db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1680 char * name = (char *) NULL ;
1681 SV * sv = (SV *) NULL ;
1684 if (items >= 3 && SvOK(ST(2)))
1685 name = (char*) SvPV(ST(2), n_a) ;
1690 RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
1691 if (RETVAL->dbp == NULL)
1706 SvREFCNT_dec(db->hash) ;
1708 SvREFCNT_dec(db->compare) ;
1710 SvREFCNT_dec(db->prefix) ;
1711 #ifdef DBM_FILTERING
1712 if (db->filter_fetch_key)
1713 SvREFCNT_dec(db->filter_fetch_key) ;
1714 if (db->filter_store_key)
1715 SvREFCNT_dec(db->filter_store_key) ;
1716 if (db->filter_fetch_value)
1717 SvREFCNT_dec(db->filter_fetch_value) ;
1718 if (db->filter_store_value)
1719 SvREFCNT_dec(db->filter_store_value) ;
1720 #endif /* DBM_FILTERING */
1722 #ifdef DB_VERSION_MAJOR
1729 db_DELETE(db, key, flags=0)
1751 RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
1757 db_FETCH(db, key, flags=0)
1770 /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
1771 RETVAL = db_get(db, key, value, flags) ;
1772 ST(0) = sv_newmortal();
1773 OutputValue(ST(0), value)
1777 db_STORE(db, key, value, flags=0)
1802 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1803 ST(0) = sv_newmortal();
1804 OutputKey(ST(0), key) ;
1810 DBTKEY key = NO_INIT
1821 RETVAL = do_SEQ(db, key, value, R_NEXT) ;
1822 ST(0) = sv_newmortal();
1823 OutputKey(ST(0), key) ;
1827 # These would be nice for RECNO
1847 #ifdef DB_VERSION_MAJOR
1848 /* get the first value */
1849 RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1854 for (i = items-1 ; i > 0 ; --i)
1856 value.data = SvPV(ST(i), n_a) ;
1860 key.size = sizeof(int) ;
1861 #ifdef DB_VERSION_MAJOR
1862 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1864 RETVAL = (db->dbp->put)(db->dbp, &key, &value, R_IBEFORE) ;
1890 /* First get the final value */
1891 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1892 ST(0) = sv_newmortal();
1896 /* the call to del will trash value, so take a copy now */
1897 OutputValue(ST(0), value) ;
1898 RETVAL = db_del(db, key, R_CURSOR) ;
1900 sv_setsv(ST(0), &PL_sv_undef);
1920 /* get the first value */
1921 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1922 ST(0) = sv_newmortal();
1926 /* the call to del will trash value, so take a copy now */
1927 OutputValue(ST(0), value) ;
1928 RETVAL = db_del(db, key, R_CURSOR) ;
1930 sv_setsv (ST(0), &PL_sv_undef) ;
1953 /* Set the Cursor to the Last element */
1954 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1955 #ifndef DB_VERSION_MAJOR
1960 keyval = *(int*)key.data ;
1963 for (i = 1 ; i < items ; ++i)
1965 value.data = SvPV(ST(i), n_a) ;
1968 key.data = &keyval ;
1969 key.size = sizeof(int) ;
1970 RETVAL = (Db->put)(Db, TXN &key, &value, 0) ;
1984 ALIAS: FETCHSIZE = 1
1987 RETVAL = GetArrayLength(aTHX_ db) ;
1993 # Now provide an interface to the rest of the DB functionality
1997 db_del(db, key, flags=0)
2005 RETVAL = db_del(db, key, flags) ;
2006 #ifdef DB_VERSION_MAJOR
2009 else if (RETVAL == DB_NOTFOUND)
2017 db_get(db, key, value, flags=0)
2027 RETVAL = db_get(db, key, value, flags) ;
2028 #ifdef DB_VERSION_MAJOR
2031 else if (RETVAL == DB_NOTFOUND)
2039 db_put(db, key, value, flags=0)
2048 RETVAL = db_put(db, key, value, flags) ;
2049 #ifdef DB_VERSION_MAJOR
2052 else if (RETVAL == DB_KEYEXIST)
2057 key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
2066 #ifdef DB_VERSION_MAJOR
2070 status = (db->in_memory
2072 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
2077 RETVAL = (db->in_memory
2079 : ((db->dbp)->fd)(db->dbp) ) ;
2085 db_sync(db, flags=0)
2092 RETVAL = db_sync(db, flags) ;
2093 #ifdef DB_VERSION_MAJOR
2102 db_seq(db, key, value, flags)
2112 RETVAL = db_seq(db, key, value, flags);
2113 #ifdef DB_VERSION_MAJOR
2116 else if (RETVAL == DB_NOTFOUND)
2124 #ifdef DBM_FILTERING
2126 #define setFilter(type) \
2129 RETVAL = sv_mortalcopy(db->type) ; \
2131 if (db->type && (code == &PL_sv_undef)) { \
2132 SvREFCNT_dec(db->type) ; \
2137 sv_setsv(db->type, code) ; \
2139 db->type = newSVsv(code) ; \
2145 filter_fetch_key(db, code)
2148 SV * RETVAL = &PL_sv_undef ;
2150 setFilter(filter_fetch_key) ;
2153 filter_store_key(db, code)
2156 SV * RETVAL = &PL_sv_undef ;
2158 setFilter(filter_store_key) ;
2161 filter_fetch_value(db, code)
2164 SV * RETVAL = &PL_sv_undef ;
2166 setFilter(filter_fetch_value) ;
2169 filter_store_value(db, code)
2172 SV * RETVAL = &PL_sv_undef ;
2174 setFilter(filter_store_value) ;
2176 #endif /* DBM_FILTERING */