3 DB_File.xs -- Perl 5 interface to Berkeley DB
5 written by Paul Marquess <Paul.Marquess@btinternet.com>
6 last modified 26th April 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.
103 # include "patchlevel.h"
104 # define PERL_REVISION 5
105 # define PERL_VERSION PATCHLEVEL
106 # define PERL_SUBVERSION SUBVERSION
109 #if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 ))
111 # define PL_sv_undef sv_undef
116 /* DEFSV appears first in 5.004_56 */
118 # define DEFSV GvSV(defgv)
121 /* Mention DB_VERSION_MAJOR_CFG, DB_VERSION_MINOR_CFG, and
122 DB_VERSION_PATCH_CFG here so that Configure pulls them all in. */
124 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
125 * shortly #included by the <db.h>) __attribute__ to the possibly
126 * already defined __attribute__, for example by GNUC or by Perl. */
128 #if DB_VERSION_MAJOR_CFG < 2
132 /* Since we dropped the gccish definition of __attribute__ we will want
133 * to redefine dNOOP, however (so that dTHX continues to work). Yes,
134 * all this means that we can't do attribute checking on the DB_File,
137 #define dNOOP extern int Perl___notused
141 /* If Perl has been compiled with Threads support,the symbol op will
142 be defined here. This clashes with a field name in db.h, so get rid of it.
155 extern void __getBerkeleyDBInfo(void);
166 # define newSVpvn(a,b) newSVpv(a,b)
172 #define DBM_FILTERING
175 # define Trace(x) printf x
181 #define DBT_clear(x) Zero(&x, 1, DBT) ;
183 #ifdef DB_VERSION_MAJOR
185 #if DB_VERSION_MAJOR == 2
186 # define BERKELEY_DB_1_OR_2
189 #if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 2)
190 # define AT_LEAST_DB_3_2
193 /* map version 2 features & constants onto their version 1 equivalent */
198 #define DB_Prefix_t size_t
203 #define DB_Hash_t u_int32_t
205 /* DBTYPE stays the same */
206 /* HASHINFO, RECNOINFO and BTREEINFO map to DB_INFO */
207 #if DB_VERSION_MAJOR == 2
208 typedef DB_INFO INFO ;
209 #else /* DB_VERSION_MAJOR > 2 */
210 # define DB_FIXEDLEN (0x8000)
211 #endif /* DB_VERSION_MAJOR == 2 */
213 /* version 2 has db_recno_t in place of recno_t */
214 typedef db_recno_t recno_t;
217 #define R_CURSOR DB_SET_RANGE
218 #define R_FIRST DB_FIRST
219 #define R_IAFTER DB_AFTER
220 #define R_IBEFORE DB_BEFORE
221 #define R_LAST DB_LAST
222 #define R_NEXT DB_NEXT
223 #define R_NOOVERWRITE DB_NOOVERWRITE
224 #define R_PREV DB_PREV
226 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
227 # define R_SETCURSOR 0x800000
229 # define R_SETCURSOR (-100)
232 #define R_RECNOSYNC 0
233 #define R_FIXEDLEN DB_FIXEDLEN
237 #define db_HA_hash h_hash
238 #define db_HA_ffactor h_ffactor
239 #define db_HA_nelem h_nelem
240 #define db_HA_bsize db_pagesize
241 #define db_HA_cachesize db_cachesize
242 #define db_HA_lorder db_lorder
244 #define db_BT_compare bt_compare
245 #define db_BT_prefix bt_prefix
246 #define db_BT_flags flags
247 #define db_BT_psize db_pagesize
248 #define db_BT_cachesize db_cachesize
249 #define db_BT_lorder db_lorder
250 #define db_BT_maxkeypage
251 #define db_BT_minkeypage
254 #define db_RE_reclen re_len
255 #define db_RE_flags flags
256 #define db_RE_bval re_pad
257 #define db_RE_bfname re_source
258 #define db_RE_psize db_pagesize
259 #define db_RE_cachesize db_cachesize
260 #define db_RE_lorder db_lorder
264 #define do_SEQ(db, key, value, flag) (db->cursor->c_get)(db->cursor, &key, &value, flag)
267 #define DBT_flags(x) x.flags = 0
268 #define DB_flags(x, v) x |= v
270 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
271 # define flagSet(flags, bitmask) ((flags) & (bitmask))
273 # define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask))
276 #else /* db version 1.x */
278 #define BERKELEY_DB_1
279 #define BERKELEY_DB_1_OR_2
292 # define DB_Prefix_t mDB_Prefix_t
299 # define DB_Hash_t mDB_Hash_t
302 #define db_HA_hash hash.hash
303 #define db_HA_ffactor hash.ffactor
304 #define db_HA_nelem hash.nelem
305 #define db_HA_bsize hash.bsize
306 #define db_HA_cachesize hash.cachesize
307 #define db_HA_lorder hash.lorder
309 #define db_BT_compare btree.compare
310 #define db_BT_prefix btree.prefix
311 #define db_BT_flags btree.flags
312 #define db_BT_psize btree.psize
313 #define db_BT_cachesize btree.cachesize
314 #define db_BT_lorder btree.lorder
315 #define db_BT_maxkeypage btree.maxkeypage
316 #define db_BT_minkeypage btree.minkeypage
318 #define db_RE_reclen recno.reclen
319 #define db_RE_flags recno.flags
320 #define db_RE_bval recno.bval
321 #define db_RE_bfname recno.bfname
322 #define db_RE_psize recno.psize
323 #define db_RE_cachesize recno.cachesize
324 #define db_RE_lorder recno.lorder
328 #define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag)
330 #define DB_flags(x, v)
331 #define flagSet(flags, bitmask) ((flags) & (bitmask))
333 #endif /* db version 1 */
337 #define db_DELETE(db, key, flags) ((db->dbp)->del)(db->dbp, TXN &key, flags)
338 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, flags)
339 #define db_FETCH(db, key, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
341 #define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
342 #define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
344 #ifdef DB_VERSION_MAJOR
345 #define db_DESTROY(db) ( db->cursor->c_close(db->cursor),\
346 (db->dbp->close)(db->dbp, 0) )
347 #define db_close(db) ((db->dbp)->close)(db->dbp, 0)
348 #define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \
349 ? ((db->cursor)->c_del)(db->cursor, 0) \
350 : ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
352 #else /* ! DB_VERSION_MAJOR */
354 #define db_DESTROY(db) ((db->dbp)->close)(db->dbp)
355 #define db_close(db) ((db->dbp)->close)(db->dbp)
356 #define db_del(db, key, flags) ((db->dbp)->del)(db->dbp, &key, flags)
357 #define db_put(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
359 #endif /* ! DB_VERSION_MAJOR */
362 #define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags)
371 #ifdef BERKELEY_DB_1_OR_2
374 #ifdef DB_VERSION_MAJOR
378 SV * filter_fetch_key ;
379 SV * filter_store_key ;
380 SV * filter_fetch_value ;
381 SV * filter_store_value ;
383 #endif /* DBM_FILTERING */
387 typedef DB_File_type * DB_File ;
392 #define ckFilter(arg,type,name) \
395 /* printf("filtering %s\n", name) ;*/ \
397 croak("recursion detected in %s", name) ; \
398 db->filtering = TRUE ; \
399 save_defsv = newSVsv(DEFSV) ; \
400 sv_setsv(DEFSV, arg) ; \
402 (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); \
403 sv_setsv(arg, DEFSV) ; \
404 sv_setsv(DEFSV, save_defsv) ; \
405 SvREFCNT_dec(save_defsv) ; \
406 db->filtering = FALSE ; \
407 /*printf("end of filtering %s\n", name) ;*/ \
412 #define ckFilter(arg,type, name)
414 #endif /* DBM_FILTERING */
416 #define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)
418 #define OutputValue(arg, name) \
419 { if (RETVAL == 0) { \
420 my_sv_setpvn(arg, name.data, name.size) ; \
421 ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \
425 #define OutputKey(arg, name) \
428 if (db->type != DB_RECNO) { \
429 my_sv_setpvn(arg, name.data, name.size); \
432 sv_setiv(arg, (I32)*(I32*)name.data - 1); \
433 ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \
438 /* Internal Global Data */
439 static recno_t Value ;
440 static recno_t zero = 0 ;
441 static DB_File CurrentDB ;
442 static DBTKEY empty ;
444 #ifdef DB_VERSION_MAJOR
448 db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
450 db_put(db, key, value, flags)
459 if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) {
463 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
464 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor) != 0)
466 if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor, 0) != 0)
470 memset(&l_key, 0, sizeof(l_key));
471 l_key.data = key.data;
472 l_key.size = key.size;
473 memset(&l_value, 0, sizeof(l_value));
474 l_value.data = value.data;
475 l_value.size = value.size;
477 if ( temp_cursor->c_get(temp_cursor, &l_key, &l_value, DB_SET) != 0) {
478 (void)temp_cursor->c_close(temp_cursor);
482 status = temp_cursor->c_put(temp_cursor, &key, &value, flags);
483 (void)temp_cursor->c_close(temp_cursor);
489 if (flagSet(flags, R_CURSOR)) {
490 return ((db->cursor)->c_put)(db->cursor, &key, &value, DB_CURRENT);
493 if (flagSet(flags, R_SETCURSOR)) {
494 if ((db->dbp)->put(db->dbp, NULL, &key, &value, 0) != 0)
496 return ((db->cursor)->c_get)(db->cursor, &key, &value, DB_SET_RANGE);
500 return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
504 #endif /* DB_VERSION_MAJOR */
508 #ifdef AT_LEAST_DB_3_2
511 btree_compare(DB * db, const DBT *key1, const DBT *key2)
513 btree_compare(db, key1, key2)
517 #endif /* CAN_PROTOTYPE */
519 #else /* Berkeley DB < 3.2 */
522 btree_compare(const DBT *key1, const DBT *key2)
524 btree_compare(key1, key2)
536 char * data1, * data2 ;
540 data1 = (char *) key1->data ;
541 data2 = (char *) key2->data ;
544 /* As newSVpv will assume that the data pointer is a null terminated C
545 string if the size parameter is 0, make sure that data points to an
546 empty string if the length is 0
559 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
560 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
563 count = perl_call_sv(CurrentDB->compare, G_SCALAR);
568 croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
580 #ifdef AT_LEAST_DB_3_2
583 btree_prefix(DB * db, const DBT *key1, const DBT *key2)
585 btree_prefix(db, key1, key2)
591 #else /* Berkeley DB < 3.2 */
594 btree_prefix(const DBT *key1, const DBT *key2)
596 btree_prefix(key1, key2)
607 char * data1, * data2 ;
611 data1 = (char *) key1->data ;
612 data2 = (char *) key2->data ;
615 /* As newSVpv will assume that the data pointer is a null terminated C
616 string if the size parameter is 0, make sure that data points to an
617 empty string if the length is 0
630 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
631 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
634 count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
639 croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
652 # define HASH_CB_SIZE_TYPE size_t
654 # define HASH_CB_SIZE_TYPE u_int32_t
658 #ifdef AT_LEAST_DB_3_2
661 hash_cb(DB * db, const void *data, u_int32_t size)
663 hash_cb(db, data, size)
666 HASH_CB_SIZE_TYPE size ;
669 #else /* Berkeley DB < 3.2 */
672 hash_cb(const void *data, HASH_CB_SIZE_TYPE size)
676 HASH_CB_SIZE_TYPE size ;
693 /* DGH - Next two lines added to fix corrupted stack problem */
699 XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
702 count = perl_call_sv(CurrentDB->hash, G_SCALAR);
707 croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
719 #if defined(TRACE) && defined(BERKELEY_DB_1_OR_2)
723 PrintHash(INFO *hash)
729 printf ("HASH Info\n") ;
730 printf (" hash = %s\n",
731 (hash->db_HA_hash != NULL ? "redefined" : "default")) ;
732 printf (" bsize = %d\n", hash->db_HA_bsize) ;
733 printf (" ffactor = %d\n", hash->db_HA_ffactor) ;
734 printf (" nelem = %d\n", hash->db_HA_nelem) ;
735 printf (" cachesize = %d\n", hash->db_HA_cachesize) ;
736 printf (" lorder = %d\n", hash->db_HA_lorder) ;
742 PrintRecno(INFO *recno)
748 printf ("RECNO Info\n") ;
749 printf (" flags = %d\n", recno->db_RE_flags) ;
750 printf (" cachesize = %d\n", recno->db_RE_cachesize) ;
751 printf (" psize = %d\n", recno->db_RE_psize) ;
752 printf (" lorder = %d\n", recno->db_RE_lorder) ;
753 printf (" reclen = %ul\n", (unsigned long)recno->db_RE_reclen) ;
754 printf (" bval = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
755 printf (" bfname = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
760 PrintBtree(INFO *btree)
766 printf ("BTREE Info\n") ;
767 printf (" compare = %s\n",
768 (btree->db_BT_compare ? "redefined" : "default")) ;
769 printf (" prefix = %s\n",
770 (btree->db_BT_prefix ? "redefined" : "default")) ;
771 printf (" flags = %d\n", btree->db_BT_flags) ;
772 printf (" cachesize = %d\n", btree->db_BT_cachesize) ;
773 printf (" psize = %d\n", btree->db_BT_psize) ;
774 #ifndef DB_VERSION_MAJOR
775 printf (" maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
776 printf (" minkeypage = %d\n", btree->db_BT_minkeypage) ;
778 printf (" lorder = %d\n", btree->db_BT_lorder) ;
783 #define PrintRecno(recno)
784 #define PrintHash(hash)
785 #define PrintBtree(btree)
792 GetArrayLength(pTHX_ DB_File db)
804 RETVAL = do_SEQ(db, key, value, R_LAST) ;
806 RETVAL = *(I32 *)key.data ;
807 else /* No key means empty file */
810 return ((I32)RETVAL) ;
815 GetRecnoKey(pTHX_ DB_File db, I32 value)
817 GetRecnoKey(db, value)
823 /* Get the length of the array */
824 I32 length = GetArrayLength(aTHX_ db) ;
826 /* check for attempt to write before start of array */
827 if (length + value + 1 <= 0)
828 croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
830 value = length + value + 1 ;
841 ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
843 ParseOpenInfo(isHASH, name, flags, mode, sv)
852 #ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1 or 2 */
856 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
857 void * openinfo = NULL ;
858 INFO * info = &RETVAL->info ;
861 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
862 Zero(RETVAL, 1, DB_File_type) ;
864 /* Default to HASH */
866 RETVAL->filtering = 0 ;
867 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
868 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
869 #endif /* DBM_FILTERING */
870 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
871 RETVAL->type = DB_HASH ;
873 /* DGH - Next line added to avoid SEGV on existing hash DB */
876 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
877 RETVAL->in_memory = (name == NULL) ;
882 croak ("type parameter is not a reference") ;
884 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
885 if (svp && SvOK(*svp))
886 action = (HV*) SvRV(*svp) ;
888 croak("internal error") ;
890 if (sv_isa(sv, "DB_File::HASHINFO"))
894 croak("DB_File can only tie an associative array to a DB_HASH database") ;
896 RETVAL->type = DB_HASH ;
897 openinfo = (void*)info ;
899 svp = hv_fetch(action, "hash", 4, FALSE);
901 if (svp && SvOK(*svp))
903 info->db_HA_hash = hash_cb ;
904 RETVAL->hash = newSVsv(*svp) ;
907 info->db_HA_hash = NULL ;
909 svp = hv_fetch(action, "ffactor", 7, FALSE);
910 info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
912 svp = hv_fetch(action, "nelem", 5, FALSE);
913 info->db_HA_nelem = svp ? SvIV(*svp) : 0;
915 svp = hv_fetch(action, "bsize", 5, FALSE);
916 info->db_HA_bsize = svp ? SvIV(*svp) : 0;
918 svp = hv_fetch(action, "cachesize", 9, FALSE);
919 info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
921 svp = hv_fetch(action, "lorder", 6, FALSE);
922 info->db_HA_lorder = svp ? SvIV(*svp) : 0;
926 else if (sv_isa(sv, "DB_File::BTREEINFO"))
929 croak("DB_File can only tie an associative array to a DB_BTREE database");
931 RETVAL->type = DB_BTREE ;
932 openinfo = (void*)info ;
934 svp = hv_fetch(action, "compare", 7, FALSE);
935 if (svp && SvOK(*svp))
937 info->db_BT_compare = btree_compare ;
938 RETVAL->compare = newSVsv(*svp) ;
941 info->db_BT_compare = NULL ;
943 svp = hv_fetch(action, "prefix", 6, FALSE);
944 if (svp && SvOK(*svp))
946 info->db_BT_prefix = btree_prefix ;
947 RETVAL->prefix = newSVsv(*svp) ;
950 info->db_BT_prefix = NULL ;
952 svp = hv_fetch(action, "flags", 5, FALSE);
953 info->db_BT_flags = svp ? SvIV(*svp) : 0;
955 svp = hv_fetch(action, "cachesize", 9, FALSE);
956 info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
958 #ifndef DB_VERSION_MAJOR
959 svp = hv_fetch(action, "minkeypage", 10, FALSE);
960 info->btree.minkeypage = svp ? SvIV(*svp) : 0;
962 svp = hv_fetch(action, "maxkeypage", 10, FALSE);
963 info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
966 svp = hv_fetch(action, "psize", 5, FALSE);
967 info->db_BT_psize = svp ? SvIV(*svp) : 0;
969 svp = hv_fetch(action, "lorder", 6, FALSE);
970 info->db_BT_lorder = svp ? SvIV(*svp) : 0;
975 else if (sv_isa(sv, "DB_File::RECNOINFO"))
978 croak("DB_File can only tie an array to a DB_RECNO database");
980 RETVAL->type = DB_RECNO ;
981 openinfo = (void *)info ;
983 info->db_RE_flags = 0 ;
985 svp = hv_fetch(action, "flags", 5, FALSE);
986 info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
988 svp = hv_fetch(action, "reclen", 6, FALSE);
989 info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
991 svp = hv_fetch(action, "cachesize", 9, FALSE);
992 info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
994 svp = hv_fetch(action, "psize", 5, FALSE);
995 info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
997 svp = hv_fetch(action, "lorder", 6, FALSE);
998 info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
1000 #ifdef DB_VERSION_MAJOR
1001 info->re_source = name ;
1004 svp = hv_fetch(action, "bfname", 6, FALSE);
1005 if (svp && SvOK(*svp)) {
1006 char * ptr = SvPV(*svp,n_a) ;
1007 #ifdef DB_VERSION_MAJOR
1008 name = (char*) n_a ? ptr : NULL ;
1010 info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
1014 #ifdef DB_VERSION_MAJOR
1017 info->db_RE_bfname = NULL ;
1020 svp = hv_fetch(action, "bval", 4, FALSE);
1021 #ifdef DB_VERSION_MAJOR
1022 if (svp && SvOK(*svp))
1026 value = (int)*SvPV(*svp, n_a) ;
1028 value = SvIV(*svp) ;
1030 if (info->flags & DB_FIXEDLEN) {
1031 info->re_pad = value ;
1032 info->flags |= DB_PAD ;
1035 info->re_delim = value ;
1036 info->flags |= DB_DELIMITER ;
1041 if (svp && SvOK(*svp))
1044 info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
1046 info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
1047 DB_flags(info->flags, DB_DELIMITER) ;
1052 if (info->db_RE_flags & R_FIXEDLEN)
1053 info->db_RE_bval = (u_char) ' ' ;
1055 info->db_RE_bval = (u_char) '\n' ;
1056 DB_flags(info->flags, DB_DELIMITER) ;
1061 info->flags |= DB_RENUMBER ;
1067 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1071 /* OS2 Specific Code */
1075 #endif /* __EMX__ */
1078 #ifdef DB_VERSION_MAJOR
1084 /* Map 1.x flags to 2.x flags */
1085 if ((flags & O_CREAT) == O_CREAT)
1086 Flags |= DB_CREATE ;
1089 if (flags == O_RDONLY)
1091 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1093 Flags |= DB_RDONLY ;
1096 if ((flags & O_TRUNC) == O_TRUNC)
1097 Flags |= DB_TRUNCATE ;
1100 status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
1102 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
1103 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
1105 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1110 RETVAL->dbp = NULL ;
1115 #if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2
1116 RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ;
1118 RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
1119 #endif /* DB_LIBRARY_COMPATIBILITY_API */
1125 #else /* Berkeley DB Version > 2 */
1129 DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
1134 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
1135 Zero(RETVAL, 1, DB_File_type) ;
1137 /* Default to HASH */
1138 #ifdef DBM_FILTERING
1139 RETVAL->filtering = 0 ;
1140 RETVAL->filter_fetch_key = RETVAL->filter_store_key =
1141 RETVAL->filter_fetch_value = RETVAL->filter_store_value =
1142 #endif /* DBM_FILTERING */
1143 RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
1144 RETVAL->type = DB_HASH ;
1146 /* DGH - Next line added to avoid SEGV on existing hash DB */
1149 /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
1150 RETVAL->in_memory = (name == NULL) ;
1152 status = db_create(&RETVAL->dbp, NULL,0) ;
1153 /* printf("db_create returned %d %s\n", status, db_strerror(status)) ; */
1155 RETVAL->dbp = NULL ;
1163 croak ("type parameter is not a reference") ;
1165 svp = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
1166 if (svp && SvOK(*svp))
1167 action = (HV*) SvRV(*svp) ;
1169 croak("internal error") ;
1171 if (sv_isa(sv, "DB_File::HASHINFO"))
1175 croak("DB_File can only tie an associative array to a DB_HASH database") ;
1177 RETVAL->type = DB_HASH ;
1179 svp = hv_fetch(action, "hash", 4, FALSE);
1181 if (svp && SvOK(*svp))
1183 (void)dbp->set_h_hash(dbp, hash_cb) ;
1184 RETVAL->hash = newSVsv(*svp) ;
1187 svp = hv_fetch(action, "ffactor", 7, FALSE);
1189 (void)dbp->set_h_ffactor(dbp, SvIV(*svp)) ;
1191 svp = hv_fetch(action, "nelem", 5, FALSE);
1193 (void)dbp->set_h_nelem(dbp, SvIV(*svp)) ;
1195 svp = hv_fetch(action, "bsize", 5, FALSE);
1197 (void)dbp->set_pagesize(dbp, SvIV(*svp));
1199 svp = hv_fetch(action, "cachesize", 9, FALSE);
1201 (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1203 svp = hv_fetch(action, "lorder", 6, FALSE);
1205 (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
1209 else if (sv_isa(sv, "DB_File::BTREEINFO"))
1212 croak("DB_File can only tie an associative array to a DB_BTREE database");
1214 RETVAL->type = DB_BTREE ;
1216 svp = hv_fetch(action, "compare", 7, FALSE);
1217 if (svp && SvOK(*svp))
1219 (void)dbp->set_bt_compare(dbp, btree_compare) ;
1220 RETVAL->compare = newSVsv(*svp) ;
1223 svp = hv_fetch(action, "prefix", 6, FALSE);
1224 if (svp && SvOK(*svp))
1226 (void)dbp->set_bt_prefix(dbp, btree_prefix) ;
1227 RETVAL->prefix = newSVsv(*svp) ;
1230 svp = hv_fetch(action, "flags", 5, FALSE);
1232 (void)dbp->set_flags(dbp, SvIV(*svp)) ;
1234 svp = hv_fetch(action, "cachesize", 9, FALSE);
1236 (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1238 svp = hv_fetch(action, "psize", 5, FALSE);
1240 (void)dbp->set_pagesize(dbp, SvIV(*svp)) ;
1242 svp = hv_fetch(action, "lorder", 6, FALSE);
1244 (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
1249 else if (sv_isa(sv, "DB_File::RECNOINFO"))
1254 croak("DB_File can only tie an array to a DB_RECNO database");
1256 RETVAL->type = DB_RECNO ;
1258 svp = hv_fetch(action, "flags", 5, FALSE);
1260 int flags = SvIV(*svp) ;
1261 /* remove FIXDLEN, if present */
1262 if (flags & DB_FIXEDLEN) {
1264 flags &= ~DB_FIXEDLEN ;
1268 svp = hv_fetch(action, "cachesize", 9, FALSE);
1270 status = dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
1273 svp = hv_fetch(action, "psize", 5, FALSE);
1275 status = dbp->set_pagesize(dbp, SvIV(*svp)) ;
1278 svp = hv_fetch(action, "lorder", 6, FALSE);
1280 status = dbp->set_lorder(dbp, SvIV(*svp)) ;
1283 svp = hv_fetch(action, "bval", 4, FALSE);
1284 if (svp && SvOK(*svp))
1288 value = (int)*SvPV(*svp, n_a) ;
1290 value = SvIV(*svp) ;
1293 status = dbp->set_re_pad(dbp, value) ;
1296 status = dbp->set_re_delim(dbp, value) ;
1302 svp = hv_fetch(action, "reclen", 6, FALSE);
1304 u_int32_t len = (u_int32_t)SvIV(*svp) ;
1305 status = dbp->set_re_len(dbp, len) ;
1310 status = dbp->set_re_source(dbp, name) ;
1314 svp = hv_fetch(action, "bfname", 6, FALSE);
1315 if (svp && SvOK(*svp)) {
1316 char * ptr = SvPV(*svp,n_a) ;
1317 name = (char*) n_a ? ptr : NULL ;
1323 status = dbp->set_flags(dbp, DB_RENUMBER) ;
1326 (void)dbp->set_flags(dbp, flags) ;
1331 croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
1338 /* Map 1.x flags to 3.x flags */
1339 if ((flags & O_CREAT) == O_CREAT)
1340 Flags |= DB_CREATE ;
1343 if (flags == O_RDONLY)
1345 if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
1347 Flags |= DB_RDONLY ;
1350 if ((flags & O_TRUNC) == O_TRUNC)
1351 Flags |= DB_TRUNCATE ;
1354 status = (RETVAL->dbp->open)(RETVAL->dbp, name, NULL, RETVAL->type,
1356 /* printf("open returned %d %s\n", status, db_strerror(status)) ; */
1359 status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
1361 /* printf("cursor returned %d %s\n", status, db_strerror(status)) ; */
1364 RETVAL->dbp = NULL ;
1370 #endif /* Berkeley DB Version > 2 */
1372 } /* ParseOpenInfo */
1376 #ifdef CAN_PROTOTYPE
1377 constant(char *name, int arg)
1389 if (strEQ(name, "BTREEMAGIC"))
1395 if (strEQ(name, "BTREEVERSION"))
1397 return BTREEVERSION;
1405 if (strEQ(name, "DB_LOCK"))
1411 if (strEQ(name, "DB_SHMEM"))
1417 if (strEQ(name, "DB_TXN"))
1431 if (strEQ(name, "HASHMAGIC"))
1437 if (strEQ(name, "HASHVERSION"))
1453 if (strEQ(name, "MAX_PAGE_NUMBER"))
1454 #ifdef MAX_PAGE_NUMBER
1455 return (U32)MAX_PAGE_NUMBER;
1459 if (strEQ(name, "MAX_PAGE_OFFSET"))
1460 #ifdef MAX_PAGE_OFFSET
1461 return MAX_PAGE_OFFSET;
1465 if (strEQ(name, "MAX_REC_NUMBER"))
1466 #ifdef MAX_REC_NUMBER
1467 return (U32)MAX_REC_NUMBER;
1481 if (strEQ(name, "RET_ERROR"))
1487 if (strEQ(name, "RET_SPECIAL"))
1493 if (strEQ(name, "RET_SUCCESS"))
1499 if (strEQ(name, "R_CURSOR"))
1505 if (strEQ(name, "R_DUP"))
1511 if (strEQ(name, "R_FIRST"))
1517 if (strEQ(name, "R_FIXEDLEN"))
1523 if (strEQ(name, "R_IAFTER"))
1529 if (strEQ(name, "R_IBEFORE"))
1535 if (strEQ(name, "R_LAST"))
1541 if (strEQ(name, "R_NEXT"))
1547 if (strEQ(name, "R_NOKEY"))
1553 if (strEQ(name, "R_NOOVERWRITE"))
1554 #ifdef R_NOOVERWRITE
1555 return R_NOOVERWRITE;
1559 if (strEQ(name, "R_PREV"))
1565 if (strEQ(name, "R_RECNOSYNC"))
1571 if (strEQ(name, "R_SETCURSOR"))
1577 if (strEQ(name, "R_SNAPSHOT"))
1611 MODULE = DB_File PACKAGE = DB_File PREFIX = db_
1615 __getBerkeleyDBInfo() ;
1618 empty.data = &zero ;
1619 empty.size = sizeof(recno_t) ;
1629 db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
1636 char * name = (char *) NULL ;
1637 SV * sv = (SV *) NULL ;
1640 if (items >= 3 && SvOK(ST(2)))
1641 name = (char*) SvPV(ST(2), n_a) ;
1646 RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
1647 if (RETVAL->dbp == NULL)
1660 SvREFCNT_dec(db->hash) ;
1662 SvREFCNT_dec(db->compare) ;
1664 SvREFCNT_dec(db->prefix) ;
1665 #ifdef DBM_FILTERING
1666 if (db->filter_fetch_key)
1667 SvREFCNT_dec(db->filter_fetch_key) ;
1668 if (db->filter_store_key)
1669 SvREFCNT_dec(db->filter_store_key) ;
1670 if (db->filter_fetch_value)
1671 SvREFCNT_dec(db->filter_fetch_value) ;
1672 if (db->filter_store_value)
1673 SvREFCNT_dec(db->filter_store_value) ;
1674 #endif /* DBM_FILTERING */
1676 #ifdef DB_VERSION_MAJOR
1683 db_DELETE(db, key, flags=0)
1701 RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
1707 db_FETCH(db, key, flags=0)
1717 /* RETVAL = ((db->dbp)->get)(db->dbp, TXN &key, &value, flags) ; */
1718 RETVAL = db_get(db, key, value, flags) ;
1719 ST(0) = sv_newmortal();
1720 OutputValue(ST(0), value)
1724 db_STORE(db, key, value, flags=0)
1744 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1745 ST(0) = sv_newmortal();
1746 OutputKey(ST(0), key) ;
1759 RETVAL = do_SEQ(db, key, value, R_NEXT) ;
1760 ST(0) = sv_newmortal();
1761 OutputKey(ST(0), key) ;
1765 # These would be nice for RECNO
1783 #ifdef DB_VERSION_MAJOR
1784 /* get the first value */
1785 RETVAL = do_SEQ(db, key, value, DB_FIRST) ;
1790 for (i = items-1 ; i > 0 ; --i)
1792 value.data = SvPV(ST(i), n_a) ;
1796 key.size = sizeof(int) ;
1797 #ifdef DB_VERSION_MAJOR
1798 RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
1800 RETVAL = (db->dbp->put)(db->dbp, &key, &value, R_IBEFORE) ;
1822 /* First get the final value */
1823 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1824 ST(0) = sv_newmortal();
1828 /* the call to del will trash value, so take a copy now */
1829 OutputValue(ST(0), value) ;
1830 RETVAL = db_del(db, key, R_CURSOR) ;
1832 sv_setsv(ST(0), &PL_sv_undef);
1848 /* get the first value */
1849 RETVAL = do_SEQ(db, key, value, R_FIRST) ;
1850 ST(0) = sv_newmortal();
1854 /* the call to del will trash value, so take a copy now */
1855 OutputValue(ST(0), value) ;
1856 RETVAL = db_del(db, key, R_CURSOR) ;
1858 sv_setsv (ST(0), &PL_sv_undef) ;
1879 /* Set the Cursor to the Last element */
1880 RETVAL = do_SEQ(db, key, value, R_LAST) ;
1881 #ifndef DB_VERSION_MAJOR
1886 keyval = *(int*)key.data ;
1889 for (i = 1 ; i < items ; ++i)
1891 value.data = SvPV(ST(i), n_a) ;
1894 key.data = &keyval ;
1895 key.size = sizeof(int) ;
1896 RETVAL = (Db->put)(Db, TXN &key, &value, 0) ;
1908 ALIAS: FETCHSIZE = 1
1911 RETVAL = GetArrayLength(aTHX_ db) ;
1917 # Now provide an interface to the rest of the DB functionality
1921 db_del(db, key, flags=0)
1927 RETVAL = db_del(db, key, flags) ;
1928 #ifdef DB_VERSION_MAJOR
1931 else if (RETVAL == DB_NOTFOUND)
1939 db_get(db, key, value, flags=0)
1947 RETVAL = db_get(db, key, value, flags) ;
1948 #ifdef DB_VERSION_MAJOR
1951 else if (RETVAL == DB_NOTFOUND)
1959 db_put(db, key, value, flags=0)
1966 RETVAL = db_put(db, key, value, flags) ;
1967 #ifdef DB_VERSION_MAJOR
1970 else if (RETVAL == DB_KEYEXIST)
1975 key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
1983 #ifdef DB_VERSION_MAJOR
1985 status = (db->in_memory
1987 : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
1991 RETVAL = (db->in_memory
1993 : ((db->dbp)->fd)(db->dbp) ) ;
1999 db_sync(db, flags=0)
2004 RETVAL = db_sync(db, flags) ;
2005 #ifdef DB_VERSION_MAJOR
2014 db_seq(db, key, value, flags)
2022 RETVAL = db_seq(db, key, value, flags);
2023 #ifdef DB_VERSION_MAJOR
2026 else if (RETVAL == DB_NOTFOUND)
2034 #ifdef DBM_FILTERING
2036 #define setFilter(type) \
2039 RETVAL = sv_mortalcopy(db->type) ; \
2041 if (db->type && (code == &PL_sv_undef)) { \
2042 SvREFCNT_dec(db->type) ; \
2047 sv_setsv(db->type, code) ; \
2049 db->type = newSVsv(code) ; \
2055 filter_fetch_key(db, code)
2058 SV * RETVAL = &PL_sv_undef ;
2060 setFilter(filter_fetch_key) ;
2063 filter_store_key(db, code)
2066 SV * RETVAL = &PL_sv_undef ;
2068 setFilter(filter_store_key) ;
2071 filter_fetch_value(db, code)
2074 SV * RETVAL = &PL_sv_undef ;
2076 setFilter(filter_fetch_value) ;
2079 filter_store_value(db, code)
2082 SV * RETVAL = &PL_sv_undef ;
2084 setFilter(filter_store_value) ;
2086 #endif /* DBM_FILTERING */